From 9a4f9ef2789f7a213482110378a5f68c54a94f74 Mon Sep 17 00:00:00 2001 From: Collin Schwantes Date: Tue, 7 Jun 2022 18:10:08 -0500 Subject: [PATCH] fixed issues with global variables, paths, and makeing sure target outputs update with new file paths --- 1- Run RVFV Simulations.R | 4 +++- 2_RVF_LHC_Sensitivity_Analysis.R | 6 +++--- 3- Calculate and Plot_R0.R | 10 +++++----- Functions/Function 7 Manage model outputs.R | 19 ++++++++++++------- _targets.R | 4 ++-- 5 files changed, 25 insertions(+), 18 deletions(-) diff --git a/1- Run RVFV Simulations.R b/1- Run RVFV Simulations.R index 453a927..a42cf75 100644 --- a/1- Run RVFV Simulations.R +++ b/1- Run RVFV Simulations.R @@ -398,7 +398,9 @@ vxp <- (unlist(param_vec["vax"])/(unlist(param_vec["muL"])+ unlist(param_vec["g" save.image(file = rdata_path) - return("RVFV Sim") + return_value <- paste("RVFV Sim:",run_path_target,sep = " ") + + return(return_value) } \ No newline at end of file diff --git a/2_RVF_LHC_Sensitivity_Analysis.R b/2_RVF_LHC_Sensitivity_Analysis.R index 7c9ba04..b82bd11 100644 --- a/2_RVF_LHC_Sensitivity_Analysis.R +++ b/2_RVF_LHC_Sensitivity_Analysis.R @@ -26,8 +26,8 @@ # library(here) RVF_LHC_SA <- function(target, h = 4000){ #Set scenario -SA <- TRUE -h <- h #Number of simulations to run in sensitivity anlaysis +SA <<- TRUE +h <<- h #Number of simulations to run in sensitivity analysis #Source data and code #Functions for setting the hatching switches the data @@ -48,7 +48,7 @@ model_run_path <- target #Set timing start.time <- 0 -end.time <- nrow(All_Precip) +end.time <<- nrow(All_Precip) timestep <- 1 times <- seq(from = start.time, to = end.time, diff --git a/3- Calculate and Plot_R0.R b/3- Calculate and Plot_R0.R index 9b467ac..95a296f 100644 --- a/3- Calculate and Plot_R0.R +++ b/3- Calculate and Plot_R0.R @@ -109,7 +109,7 @@ pts$X <- R0params[x] if(!names(R0params[x])=="biteA"){ stop() } -plot.biteA <- ggplot()+# +plot.biteA <<- ggplot()+# geom_line(data = df_plot, aes(x = Value, y = R0_both, col = "1B"), size = 1, alpha = .5, linetype = "dashed") + geom_line(data = df_plot, aes(x = Value, y = R0_A, col = "2A"), size = 1, alpha = .5, linetype = "dashed") + geom_line(data = df_plot, aes(x = Value, y = R0_C, col = "3C"), size = 1, alpha = .5, linetype = "dashed") + @@ -132,7 +132,7 @@ pts$X <- R0params[x] if(!names(R0params[x])=="q"){ stop() } -plot.q <- ggplot()+# +plot.q <<- ggplot()+# geom_line(data = df_plot, aes(x = Value, y = R0_both, col = "1B"), size = 1, alpha = .5, linetype = "dashed") + geom_line(data = df_plot, aes(x = Value, y = R0_A, col = "2A"), size = 1, alpha = .5, linetype = "dashed") + geom_line(data = df_plot, aes(x = Value, y = R0_C, col = "3C"), size = 1, alpha = .5, linetype = "dashed") + @@ -155,7 +155,7 @@ pts$X <- R0params[x] if(!names(R0params[x])=="Tcsl"){ stop() } -plot.Tcsl <- ggplot()+# +plot.Tcsl <<- ggplot()+# geom_line(data = df_plot, aes(x = Value, y = R0_both, col = "1B"), size = 1, alpha = .5, linetype = "dashed") + geom_line(data = df_plot, aes(x = Value, y = R0_A, col = "2A"), size = 1, alpha = .5, linetype = "dashed") + geom_line(data = df_plot, aes(x = Value, y = R0_C, col = "3C"), size = 1, alpha = .5, linetype = "dashed") + @@ -178,7 +178,7 @@ pts$X <- R0params[x] if(!names(R0params[x])=="muC"){ stop() } -plot.muC <- ggplot()+# +plot.muC <<- ggplot()+# geom_line(data = df_plot, aes(x = Value, y = R0_both, col = "1B"), size = 1, alpha = .5, linetype = "dashed") + geom_line(data = df_plot, aes(x = Value, y = R0_A, col = "2A"), size = 1, alpha = .5, linetype = "dashed") + geom_line(data = df_plot, aes(x = Value, y = R0_C, col = "3C"), size = 1, alpha = .5, linetype = "dashed") + @@ -201,7 +201,7 @@ pts$X <- R0params[x] if(!names(R0params[x])=="biteC"){ stop() } -plot.biteC <- ggplot()+# +plot.biteC <<- ggplot()+# geom_line(data = df_plot, aes(x = Value, y = R0_both, col = "1B"), size = 1, alpha = .5, linetype = "dashed") + geom_line(data = df_plot, aes(x = Value, y = R0_A, col = "2A"), size = 1, alpha = .5, linetype = "dashed") + geom_line(data = df_plot, aes(x = Value, y = R0_C, col = "3C"), size = 1, alpha = .5, linetype = "dashed") + diff --git a/Functions/Function 7 Manage model outputs.R b/Functions/Function 7 Manage model outputs.R index 44ce275..cfd7ca4 100644 --- a/Functions/Function 7 Manage model outputs.R +++ b/Functions/Function 7 Manage model outputs.R @@ -1,8 +1,8 @@ ## create folder for outputs from hash of params vector -get_run_id <- function(){ - rlang::hash(Sys.time()) +get_run_id <- function(value = Sys.time()){ + rlang::hash(value) } create_model_folders <- function(run_id,overwrite = FALSE){ @@ -10,7 +10,7 @@ create_model_folders <- function(run_id,overwrite = FALSE){ dir.create(folder_path,recursive = TRUE) ## Create set of subfolders for different outputs ---- - sub_folders <- c("Publication_Figures/Draft_Figures","Data for sensistivity analysis" ) + sub_folders <- c("Publication_Figures/Draft_Figures","Data for sensitivity analyses" ) for(folder in sub_folders){ sub_folder_path <- sprintf("%s/%s", folder_path, folder) @@ -25,8 +25,8 @@ write_model_run_path <- function(folder_path){ saveRDS(object = folder_path,"model_runs/current_run_path.RDS") } -create_model_run_path <- function(){ - run_id <- get_run_id() +create_model_run_path <- function(value = Sys.time()){ + run_id <- get_run_id(value) print(sprintf("Model run id: %s", run_id)) folder_path <- create_model_folders(run_id) @@ -47,10 +47,15 @@ read_model_run_path <- function(){ delete_model_run_path <- function(target,...){ dep_obj <- paste(target,...,collapse = ", ") + pathRemoved <- readRDS("model_runs/current_run_path.RDS") unlink("model_runs/current_run_path.RDS") - message("Current_run_path.RDS removed. + message(glue::glue("Current_run_path.RDS removed. + Any outputs were saved in {pathRemoved} + Use set_model_run_path to interactively - set the model run path") + set the model run path")) + + return("current_run_path.RDS removed") } diff --git a/_targets.R b/_targets.R index 3d6c9b6..f779d8f 100644 --- a/_targets.R +++ b/_targets.R @@ -40,8 +40,8 @@ list( ), tar_target( name = b_LHC_SA, - command = RVF_LHC_SA(Create_Run_Path, h = 1), - cue = targets::tar_cue("never") ## takes around 100hrs on 8 core machine + command = RVF_LHC_SA(Create_Run_Path, h = 1) + #cue = targets::tar_cue("never") ## 4k sims takes around 100hrs on 8 core machine ), tar_target( name = c_Calc_Plot_R0,