fix: when user customizes non-existing plot_folder #506

facebookexperimental · Oct 4, 2022 · 8398f12 · 8398f12
1 parent 6587f65
commit 8398f12
Show file tree

Hide file tree

Showing 4 changed files with 8 additions and 5 deletions.
diff --git a/R/R/checks.R b/R/R/checks.R
@@ -636,7 +636,7 @@ check_filedir <- function(plot_folder) {
   }
   if (!dir.exists(plot_folder)) {
     plot_folder <- getwd()
-    message("Provided 'plot_folder' doesn't exist. Using current working directory: ", plot_folder)
+    message("WARNING: Provided 'plot_folder' doesn't exist. Using current working directory: ", plot_folder)
   }
   return(plot_folder)
 }

diff --git a/R/R/json.R b/R/R/json.R
@@ -84,7 +84,7 @@ robyn_write <- function(InputCollect,
     select_model <- "inputs"
   }
 
-  if (!dir.exists(dir)) dir.create(dir)
+  if (!dir.exists(dir)) dir.create(dir, recursive = TRUE)
   filename <- sprintf("%s/RobynModel-%s.json", dir, select_model)
   filename <- gsub("//", "/", filename)
   class(ret) <- c("robyn_write", class(ret))
@@ -261,6 +261,7 @@ robyn_chain <- function(json_file) {
   plot_folder <- json_data$ExportedModel$plot_folder
   temp <- stringr::str_split(plot_folder, "/")[[1]]
   chain <- temp[startsWith(temp, "Robyn_")]
+  if (length(chain) == 0) chain <- tail(temp[temp != ""], 1)
   base_dir <- gsub(sprintf("\\/%s.*", chain[1]), "", plot_folder)
   chainData <- list()
   for (i in rev(seq_along(chain))) {

diff --git a/R/R/outputs.R b/R/R/outputs.R
@@ -134,7 +134,7 @@ robyn_outputs <- function(InputCollect, OutputModels,
   OutputCollect$plot_folder <- gsub("//", "/", plotPath)
 
   if (export) {
-    dir.create(OutputCollect$plot_folder)
+    if (!dir.exists(OutputCollect$plot_folder)) dir.create(OutputCollect$plot_folder, recursive = TRUE)
     tryCatch(
       {
         if (!quiet) message(paste0(">>> Collecting ", length(allSolutions), " pareto-optimum results into: ", OutputCollect$plot_folder))

diff --git a/R/R/plots.R b/R/R/plots.R
@@ -929,7 +929,9 @@ refresh_plots_json <- function(OutputCollectRF, json_file, export = TRUE) {
     group_by(.data$solID, .data$label, .data$variable) %>%
     summarise_all(sum)
 
-  outputs[["pBarRF"]] <- pBarRF <- ggplot(df, aes(y = .data$variable)) +
+  df <- replace(df, is.na(df), 0)
+  outputs[["pBarRF"]] <- pBarRF <- df %>%
+    ggplot(aes(y = .data$variable)) +
     geom_col(aes(x = .data$decompPer)) +
     geom_text(aes(
       x = .data$decompPer,
@@ -945,7 +947,7 @@ refresh_plots_json <- function(OutputCollectRF, json_file, export = TRUE) {
     na.rm = TRUE, hjust = -0.4, size = 2.8, colour = "#39638b"
     ) +
     facet_wrap(. ~ .data$label, scales = "free") +
-    scale_x_percent(limits = c(0, max(df$performance, na.rm = TRUE) * 1.2)) +
+    # scale_x_percent(limits = c(0, max(df$performance, na.rm = TRUE) * 1.2)) +
     labs(
       title = paste(
         "Model refresh: Decomposition & Paid Media",