Merge branch 'main' into SL_small_fixes

datasetup/build_US_setup.R

@@ -153,6 +153,9 @@ if (length(config$subpop_setup$geodata) > 0) {
 # manually remove PR
 census_data <- census_data %>% filter(USPS != "PR")
 
+
+if(!dir.exists(dirname(config$subpop_setup$geodata))){
+  dir.create(dirname(config$subpop_setup$geodata))}
 write.csv(file = file.path(geodata_file), census_data, row.names=FALSE)
 print(paste("Wrote geodata file:", file.path(geodata_file)))
 
@@ -162,13 +165,13 @@ print(paste("Wrote geodata file:", file.path(geodata_file)))
 # MOBILITY DATA (COMMUTER DATA) ------------------------------------------------------------
 
 
-if(state_level & !file.exists(paste0(config$data_path, "/", config$subpop_setup$mobility))){
+if(state_level & !file.exists(paste0(config$subpop_setup$mobility))){
 
   warning(paste("State-level mobility files must be created manually because `build_US_setup.R` does not generate a state-level mobility file automatically. No valid mobility file named", paste0(config$data_path, "/", config$subpop_setup$mobility), "(specified in the config) currently exists. Please check again."))
 
-} else if(state_level & file.exists(paste0(config$data_path, "/", config$subpop_setup$mobility))){
+} else if(state_level & file.exists(paste0(config$subpop_setup$mobility))){
 
-  warning(paste("Using existing state-level mobility file named", paste0(config$data_path, "/", config$subpop_setup$mobility)))
+  warning(paste("Using existing state-level mobility file named", paste0(config$subpop_setup$mobility)))
 
 } else{
 

datasetup/build_covid_data.R

@@ -389,7 +389,8 @@ us_data <- us_data %>%
     # mutate(across(starts_with("incid"), ~ replace_na(.x, 0))) %>%
     mutate(across(starts_with("incid"), ~ as.numeric(.x)))
 
-
+if(!dir.exists(dirname(config$inference$gt_data_path))){
+  dir.create(dirname(config$inference$gt_data_path))}
 # Save
 write_csv(us_data, config$inference$gt_data_path)
 

datasetup/build_flu_data.R

@@ -80,6 +80,8 @@ us_data <- us_data %>%
     filter(date >= lubridate::as_date(config$start_date) & date <= lubridate::as_date(end_date_)) %>%
     filter(!is.na(source))
 
+if(!dir.exists(dirname(config$inference$gt_data_path))){
+  dir.create(dirname(config$inference$gt_data_path))}
 write_csv(us_data, config$inference$gt_data_path)
 
 

datasetup/build_nonUS_setup.R

@@ -103,6 +103,8 @@ if(opt$w){
 }
 
 # Save population geodata
+if(!dir.exists(dirname(config$subpop_setup$geodata))){
+  dir.create(dirname(config$subpop_setup$geodata))}
 names(census_data) <- c("subpop","admin2","admin0","pop")
 write.csv(file = file.path('geodata.csv'), census_data,row.names=FALSE)
 

flepimop/R_packages/inference/R/inference_slot_runner_funcs.R

@@ -84,7 +84,6 @@ aggregate_and_calc_loc_likelihoods <- function(
         ## We use a data frame for debugging, only ll is used
         likelihood_data[[location]] <- dplyr::tibble(
             ll = this_location_log_likelihood,
-            filename = hosp_file,
             subpop = location,
             accept = 0, # acceptance decision (0/1) . Will be updated later when accept/reject decisions made
             accept_avg = 0, # running average acceptance decision
@@ -589,8 +588,8 @@ initialize_mcmc_first_block <- function(
             }
 
             # load and add to original seeding
-            seed_new <-  readr::read_csv(global_files[["seed_filename"]])
-            added_seeding <- readr::read_csv(config$seeding$added_seeding$added_lambda_file)
+            seed_new <-  readr::read_csv(global_files[["seed_filename"]],show_col_types = FALSE)
+            added_seeding <- readr::read_csv(config$seeding$added_seeding$added_lambda_file,show_col_types = FALSE)
 
             if (!is.null(config$seeding$added_seeding$fix_original_seeding) &&
                 config$seeding$added_seeding$fix_original_seeding){
@@ -626,19 +625,6 @@ initialize_mcmc_first_block <- function(
                 }
                 initial_init_file <- config$initial_conditions$initial_conditions_file
 
-                if (!file.exists(config$initial_conditions$initial_conditions_file)) {
-                    stop("ERROR: Initial conditions file specified but does not exist.")
-                }
-                if (grepl(".csv", initial_init_file)){
-                    initial_init <- readr::read_csv(initial_init_file)
-                    arrow::write_parquet(initial_init, global_files[["init_filename"]])
-                }else{
-                    err <- !(file.copy(initial_init_file, global_files[["init_filename"]]))
-                    if (err != 0) {
-                        stop("Could not copy initial conditions file")
-                    }
-                }
-
             } else if (config$initial_conditions$method %in% c("InitialConditionsFolderDraw", "SetInitialConditionsFolderDraw")) {
                 print("Initial conditions in inference has not been fully implemented yet for the 'folder draw' methods,
                       and no copying to global or chimeric files is being done.")
@@ -647,21 +633,34 @@ initialize_mcmc_first_block <- function(
                     stop("ERROR: Initial conditions file needs to be specified in the config under `initial_conditions:initial_conditions_file`")
                 }
                 initial_init_file <- global_files[[paste0(config$initial_conditions$initial_file_type, "_filename")]]
+            }
 
-                if (!file.exists(initial_init_file)) {
-                    stop("ERROR: Initial conditions file specified but does not exist.")
-                }
-                if (grepl(".csv", initial_init_file)){ 
-                    initial_init <- readr::read_csv(initial_init_file)
-                    arrow::write_parquet(initial_init, global_files[["init_filename"]])
-                }else{
-                    err <- !(file.copy(initial_init_file, global_files[["init_filename"]]))
-                    if (err != 0) {
-                        stop("Could not copy initial conditions file")
-                    }
-                }
 
+            if (!file.exists(initial_init_file)) {
+                stop("ERROR: Initial conditions file specified but does not exist.")
+            }
+
+            if (grepl(".csv", initial_init_file)){
+                initial_init <- readr::read_csv(initial_init_file,show_col_types = FALSE)
+            }else{
+                initial_init <- arrow::read_parquet(initial_init_file)
             }
+
+            # if the initial conditions file contains a 'date' column, filter for config$start_date
+
+            if("date" %in% colnames(initial_init)){
+
+                initial_init <- initial_init %>%
+                    dplyr::mutate(date = as.POSIXct(date, tz="UTC")) %>%
+                    dplyr::filter(date == as.POSIXct(paste0(config$start_date, " 00:00:00"), tz="UTC"))
+
+                if (nrow(initial_init) == 0) {
+                    stop("ERROR: Initial conditions file specified but does not contain the start date.")
+                }  
+
+            }
+
+            arrow::write_parquet(initial_init, global_files[["init_filename"]])
         }
     }
 

flepimop/R_packages/inference/tests/testthat/test-aggregate_and_calc_loc_likelihoods.R

@@ -195,7 +195,7 @@ test_that("aggregate_and_calc_loc_likelihoods returns a likelihood per location
 
 
     expect_that(nrow(tmp), equals(length(stuff$all_locations)))
-    expect_that(sort(colnames(tmp)), equals(sort(c("ll","accept","accept_prob","accept_avg","filename",stuff$obs_subpop))))
+    expect_that(sort(colnames(tmp)), equals(sort(c("ll","accept","accept_prob","accept_avg",stuff$obs_subpop))))
 
 })
 

flepimop/main_scripts/inference_main.R

@@ -34,7 +34,12 @@ option_list = list(
   optparse::make_option(c("-r", "--rpath"), action="store", default=Sys.getenv("RSCRIPT_PATH","Rscript"), type = 'character', help = "path to R executable"),
   optparse::make_option(c("-R", "--is-resume"), action="store", default=Sys.getenv("RESUME_RUN",FALSE), type = 'logical', help = "Is this run a resume"),
   optparse::make_option(c("-I", "--is-interactive"), action="store", default=Sys.getenv("RUN_INTERACTIVE",Sys.getenv("INTERACTIVE_RUN", FALSE)), type = 'logical', help = "Is this run an interactive run"),
-  optparse::make_option(c("-L", "--reset_chimeric_on_accept"), action = "store", default = Sys.getenv("FLEPI_RESET_CHIMERICS", TRUE), type = 'logical', help = 'Should the chimeric parameters get reset to global parameters when a global acceptance occurs')
+  optparse::make_option(c("-L", "--reset_chimeric_on_accept"), action = "store", default = Sys.getenv("FLEPI_RESET_CHIMERICS", TRUE), type = 'logical', help = 'Should the chimeric parameters get reset to global parameters when a global acceptance occurs'),
+  optparse::make_option(c("-S","--save_seir"), action = "store", default = Sys.getenv("SAVE_SEIR", FALSE), type = 'logical', help = 'Should the SEIR output files be saved for each iteration'),
+  optparse::make_option(c("-H","--save_hosp"), action = "store", default = Sys.getenv("SAVE_HOSP", TRUE), type = 'logical', help = 'Should the HOSP output files be saved for each iteration'),
+  optparse::make_option(c("-M", "--memory_profiling"), action = "store", default = Sys.getenv("FLEPI_MEM_PROFILE", FALSE), type = 'logical', help = 'Should the memory profiling be run during iterations'),
+  optparse::make_option(c("-P", "--memory_profiling_iters"), action = "store", default = Sys.getenv("FLEPI_MEM_PROF_ITERS", 100), type = 'integer', help = 'If doing memory profiling, after every X iterations run the profiler'),
+  optparse::make_option(c("-g", "--subpop_len"), action="store", default=Sys.getenv("SUBPOP_LENGTH", 5), type='integer', help = "number of digits in subpop")
 )
 
 parser=optparse::OptionParser(option_list=option_list)
@@ -114,7 +119,7 @@ foreach(seir_modifiers_scenario = seir_modifiers_scenarios) %:%
     if (nchar(opt$ground_truth_start) > 0) {
       ground_truth_start_text <- c("--ground_truth_start", opt$ground_truth_start)
     }
-    if (nchar(opt$ground_truth_start) > 0) {
+    if (nchar(opt$ground_truth_end) > 0) {
       ground_truth_end_text <- c("--ground_truth_end", opt$ground_truth_end)
     }
 
@@ -139,6 +144,11 @@ foreach(seir_modifiers_scenario = seir_modifiers_scenarios) %:%
         "-R", opt[["is-resume"]],
         "-I", opt[["is-interactive"]],
         "-L", opt$reset_chimeric_on_accept,
+        "-S", opt$save_seir,
+        "-H", opt$save_hosp,
+        "-M", opt$memory_profiling,
+        "-P", opt$memory_profiling_iters,
+        "-g", opt$subpop_len,
         #paste("2>&1 | tee log_inference_slot_",config$name,"_",opt$run_id, "_", flepi_slot, ".txt", sep=""), # works on Mac only, not windows
         #paste("2>&1 | tee model_output/",config$name,"/",opt$run_id,"/log/log_inference_slot", flepi_slot, ".txt", sep=""), # doesn't work because config$name needs to be combined with scenarios to generate the folder name, and, because this command seems to only be able to pipe output to pre-existing folders
         sep = " ")