fix fips still being present

HopkinsIDD · Sep 29, 2023 · 8ea82a7 · 8ea82a7
1 parent 600ae69
commit 8ea82a7
Show file tree

Hide file tree

Showing 2 changed files with 12 additions and 14 deletions.
diff --git a/flepimop/R_packages/config.writer/R/yaml_utils.R b/flepimop/R_packages/config.writer/R/yaml_utils.R
@@ -80,16 +80,15 @@
 collapse_intervention<- function(dat){
     #TODO: add number to repeated names
     #TODO add a check that all end_dates are the same
-    mtr <- dat %>%
+    mtr <- dat %>% as_tibble() %>%
         dplyr::filter(template=="MultiPeriodModifier") %>%
         dplyr::mutate(end_date=paste0("end_date: ", end_date),
                       start_date=paste0("- start_date: ", start_date)) %>%
         tidyr::unite(col="period", sep="\n              ", start_date:end_date) %>%
         dplyr::group_by(dplyr::across(-period)) %>%
         dplyr::summarize(period = paste0(period, collapse="\n            "))
 
-    if (!all(is.na(mtr$spatial_groups)) & !all(is.null(mtr$spatial_groups))) {
-
+    if (exists("mtr$spatial_groups") && (!all(is.na(mtr$spatial_groups)) & !all(is.null(mtr$spatial_groups)))) {
         mtr <- mtr %>%
             dplyr::group_by(dplyr::across(-subpop)) %>%
             dplyr::summarize(subpop = paste0(subpop, collapse='", "'),

diff --git a/flepimop/main_scripts/inference_slot.R b/flepimop/main_scripts/inference_slot.R
@@ -163,7 +163,7 @@ if (is.null(config$inference$gt_source)){
 }
 
 gt_scale <- ifelse(state_level, "US state", "US county")
-fips_codes_ <- geodata[[obs_subpop]]
+subpops_ <- geodata[[obs_subpop]]
 
 gt_start_date <- lubridate::ymd(config$start_date)
 if (opt$ground_truth_start != "") {
@@ -203,21 +203,20 @@ if (config$inference$do_inference){
 
     obs <- suppressMessages(
         readr::read_csv(config$inference$gt_data_path,
-                        col_types = readr::cols(FIPS = readr::col_character(),
-                                                date = readr::col_date(),
+                        col_types = readr::cols(date = readr::col_date(),
                                                 source = readr::col_character(),
+                                                subpop = readr::col_character(),
                                                 .default = readr::col_double()), )) %>%
-        dplyr::filter(FIPS %in% fips_codes_, date >= gt_start_date, date <= gt_end_date) %>%
-        dplyr::right_join(tidyr::expand_grid(FIPS = unique(.$FIPS), date = unique(.$date))) %>%
-        dplyr::mutate_if(is.numeric, dplyr::coalesce, 0) %>%
-        dplyr::rename(!!obs_subpop := FIPS)
+        dplyr::filter(subpop %in% subpops_, date >= gt_start_date, date <= gt_end_date) %>%
+        dplyr::right_join(tidyr::expand_grid(subpop = unique(.$subpop), date = unique(.$date))) %>%
+        dplyr::mutate_if(is.numeric, dplyr::coalesce, 0)
 
-    geonames <- unique(obs[[obs_subpop]])
+    subpopnames <- unique(obs[[obs_subpop]])
 
 
     ## Compute statistics
     data_stats <- lapply(
-        geonames,
+        subpopnames,
         function(x) {
             df <- obs[obs[[obs_subpop]] == x, ]
             inference::getStats(
@@ -229,7 +228,7 @@ if (config$inference$do_inference){
                 end_date = gt_end_date
             )
         }) %>%
-        set_names(geonames)
+        set_names(subpopnames)
 
 
     likelihood_calculation_fun <- function(sim_hosp){
@@ -262,7 +261,7 @@ if (config$inference$do_inference){
 
 } else {
 
-    geonames <- obs_subpop
+    subpopnames <- obs_subpop
 
     likelihood_calculation_fun <- function(sim_hosp){