sirfunctions 2.1.7

.github/workflows/R-CMD-check.yaml

@@ -49,3 +49,4 @@ jobs:
         with:
           upload-snapshots: true
           build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'
+          error-on: '"error"'

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: sirfunctions
 Title: Key Functions to Analyze Global Polio Surveillance Data
-Version: 2.1.6
+Version: 2.1.7
 Authors@R: c(
     person("Nishant", "Kishore", , "ynm2@cdc.gov", role = c("aut"),
            comment = c(ORCID = "0000-0003-0408-2747")),
@@ -47,7 +47,8 @@ Imports:
     stats,
     rappdirs,
     rmarkdown,
-    grDevices
+    grDevices,
+    pins
 Suggests:
     arrow,
     qs2,

NAMESPACE

@@ -104,6 +104,7 @@ export(get_cdc_childvaxview_data)
 export(get_constant)
 export(get_ctry_abbrev)
 export(get_diff_cols)
+export(get_edav_pins_board)
 export(get_lab_date_col_missingness)
 export(get_lab_locs)
 export(get_ppt_template)
@@ -171,6 +172,7 @@ importFrom(lifecycle,badge)
 importFrom(lifecycle,deprecate_warn)
 importFrom(lifecycle,deprecated)
 importFrom(lifecycle,is_present)
+importFrom(pins,board_azure)
 importFrom(purrr,map)
 importFrom(rappdirs,user_data_dir)
 importFrom(readr,read_csv)

R/dal.R

@@ -3695,7 +3695,7 @@ force_load_polio_data_cache <- function(attach.spatial.data, output_format = ".r
     # Check if spatial data exists in the cache
     if (sirfunctions_io("exists.file", NULL, spatial_data_path, edav = FALSE)) {
       cli::cli_alert_info("Loading spatial data from cache")
-      spatial_data <- sirfunctions_io("read", NULL, spatial_data_path, edav = FALSE)
+      spatial.data <- sirfunctions_io("read", NULL, spatial_data_path, edav = FALSE)
 
       raw.data$global.ctry <- spatial.data$global.ctry
       raw.data$global.prov <- spatial.data$global.prov

R/dr.lab.functions.R

@@ -1232,7 +1232,7 @@ clean_lab_data <- function(lab_data, start_date, end_date,
   )) |>
   mutate(seq.capacity = if_else(country %in% c("NIGERIA", "UGANDA") & DateStoolCollected >= as_date("2025-02-01"), "Sequencing capacity", seq.capacity))
 
-  return(lab_data)
+  return(lab_data_man)
 }
 
 

R/dr.main.functions.R

@@ -251,9 +251,8 @@ update_data <-
                                        polis_folder = .polis_folder,
                                        use_edav = .use_edav
                                        )
-    country_name <- stringr::str_replace_all(country_name, ", ", ",") |>
-      stringr::str_split(",") |>
-      unlist()
+
+
     country_data <- sirfunctions::extract_country_data(country_name, raw_data)
     readr::write_rds(country_data, path_to_save)
     message(paste0("Data saved at:\n", dr_data_path))
