You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

134 lines
4.4 KiB

3 years ago
3 years ago
2 years ago
3 years ago
2 years ago
3 years ago
2 years ago
3 years ago
2 years ago
3 years ago
3 years ago
2 years ago
3 years ago
2 years ago
2 years ago
3 years ago
3 years ago
3 years ago
2 years ago
3 years ago
2 years ago
2 years ago
3 years ago
2 years ago
3 years ago
  1. #' Retrieve ILINet Surveillance Data
  2. #'
  3. #' The CDC FluView Portal provides in-season and past seasons' national, regional,
  4. #' and state-level outpatient illness and viral surveillance data from both
  5. #' ILINet (Influenza-like Illness Surveillance Network) and WHO/NREVSS
  6. #' (National Respiratory and Enteric Virus Surveillance System).
  7. #'
  8. #' This function retrieves current and historical ILINet surveillance data for
  9. #' the identified region.
  10. #'
  11. #' @md
  12. #' @param region one of "`national`", "`hhs`", "`census`", or "`state`"
  13. #' @param years a vector of years to retrieve data for (i.e. `2014` for CDC
  14. #' flu season 2014-2015). CDC has data for this API going back to 1997.
  15. #' Default value (`NULL`) means retrieve **all** years. NOTE: if you
  16. #' happen to specify a 2-digit season value (i.e. `57` == 2017-2018)
  17. #' the function is smart enough to retrieve by season ID vs convert that
  18. #' to a year.
  19. #' @references
  20. #' - [CDC FluView Portal](https://gis.cdc.gov/grasp/fluview/fluportaldashboard.html)
  21. #' - [ILINet Portal](https://wwwn.cdc.gov/ilinet/) (Login required)
  22. #' - [WHO/NREVSS](https://www.cdc.gov/surveillance/nrevss/index.html)
  23. #' @export
  24. #' @examples
  25. #' national_ili <- ilinet("national", years = 2017)
  26. #' \dontrun{
  27. #' hhs_ili <- ilinet("hhs")
  28. #' census_ili <- ilinet("census")
  29. #' state_ili <- ilinet("state")
  30. #'
  31. #' library(purrr)
  32. #' map_df(
  33. #' c("national", "hhs", "census", "state"),
  34. #' ~ ilinet(.x)
  35. #' )
  36. #' }
  37. ilinet <- function(region = c("national", "hhs", "census", "state"), years = NULL) {
  38. #region="national"; years=1997:2018
  39. region <- match.arg(tolower(region), c("national", "hhs", "census", "state"))
  40. meta <- jsonlite::fromJSON("https://gis.cdc.gov/grasp/flu2/GetPhase02InitApp?appVersion=Public")
  41. list(
  42. AppVersion = "Public",
  43. DatasourceDT = list(list(ID = 1, Name = "ILINet")),
  44. RegionTypeId = .region_map[region]
  45. ) -> params
  46. params$SubRegionsDT <- switch(region,
  47. national = {
  48. list(list(ID = 0, Name = ""))
  49. },
  50. hhs = {
  51. lapply(1:10, function(i) list(ID = i, Name = as.character(i)))
  52. },
  53. census = {
  54. lapply(1:9, function(i) list(ID = i, Name = as.character(i)))
  55. },
  56. state = {
  57. lapply(1:59, function(i) list(ID = i, Name = as.character(i)))
  58. }
  59. )
  60. available_seasons <- sort(meta$seasons$seasonid)
  61. if (is.null(years)) { # ALL YEARS
  62. years <- available_seasons
  63. } else { # specified years or seasons or a mix
  64. years <- as.numeric(years)
  65. years <- ifelse(years > 1996, years - 1960, years)
  66. years <- sort(unique(years))
  67. years <- years[years %in% available_seasons]
  68. if (length(years) == 0) {
  69. years <- rev(sort(meta$seasons$seasonid))[1]
  70. curr_season_descr <- meta$seasons[meta$seasons$seasonid == years, "description"]
  71. message(sprintf(
  72. "No valid years specified, defaulting to this flu season => ID: %s [%s]",
  73. years, curr_season_descr
  74. ))
  75. }
  76. }
  77. params$SeasonsDT <- lapply(years, function(i) list(ID = i, Name = as.character(i)))
  78. tf <- tempfile(fileext = ".zip")
  79. td <- tempdir()
  80. on.exit(unlink(tf), TRUE)
  81. httr::POST(
  82. url = "https://gis.cdc.gov/grasp/flu2/PostPhase02DataDownload",
  83. httr::user_agent(.cdcfluview_ua),
  84. httr::add_headers(
  85. Origin = "https://gis.cdc.gov",
  86. Accept = "application/json, text/plain, */*",
  87. Referer = "https://gis.cdc.gov/grasp/fluview/fluportaldashboard.html"
  88. ),
  89. encode = "json",
  90. body = params,
  91. # httr::verbose(),
  92. httr::write_disk(tf)
  93. ) -> res
  94. httr::stop_for_status(res)
  95. nm <- unzip(tf, overwrite = TRUE, exdir = td)
  96. xdf <- read.csv(nm, skip = 1, stringsAsFactors = FALSE)
  97. xdf <- .mcga(xdf)
  98. xdf$weighted_ili <- to_num(xdf$weighted_ili)
  99. xdf$unweighted_ili <- to_num(xdf$unweighted_ili)
  100. xdf$age_0_4 <- to_num(xdf$age_0_4)
  101. xdf$age_25_49 <- to_num(xdf$age_25_49)
  102. xdf$age_25_64 <- to_num(xdf$age_25_64)
  103. xdf$age_5_24 <- to_num(xdf$age_5_24)
  104. xdf$age_50_64 <- to_num(xdf$age_50_64)
  105. xdf$age_65 <- to_num(xdf$age_65)
  106. xdf$ilitotal <- to_num(xdf$ilitotal)
  107. xdf$num_of_providers <- to_num(xdf$num_of_providers)
  108. xdf$total_patients <- to_num(xdf$total_patients)
  109. xdf$week_start <- MMWRweek::MMWRweek2Date(xdf$year, xdf$week)
  110. if (region == "national") xdf$region <- "National"
  111. if (region == "hhs") xdf$region <- factor(xdf$region, levels = sprintf("Region %s", 1:10))
  112. class(xdf) <- c("tbl_df", "tbl", "data.frame")
  113. arrange(suppressMessages(readr::type_convert(xdf)), week_start)
  114. }