Merge PR #913 from facebookexperimental/allocator_csv

fix: avoid overwriting csv when scenario changes
fix: check_factorvars() for context vars only and paid_media_spends & organic must be numeric
fix: only check for plot_folder when exporting
fix: min_var as a parameter, not fixed + document()
fix: missing space in allocator's title
fix: warning in geom_density_ridges_gradient. No parameter named size

R/DESCRIPTION

@@ -1,7 +1,7 @@
 Package: Robyn
 Type: Package
 Title: Semi-Automated Marketing Mix Modeling (MMM) from Meta Marketing Science 
-Version: 3.10.5.9012
+Version: 3.10.5.9013
 Authors@R: c(
     person("Gufeng", "Zhou", , "[email protected]", c("cre","aut")),
     person("Leonel", "Sentana", , "[email protected]", c("aut")),

R/R/allocator.R

@@ -759,7 +759,7 @@ robyn_allocator <- function(robyn_object = NULL,
     if (dep_var_type == "conversion") {
       colnames(export_dt_optimOut) <- gsub("Roi", "CPA", colnames(export_dt_optimOut))
     }
-    write.csv(export_dt_optimOut, paste0(plot_folder, select_model, "_reallocated.csv"))
+    write.csv(export_dt_optimOut, paste0(plot_folder, select_model, "_", scenario, "_reallocated.csv"))
   }
 
   ## Plot allocator results

R/R/checks.R

@@ -279,6 +279,10 @@ check_paidmedia <- function(dt_input, paid_media_vars, paid_media_signs, paid_me
   if (!all(is_num)) {
     stop("All your 'paid_media_vars' must be numeric. Check: ", v2t(paid_media_vars[!is_num]))
   }
+  is_num <- unlist(lapply(dt_input[, paid_media_spends], is.numeric))
+  if (!all(is_num)) {
+    stop("All your 'paid_media_spends' must be numeric. Check: ", v2t(paid_media_spends[!is_num]))
+  }
   get_cols <- any(dt_input[, unique(c(paid_media_vars, paid_media_spends))] < 0)
   if (get_cols) {
     check_media_names <- unique(c(paid_media_vars, paid_media_spends))
@@ -319,14 +323,17 @@ check_organicvars <- function(dt_input, organic_vars, organic_signs) {
   if (length(organic_signs) != length(organic_vars)) {
     stop("Input 'organic_signs' must have same length as 'organic_vars'")
   }
+  is_num <- unlist(lapply(dt_input[, organic_vars], is.numeric))
+  if (!all(is_num)) {
+    stop("All your 'organic_vars' must be numeric. Check: ", v2t(organic_vars[!is_num]))
+  }
   return(invisible(list(organic_signs = organic_signs)))
 }
 
-check_factorvars <- function(dt_input, factor_vars = NULL, context_vars = NULL, organic_vars = NULL) {
+check_factorvars <- function(dt_input, factor_vars = NULL, context_vars = NULL) {
   check_vector(factor_vars)
   check_vector(context_vars)
-  check_vector(organic_vars)
-  temp <- select(dt_input, all_of(c(context_vars, organic_vars)))
+  temp <- select(dt_input, all_of(context_vars))
   are_not_numeric <- !sapply(temp, is.numeric)
   if (any(are_not_numeric)) {
     these <- are_not_numeric[!names(are_not_numeric) %in% factor_vars]
@@ -337,8 +344,8 @@ check_factorvars <- function(dt_input, factor_vars = NULL, context_vars = NULL,
     }
   }
   if (!is.null(factor_vars)) {
-    if (!all(factor_vars %in% c(context_vars, organic_vars))) {
-      stop("Input 'factor_vars' must be any from 'context_vars' or 'organic_vars' inputs")
+    if (!all(factor_vars %in% context_vars)) {
+      stop("Input 'factor_vars' must be any from 'context_vars' inputs")
     }
   }
   return(factor_vars)

R/R/clusters.R

@@ -41,7 +41,7 @@
 robyn_clusters <- function(input, dep_var_type,
                            cluster_by = "hyperparameters",
                            all_media = NULL,
-                           k = "auto", limit = 1,
+                           k = "auto", wss_var = 0.05, limit = 1,
                            weights = rep(1, 3), dim_red = "PCA",
                            quiet = FALSE, export = FALSE, seed = 123,
                            ...) {
@@ -88,20 +88,19 @@ robyn_clusters <- function(input, dep_var_type,
       }
     )
     # if (is.null(cls)) return(NULL)
-    min_var <- 0.05
     k <- cls$nclusters %>%
       mutate(
         pareto = .data$wss / .data$wss[1],
         dif = lag(.data$pareto) - .data$pareto
       ) %>%
-      filter(.data$dif > min_var) %>%
+      filter(.data$dif > wss_var) %>%
       pull(.data$n) %>%
       max(., na.rm = TRUE)
     if (k < min_clusters) k <- min_clusters
     if (!quiet) {
       message(sprintf(
         ">> Auto selected k = %s (clusters) based on minimum WSS variance of %s%%",
-        k, min_var * 100
+        k, wss_var * 100
       ))
     }
   }
@@ -363,7 +362,7 @@ errors_scores <- function(df, balance = rep(1, 3), ts_validation = TRUE, ...) {
   p <- ggplot(sim_collect, aes(x = .data$x_sim, y = .data$rn)) +
     facet_wrap(~ .data$cluster_title, scales = "free_x") +
     xlim(range(sim_collect$x_sim)) +
-    geom_density_ridges_gradient(scale = 3, rel_min_height = 0.01, size = 0.1) +
+    geom_density_ridges_gradient(scale = 3, rel_min_height = 0.01) +
     geom_text(
       data = df_ci,
       aes(x = .data$boot_mean, y = .data$rn, label = .data$boot_ci),

R/R/inputs.R

@@ -235,7 +235,7 @@ robyn_inputs <- function(dt_input = NULL,
     organic_signs <- organic$organic_signs
 
     ## Check factor_vars
-    factor_vars <- check_factorvars(dt_input, factor_vars, context_vars, organic_vars)
+    factor_vars <- check_factorvars(dt_input, factor_vars, context_vars)
 
     ## Check all vars
     all_media <- c(paid_media_spends, organic_vars)

R/R/outputs.R

@@ -56,7 +56,7 @@ robyn_outputs <- function(InputCollect, OutputModels,
                           refresh = FALSE, ...) {
   t0 <- Sys.time()
   if (is.null(plot_folder)) plot_folder <- getwd()
-  plot_folder <- check_dir(plot_folder)
+  if (export) plot_folder <- check_dir(plot_folder)
 
   # Check calibration constrains
   calibrated <- !is.null(InputCollect$calibration_input)

R/R/plots.R

@@ -799,7 +799,7 @@ allocation_plots <- function(
     geom_bar(stat = "identity", width = 0.6, alpha = 0.7) +
     geom_text(aes(label = formatNum(.data$value, signif = 3, abbr = TRUE)), color = "black", vjust = -.5) +
     theme_lares(background = "white", legend = "none") +
-    labs(title = paste0("Total Budget Optimization Result (scaled up to",
+    labs(title = paste0("Total Budget Optimization Result (scaled up to ",
                         unique(dt_optimOut$periods), ")"), fill = NULL, y = NULL, x = NULL) +
     scale_y_continuous(limits = c(0, max(df_roi$value_norm * 1.2))) +
     theme(axis.text.y = element_blank())