@@ -479,7 +478,7 @@ fetch_dr_data <- function(country, year, local_dr_repo) {
 #' environmental variables (i.e., [Sys.getenv()], where values for `x` related to
 #' the desk review is prefixed with `"DR"`) . The function only supports running one country at a time.
 #'
-#' @param country_name `str` Name of the country.
+#' @param country_name `str` Name of the country. You may pass multiple countries as a vector of strings.
 #' @param start_date `str` Start date of the desk review. If `NULL`, defaults to four years
 #' from when the function was ran on January 1st.
 #' @param end_date `str` End date of the desk review. If `NULL`, defaults to six weeks from when
@@ -500,6 +499,7 @@ fetch_dr_data <- function(country, year, local_dr_repo) {
 #' \dontrun{
 #' ctry.data <- init_dr("algeria", source = F) # Sets up folder in the current working directory
 #' ctry.data <- init_dr("algeria", branch = "dev") # Use functions from the dev branch
+#' ctry.data <- init_dr(c("algeria", "nigeria"), source = F) # Multiple countries.
 #' }
 #'
 #' @export
@@ -540,13 +540,14 @@ init_dr <-
 
     # Set up local directory for storing for data and metadata
     df_name <-
-      stringr::str_c(stringr::str_to_lower(country_name))
+      stringr::str_c(stringr::str_to_lower(country_name)) |>
+      paste(collapse = ", ")
 
     # Relative path of where data and metadata is stored
     dr_path <-
       file.path(
         local_dr_folder,
-        stringr::str_to_lower(country_name),
+        stringr::str_to_lower(df_name),
         year
       )
 

R/get_edav_pins_board.R

@@ -0,0 +1,24 @@
+#' Obtain a pins board from EDAV
+#'
+#' @description
+#' This is a convenience function to obtain a pins board in EDAV. After the pins
+#' board is loaded, several functions from the pins package are available to explore
+#' the board. Please see the pins package [get started](https://pins.rstudio.com/articles/pins.html) page.
+#'
+#' @param board_loc `str` Location of the pins board in Azure.
+#' @param azcontainer `azcontainer` An Azure container.
+#'
+#' @returns `pins board` An Azure pins board.
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' edav_board <- get_edav_pins_board()
+#' }
+get_edav_pins_board <- function(board_loc = "GID/PEB/SIR/pins_board",
+                                azcontainer = get_azure_storage_connection()) {
+
+  azboard <- pins::board_azure(azcontainer, board_loc)
+
+  return(azboard)
+}

R/kpi.figure.functions.R

@@ -529,9 +529,11 @@ generate_kpi_npafp_bar <- function(c1, afp_data,
   ctry_abbrev <- get_ctry_abbrev(afp_data)
   priority_ctry <- c1 |>
     dplyr::left_join(ctry_abbrev,
-                     by = c("ctry" = "place.admin.0", "Region" = "whoregion")) |>
+                     by = c("ctry" = "place.admin.0")) |>
     dplyr::filter(.data$`SG Priority Level` == "HIGH") |>
-    dplyr::mutate(prop_met_npafp = .data$prop_met_npafp)
+    # Remove whoregion from ctry_abbrev and use Region since
+    # c1 already accounts for Indonesia change and it's not used here
+    dplyr::select(-whoregion)
 
   bar_plot <- generate_kpi_barchart(priority_ctry,
                         "prop_met_npafp",
@@ -587,8 +589,11 @@ generate_kpi_evdetect_bar <- function(c1, afp_data,
   ctry_abbrev <- get_ctry_abbrev(afp_data)
   priority_ctry <- c1 |>
     dplyr::left_join(ctry_abbrev,
-                     by = c("ctry" = "place.admin.0", "Region" = "whoregion")) |>
-    dplyr::mutate(prop_met_ev = .data$prop_met_ev)
+                     by = c("ctry" = "place.admin.0")) |>
+    # Remove whoregion from ctry_abbrev and use Region since
+    # c1 already accounts for Indonesia change and it's not used here
+    dplyr::select(-whoregion) |>
+    dplyr::filter(`SG Priority Level` == "HIGH")
 
   if (!is.null(who_region)) {
     priority_ctry <- priority_ctry |> dplyr::filter(Region %in% who_region)
@@ -635,9 +640,11 @@ generate_kpi_stoolad_bar <- function(c1, afp_data,
   ctry_abbrev <- get_ctry_abbrev(afp_data)
   priority_ctry <- c1 |>
     dplyr::left_join(ctry_abbrev,
-                     by = c("ctry" = "place.admin.0", "Region" = "whoregion")) |>
-    dplyr::filter(.data$`SG Priority Level` == "HIGH") |>
-    dplyr::mutate(prop_met_stool = .data$prop_met_stool)
+                     by = c("ctry" = "place.admin.0")) |>
+    # Remove whoregion from ctry_abbrev and use Region since
+    # c1 already accounts for Indonesia change and it's not used here
+    dplyr::select(-whoregion) |>
+    dplyr::filter(.data$`SG Priority Level` == "HIGH")
 
   bar_plot <- generate_kpi_barchart(priority_ctry,
                                     "prop_met_stool",
@@ -736,8 +743,14 @@ generate_kpi_violin <- function(
 #' @param rolling `logical` Using rolling periods or year-to-year? Defaults to `TRUE`.
 #' @param who_region `list` Regions to display. Defaults to `NULL`, which shows
 #' all of the regions.
+#' @param risk_table `tibble` Priority level of each country. Defaults to `NULL`,
+#' which will download the information directly from EDAV.
+#' @param lab_locs `tibble` Summary of the sequencing capacities of labs.
+#' Output of [get_lab_locs()]. Defaults to `NULL`, which will download the information
+#' directly from EDAV.
 #' @param output_path `str` Where to output the figure to.
-#' @param y_max `num` The maximum y-axis value.
+#' @param y_max `num` The maximum y-axis value. Defaults to `NULL`, which will compute the
+#' y_max as the max value of days to notify hq.
 #'
 #' @returns `ggplot` A violin plot showing timeliness of detection.
 #' @export
@@ -752,12 +765,14 @@ generate_timely_det_violin <- function(raw_data,
                                        priority_level = c("HIGH", "MEDIUM", "LOW (WATCHLIST)", "LOW"),
                                        who_region = NULL,
                                        rolling = TRUE,
+                                       risk_table = NULL,
+                                       lab_locs = NULL,
                                        output_path = Sys.getenv("KPI_FIGURES"),
-                                       y_max = 250) {
+                                       y_max = NULL) {
 
   start_date <- lubridate::as_date(start_date)
   end_date <- lubridate::as_date(end_date)
-  pos <- generate_pos_timeliness(raw_data, start_date, end_date)
+  pos <- generate_pos_timeliness(raw_data, start_date, end_date, risk_table, lab_locs)
   ctry_abbrev <- get_ctry_abbrev(raw_data$afp)
   color.risk.cat <- c(
     "HIGH" = "#d73027",
@@ -774,27 +789,40 @@ generate_timely_det_violin <- function(raw_data,
   }
 
   pos_filtered <- pos |>
+    dplyr::mutate(whoregion = get_region(place.admin.0)) |>
+    # Remove other who region columns because it's confusing
+    dplyr::select(-dplyr::any_of(c("who.region", "Region"))) |>
     dplyr::filter(.data$`SG Priority Level` %in% priority_level,
                   .data$whoregion %in% who_region) |>
     dplyr::left_join(ctry_abbrev,
                      by = c("place.admin.0", "whoregion")) |>
-    dplyr::mutate(seq_lab = case_when(
-      .data$seq.capacity == "no" ~ "No sequencing capacity",
-      .data$seq.capacity == "yes" ~ "Sequencing capacity"
-    )) |>
+    # Manually change the region of Indonesia based on change
+    # since get_region() defaults to WPRO now, we have to do the opposite
+    # to assign Indonesia samples to SEARO prior to May 23, 2025
+    # dplyr::mutate(whoregion = ifelse(place.admin.0 == "INDONESIA" &
+    #   analysis_year_start < lubridate::as_date("2025-05-23"), "SEARO", whoregion)) |>
+    dplyr::mutate(seq_lab = stringr::str_to_lower(seq.capacity),
+                  seq_lab = ifelse(seq_lab == "yes",
+                                   "Sequencing capacity",
+                                   "No sequencing capacity"
+                  ))  |>
     dplyr::filter(!is.na(.data$seq_lab)) |>
     dplyr::mutate(
       sg_priority_level = factor(.data$`SG Priority Level`, levels = c(
         "LOW", "LOW (WATCHLIST)", "MEDIUM", "HIGH"))
     )
 
+  if (is.null(y_max)) {
+  y_max <- max(pos_filtered$ontonothq, na.rm = TRUE)
+  }
+
   if (rolling) {
-    facets <- ggh4x::facet_nested(rolling_period~seq_lab+who.region,
+    facets <- ggh4x::facet_nested(rolling_period~seq_lab+whoregion,
                                     scales = "free", space = "free",
                                     labeller = ggplot2::label_wrap_gen(13),
                                     switch = "y")
   } else {
-    facets <- ggh4x::facet_nested(year~seq_lab+who.region,
+    facets <- ggh4x::facet_nested(year~seq_lab+whoregion,
                                     scales = "free", space = "free",
                                     labeller = ggplot2::label_wrap_gen(13),
                                     switch = "y")
@@ -811,7 +839,7 @@ generate_timely_det_violin <- function(raw_data,
   plot_mock_legend <- ggpubr::get_legend(plot_mock)
 
   plot_1 <- generate_kpi_violin(pos_filtered |>
-                                  filter(seq.capacity == "no"), "ctry.short", "ontonothq",
+                                  filter(seq_lab == "No sequencing capacity"), "ctry.short", "ontonothq",
                               "sg_priority_level",
                               facets,
                               46, y.max = y_max)
@@ -820,7 +848,7 @@ generate_timely_det_violin <- function(raw_data,
                                name = "Priority Level",
                                na.value = "white")
 
-  plot_2 <- generate_kpi_violin(pos_filtered |> filter(seq.capacity == "yes"), "ctry.short", "ontonothq",
+  plot_2 <- generate_kpi_violin(pos_filtered |> filter(seq_lab == "Sequencing capacity"), "ctry.short", "ontonothq",
                                 "sg_priority_level",
                                 facets,
                                 35, y.max = y_max)
@@ -917,6 +945,9 @@ generate_timely_ship_violin <- function(afp_data,
   afp_filtered <- afp_data |>
     dplyr::filter(.data$`SG Priority Level` %in% priority_level,
                   .data$whoregion %in% who_region) |>
+    dplyr::mutate(whoregion = get_region(place.admin.0)) |>
+    # Remove other who region columns because it's confusing
+    dplyr::select(-dplyr::any_of(c("who.region", "Region"))) |>
     dplyr::left_join(ctry_abbrev,
                      by = c("ctry" = "place.admin.0", "whoregion")) |>
     dplyr::mutate(
@@ -1038,10 +1069,16 @@ generate_lab_culture_violin <- function(lab_data, afp_data,
   lab_filtered <- lab_data |> dplyr::left_join(ctry_abbrev,
                                            by = c("country" = "place.admin.0",
                                                   "whoregion")) |>
+    dplyr::mutate(whoregion = get_region(country)) |>
+    # Remove other who region columns because it's confusing
+    dplyr::select(-dplyr::any_of(c("who.region", "Region"))) |>
     add_risk_category(ctry_col = "country") |>
     dplyr::mutate(
       year = lubridate::year(.data$DateStoolCollected)
     ) |>
+    # Filter out "incorrect" lab data where the date onset doesn't match
+    # the stool collection date
+    dplyr::filter(dplyr::between(DateStoolCollected, analysis_year_start, analysis_year_end)) |>
     dplyr::filter(.data$`SG Priority Level` %in% priority_level,
                   !is.na(.data$culture.itd.cat),
                   dplyr::between(DateStoolCollected, start_date, end_date)) |>
@@ -1124,7 +1161,13 @@ generate_lab_itd_violin <- function(lab_data, afp_data,
   lab_filtered <- lab_data |> dplyr::left_join(ctry_abbrev,
                                                by = c("country" = "place.admin.0",
                                                       "whoregion")) |>
+    dplyr::mutate(whoregion = get_region(country)) |>
+    # Remove other who region columns because it's confusing
+    dplyr::select(-dplyr::any_of(c("who.region", "Region"))) |>
     add_risk_category(ctry_col = "country") |>
+    # Filter out "incorrect" lab data where the date onset doesn't match
+    # the stool collection date
+    dplyr::filter(dplyr::between(DateStoolCollected, analysis_year_start, analysis_year_end)) |>
     dplyr::mutate(
       year = lubridate::year(.data$DateStoolCollected)
     ) |>
@@ -1210,7 +1253,13 @@ generate_lab_seqship_violin <- function(lab_data, afp_data,
   lab_filtered <- lab_data |> dplyr::left_join(ctry_abbrev,
                                                by = c("country" = "place.admin.0",
                                                       "whoregion")) |>
+    dplyr::mutate(whoregion = get_region(country)) |>
+    # Remove other who region columns because it's confusing
+    dplyr::select(-dplyr::any_of(c("who.region", "Region"))) |>
     add_risk_category(ctry_col = "country") |>
+    # Filter out "incorrect" lab data where the date onset doesn't match
+    # the stool collection date
+    dplyr::filter(dplyr::between(DateStoolCollected, analysis_year_start, analysis_year_end)) |>
     dplyr::mutate(
       year = lubridate::year(.data$DateStoolCollected)
     ) |>
@@ -1280,7 +1329,7 @@ generate_lab_seqres_violin <- function(lab_data, afp_data,
                                               who_region = NULL,
                                               rolling = TRUE,
                                               output_path = Sys.getenv("KPI_FIGURES"),
-                                              y_max = 60) {
+                                              y_max = NULL) {
 
   start_date <- lubridate::as_date(start_date)
   end_date <- lubridate::as_date(end_date)
@@ -1297,7 +1346,12 @@ generate_lab_seqres_violin <- function(lab_data, afp_data,
   lab_filtered <- lab_data |> dplyr::left_join(ctry_abbrev,
                                                by = c("country" = "place.admin.0",
                                                       "whoregion")) |>
+    # Remove other who region columns because it's confusing
+    dplyr::select(-dplyr::any_of(c("who.region", "Region"))) |>
     add_risk_category(ctry_col = "country") |>
+    # Filter out "incorrect" lab data where the date onset doesn't match
+    # the stool collection date
+    dplyr::filter(dplyr::between(DateStoolCollected, analysis_year_start, analysis_year_end)) |>
     dplyr::mutate(
       year = lubridate::year(.data$DateStoolCollected)
     ) |>
@@ -1309,11 +1363,16 @@ generate_lab_seqres_violin <- function(lab_data, afp_data,
         "LOW", "LOW (WATCHLIST)", "MEDIUM", "HIGH"))
     )
 
+
   if (!is.null(who_region)) {
     lab_filtered <- lab_filtered |>
       dplyr::filter(.data$whoregion %in% who_region)
   }
 
+  if (is.null(y_max)) {
+    y_max <- as.numeric(max(lab_filtered$days.seq.rec.res, na.rm = TRUE))
+  }
+
   if (rolling) {
     facets <- ggh4x::facet_nested(rolling_period ~ seq.cat + seq.lab,
                                   scales = "free", space = "free",
@@ -1410,7 +1469,13 @@ generate_lab_itdres_seqres_violin <- function(lab_data, afp_data,
   lab_filtered <- lab_data |> dplyr::left_join(ctry_abbrev,
                                                by = c("country" = "place.admin.0",
                                                       "whoregion")) |>
+    dplyr::mutate(whoregion = get_region(country)) |>
+    # Remove other who region columns because it's confusing
+    dplyr::select(-dplyr::any_of(c("who.region", "Region"))) |>
     add_risk_category(ctry_col = "country") |>
+    # Filter out "incorrect" lab data where the date onset doesn't match
+    # the stool collection date
+    dplyr::filter(dplyr::between(DateStoolCollected, analysis_year_start, analysis_year_end)) |>
     dplyr::mutate(
       year = lubridate::year(.data$DateStoolCollected)
     ) |>