From 6188d29f4c86c7075770e6d08321713b78f97174 Mon Sep 17 00:00:00 2001 From: laresbernardo Date: Fri, 1 Dec 2023 11:37:40 +0100 Subject: [PATCH 01/11] fix: check_metric_dates's dynamic quiet on robyn_allocator() --- R/DESCRIPTION | 2 +- R/R/allocator.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/DESCRIPTION b/R/DESCRIPTION index 9f8d7542a..b8bda6c1a 100644 --- a/R/DESCRIPTION +++ b/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.9008 +Version: 3.10.5.9009 Authors@R: c( person("Gufeng", "Zhou", , "gufeng@meta.com", c("cre","aut")), person("Leonel", "Sentana", , "leonelsentana@meta.com", c("aut")), diff --git a/R/R/allocator.R b/R/R/allocator.R index 009ff3609..fbfc8ae85 100644 --- a/R/R/allocator.R +++ b/R/R/allocator.R @@ -212,7 +212,7 @@ robyn_allocator <- function(robyn_object = NULL, # Spend values based on date range set window_loc <- InputCollect$rollingWindowStartWhich:InputCollect$rollingWindowEndWhich dt_optimCost <- slice(InputCollect$dt_mod, window_loc) - new_date_range <- check_metric_dates(date_range, dt_optimCost$ds, InputCollect$dayInterval, quiet = FALSE, is_allocator = TRUE) + new_date_range <- check_metric_dates(date_range, dt_optimCost$ds, InputCollect$dayInterval, quiet = quiet, is_allocator = TRUE) date_min <- head(new_date_range$date_range_updated, 1) date_max <- tail(new_date_range$date_range_updated, 1) check_daterange(date_min, date_max, dt_optimCost$ds) From d31e01c3f975ee1c486180a5b7d9d6e1cc527a5f Mon Sep 17 00:00:00 2001 From: laresbernardo Date: Thu, 7 Dec 2023 17:57:55 +0100 Subject: [PATCH 02/11] docs: commented code to try robyn_modelselector() --- demo/demo.R | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/demo/demo.R b/demo/demo.R index 053a1c9d4..95b6bb1dd 100644 --- a/demo/demo.R +++ b/demo/demo.R @@ -339,6 +339,16 @@ print(OutputCollect) ################################################################ #### Step 4: Select and save the any model +### Using lares >= 5.2.4, you can try this to help you pick a model: +### (Update dev version with lares::updateLares()) +# lares::robyn_modelselector( +# InputCollect, +# OutputCollect, +# metrics = c("rsq_train", "performance", "potential_improvement", +# "non_zeroes", "incluster_models"), +# wt = c(2, 1, 1, 1, 0.1) +# ) + ## Compare all model one-pagers and select one that mostly reflects your business reality print(OutputCollect) select_model <- "1_122_7" # Pick one of the models from OutputCollect to proceed From 34c2cf906149f8ac11301837395372113e5b1d2f Mon Sep 17 00:00:00 2001 From: laresbernardo Date: Thu, 7 Dec 2023 18:07:08 +0100 Subject: [PATCH 03/11] fix: Warning in rnorm(sim_n, mean = boot_mean, sd = boot_se) : NAs produced --- R/R/clusters.R | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/R/R/clusters.R b/R/R/clusters.R index 9ada23a71..d4379bb55 100644 --- a/R/R/clusters.R +++ b/R/R/clusters.R @@ -198,9 +198,9 @@ confidence_calcs <- function( v_samp <- df_chn$roi_total } boot_res <- .bootci(samp = v_samp, boot_n = boot_n) - boot_mean <- mean(boot_res$boot_means) + boot_mean <- mean(boot_res$boot_means, na.rm = TRUE) boot_se <- boot_res$se - ci_low <- ifelse(boot_res$ci[1] < 0, 0, boot_res$ci[1]) + ci_low <- ifelse(boot_res$ci[1] <= 0, 0, boot_res$ci[1]) ci_up <- boot_res$ci[2] # Collect loop results @@ -218,7 +218,7 @@ confidence_calcs <- function( rn = i, n = length(v_samp), boot_mean = boot_mean, - x_sim = rnorm(sim_n, mean = boot_mean, sd = boot_se) + x_sim = suppressWarnings(rnorm(sim_n, mean = boot_mean, sd = boot_se)) ) %>% mutate(y_sim = dnorm(.data$x_sim, mean = boot_mean, sd = boot_se)) } @@ -430,8 +430,7 @@ errors_scores <- function(df, balance = rep(1, 3), ts_validation = TRUE, ...) { .bootci <- function(samp, boot_n, seed = 1, ...) { set.seed(seed) - - if (length(samp) > 1) { + if (length(samp[!is.na(samp)]) > 1) { samp_n <- length(samp) samp_mean <- mean(samp, na.rm = TRUE) boot_sample <- matrix( @@ -451,6 +450,6 @@ errors_scores <- function(df, balance = rep(1, 3), ts_validation = TRUE, ...) { return(list(boot_means = boot_means, ci = ci, se = se)) } else { - return(list(boot_means = samp, ci = c(NA, NA), se = NA)) + return(list(boot_means = samp, ci = c(samp, samp), se = 0)) } } From b40abf7246ae550fb59daf3fd9b90a2d7fed682c Mon Sep 17 00:00:00 2001 From: laresbernardo Date: Thu, 7 Dec 2023 18:22:14 +0100 Subject: [PATCH 04/11] fix: Warning in max(data$x, na.rm = TRUE) :no non-missing arguments to max; returning -Inf --- R/R/clusters.R | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/R/R/clusters.R b/R/R/clusters.R index d4379bb55..9520078ca 100644 --- a/R/R/clusters.R +++ b/R/R/clusters.R @@ -155,10 +155,11 @@ robyn_clusters <- function(input, dep_var_type, get_height <- ceiling(k / 2) / 2 db <- (output$plot_clusters_ci / (output$plot_models_rois + output$plot_models_errors)) + patchwork::plot_layout(heights = c(get_height, 1), guides = "collect") - # Suppressing "Picking joint bandwidth of x" messages - suppressMessages(ggsave(paste0(path, "pareto_clusters_detail.png"), + # Suppressing "Picking joint bandwidth of x" messages + + # In min(data$x, na.rm = TRUE) : no non-missing arguments to min; returning Inf warnings + suppressMessages(suppressWarnings(ggsave(paste0(path, "pareto_clusters_detail.png"), plot = db, dpi = 500, width = 12, height = 4 + length(all_paid) * 2, limitsize = FALSE - )) + ))) } return(output) @@ -331,12 +332,18 @@ errors_scores <- function(df, balance = rep(1, 3), ts_validation = TRUE, ...) { .min_max_norm <- function(x, min = 0, max = 1) { x <- x[is.finite(x)] - if (length(x) == 1) { + x <- x[!is.na(x)] + if (length(x) <= 1) { return(x) - } # return((max - min) / 2) + } a <- min(x, na.rm = TRUE) b <- max(x, na.rm = TRUE) - (max - min) * (x - a) / (b - a) + min + den <- ((b - a) + min) + if (den != 0) { + return((max - min) * (x - a) / den) + } else { + return(x) + } } .clusters_df <- function(df, all_paid, balance = rep(1, 3), limit = 1, ts_validation = TRUE, ...) { From 394e9f2e891586253bb2c9a0eb56bf55f44266b9 Mon Sep 17 00:00:00 2001 From: laresbernardo Date: Thu, 7 Dec 2023 19:26:07 +0100 Subject: [PATCH 05/11] docs: lares >= 5.2.4 on CRAN --- demo/demo.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/demo/demo.R b/demo/demo.R index 95b6bb1dd..ba43af741 100644 --- a/demo/demo.R +++ b/demo/demo.R @@ -340,7 +340,7 @@ print(OutputCollect) #### Step 4: Select and save the any model ### Using lares >= 5.2.4, you can try this to help you pick a model: -### (Update dev version with lares::updateLares()) +### (Update to stable or dev version using lares::updateLares()) # lares::robyn_modelselector( # InputCollect, # OutputCollect, From 1905538690761a9e34c481163bbe5d089e5df4e2 Mon Sep 17 00:00:00 2001 From: laresbernardo Date: Fri, 8 Dec 2023 17:58:29 +0100 Subject: [PATCH 06/11] docs: add commented robyn_hypsbuilder() example in demo.R --- demo/demo.R | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/demo/demo.R b/demo/demo.R index ba43af741..a2b086ec8 100644 --- a/demo/demo.R +++ b/demo/demo.R @@ -200,6 +200,15 @@ hyperparameters <- list( # facebook_S_shapes = c(0, 10) # facebook_S_scales = c(0, 0.1) +### Using lares >= 5.2.4, you can build default hyperparameters for paid media and organic vars +### (Update to stable or dev version using lares::updateLares()) +# hyperparameters <- lares::robyn_hypsbuilder( +# channels = c(InputCollect$paid_media_spends, InputCollect$organic_vars), +# media_type = c("offline", "offline", "offline", "online", "online", "online"), +# adstock = InputCollect$adstock, +# date_type = paste0(InputCollect$intervalType, "ly"), +# lagged = FALSE) + #### 2a-3: Third, add hyperparameters into robyn_inputs() InputCollect <- robyn_inputs(InputCollect = InputCollect, hyperparameters = hyperparameters) @@ -346,7 +355,7 @@ print(OutputCollect) # OutputCollect, # metrics = c("rsq_train", "performance", "potential_improvement", # "non_zeroes", "incluster_models"), -# wt = c(2, 1, 1, 1, 0.1) +# wt = c(3, 1, 1, 1, 0.1) # ) ## Compare all model one-pagers and select one that mostly reflects your business reality From 546d2363b7d4b64a9760b77a021d0e4dd127f9ea Mon Sep 17 00:00:00 2001 From: laresbernardo Date: Mon, 11 Dec 2023 10:19:43 +0100 Subject: [PATCH 07/11] feat: warn when rewriting hyps and could be un-intentional given the user is providing them --- R/R/inputs.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/R/inputs.R b/R/R/inputs.R index e1f676942..f5da8f05b 100644 --- a/R/R/inputs.R +++ b/R/R/inputs.R @@ -177,7 +177,10 @@ robyn_inputs <- function(dt_input = NULL, ### Use case 3: running robyn_inputs() with json_file if (!is.null(json_file)) { json <- robyn_read(json_file, step = 1, ...) - if (is.null(dt_input) || is.null(dt_holidays)) stop("Provide 'dt_input' and 'dt_holidays'") + if (is.null(dt_input)) stop("Must provide 'dt_input' input; 'dt_holidays' input optional") + if (!is.null(hyperparameters)) { + warning("Replaced hyperparameters input with json_file's fixed hyperparameters values") + } for (i in seq_along(json$InputCollect)) { assign(names(json$InputCollect)[i], json$InputCollect[[i]]) } From ffa5a7c66464ae7bec424b9483061cc278bc51ea Mon Sep 17 00:00:00 2001 From: laresbernardo Date: Wed, 13 Dec 2023 15:06:21 +0100 Subject: [PATCH 08/11] feat: enable ... to be exported as Extras in robyn_write() --- R/R/json.R | 8 ++++++-- R/man/robyn_write.Rd | 2 +- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/R/R/json.R b/R/R/json.R index 643a28133..4caf2b8b5 100644 --- a/R/R/json.R +++ b/R/R/json.R @@ -19,7 +19,7 @@ #' into the JSON file? #' @param dir Character. Existing directory to export JSON file to. #' @param pareto_df Dataframe. Save all pareto solutions to json file. -#' @param ... Additional parameters. +#' @param ... Additional parameters to export into a custom Extras element. #' @examples #' \dontrun{ #' InputCollectJSON <- robyn_inputs( @@ -44,7 +44,6 @@ robyn_write <- function(InputCollect, stopifnot(inherits(InputCollect, "robyn_inputs")) if (!is.null(OutputCollect)) { stopifnot(inherits(OutputCollect, "robyn_outputs")) - stopifnot(select_model %in% OutputCollect$allSolutions) if (is.null(select_model) && length(OutputCollect$allSolutions == 1)) { select_model <- OutputCollect$allSolutions } @@ -85,6 +84,7 @@ robyn_write <- function(InputCollect, # Model associated data if (length(select_model) == 1) { + stopifnot(select_model %in% OutputCollect$allSolutions) outputs <- list() outputs$select_model <- select_model outputs$summary <- filter(OutputCollect$xDecompAgg, .data$solID == select_model) %>% @@ -114,6 +114,10 @@ robyn_write <- function(InputCollect, select_model <- "inputs" } + if (length(list(...)) > 0) { + ret[["Extras"]] <- list(...) + } + if (!dir.exists(dir) & export) dir.create(dir, recursive = TRUE) filename <- sprintf("%s/RobynModel-%s.json", dir, select_model) filename <- gsub("//", "/", filename) diff --git a/R/man/robyn_write.Rd b/R/man/robyn_write.Rd index 86a321466..999beefab 100644 --- a/R/man/robyn_write.Rd +++ b/R/man/robyn_write.Rd @@ -43,7 +43,7 @@ into the JSON file?} \item{pareto_df}{Dataframe. Save all pareto solutions to json file.} -\item{...}{Additional parameters.} +\item{...}{Additional parameters to export into a custom Extras element.} \item{x}{\code{robyn_read()} or \code{robyn_write()} output.} From 4caf2f73847f93724a4bee3a2d611a3028e0f68c Mon Sep 17 00:00:00 2001 From: laresbernardo Date: Wed, 13 Dec 2023 17:46:32 +0100 Subject: [PATCH 09/11] feat: new baseline_level parameter for one-pagers to allow aggregations --- R/R/auxiliary.R | 18 ++++++++++++++++++ R/R/plots.R | 28 ++++++++++++++++++++++++++-- R/man/robyn_outputs.Rd | 7 +++++++ 3 files changed, 51 insertions(+), 2 deletions(-) diff --git a/R/R/auxiliary.R b/R/R/auxiliary.R index 401f4a44b..847de5174 100644 --- a/R/R/auxiliary.R +++ b/R/R/auxiliary.R @@ -71,3 +71,21 @@ robyn_update <- function(dev = TRUE, ...) { utils::install.packages("Robyn", ...) } } + +# Merge baseline variables based on baseline_level param input +baseline_vars <- function(InputCollect, baseline_level) { + stopifnot(length(baseline_level) == 1) + stopifnot(baseline_level %in% 0:5) + x <- "" + if (baseline_level >= 1) + x <- c(x, "(Intercept)") + if (baseline_level >= 2) + x <- c(x, "trend") + if (baseline_level >= 3) + x <- unique(c(x, InputCollect$prophet_vars)) + if (baseline_level >= 4) + x <- c(x, InputCollect$context_vars) + if (baseline_level >= 5) + x <- c(x, InputCollect$organic_vars) + return(x) +} diff --git a/R/R/plots.R b/R/R/plots.R index 3bd93ff03..56d2c45c9 100644 --- a/R/R/plots.R +++ b/R/R/plots.R @@ -242,12 +242,18 @@ robyn_plots <- function( #' Generate and Export Robyn One-Pager Plots #' #' @rdname robyn_outputs +#' @param baseline_level Integer, from 0 to 5. Aggregate baseline variables, +#' depending on the level of aggregation you need. Default is 0 for no +#' aggregation. 1 for Intercept only. 2 adding trend. 3 adding all prophet +#' decomposition variables. 4. Adding contextual variables. 5 Adding organic +#' variables. Results will be reflected on the waterfall chart. #' @return Invisible list with \code{patchwork} plot(s). #' @export robyn_onepagers <- function( InputCollect, OutputCollect, select_model = NULL, quiet = FALSE, - export = TRUE, plot_folder = OutputCollect$plot_folder, ...) { + export = TRUE, plot_folder = OutputCollect$plot_folder, + baseline_level = 0, ...) { check_class("robyn_outputs", OutputCollect) if (TRUE) { pareto_fronts <- OutputCollect$pareto_fronts @@ -266,6 +272,9 @@ robyn_onepagers <- function( } } + # Baseline variables + bvars <- baseline_vars(InputCollect, baseline_level) + # Prepare for parallel plotting if (check_parallel_plot() && OutputCollect$cores > 1) registerDoParallel(OutputCollect$cores) else registerDoSEQ() if (!hyper_fixed) { @@ -381,7 +390,22 @@ robyn_onepagers <- function( ) ## 2. Waterfall - plotWaterfallLoop <- temp[[sid]]$plot2data$plotWaterfallLoop + plotWaterfallLoop <- temp[[sid]]$plot2data$plotWaterfallLoop %>% + mutate(rn = ifelse( + .data$rn %in% bvars, paste0("Baseline_L", baseline_level), as.character(.data$rn))) %>% + group_by(.data$rn) %>% + summarise(xDecompAgg = sum(.data$xDecompAgg, na.rm = TRUE), + xDecompPerc = sum(.data$xDecompPerc, na.rm = TRUE)) %>% + arrange(.data$xDecompPerc) %>% + mutate( + end = 1 - cumsum(.data$xDecompPerc), + start = lag(.data$end), + start = ifelse(is.na(.data$start), 1, .data$start), + id = row_number(), + rn = as.factor(as.character(.data$rn)), + sign = as.factor(ifelse(.data$xDecompPerc >= 0, "Positive", "Negative")) + ) + p2 <- suppressWarnings( ggplot(plotWaterfallLoop, aes(x = .data$id, fill = .data$sign)) + geom_rect(aes( diff --git a/R/man/robyn_outputs.Rd b/R/man/robyn_outputs.Rd index 679bf0e7d..c48d83a4a 100644 --- a/R/man/robyn_outputs.Rd +++ b/R/man/robyn_outputs.Rd @@ -54,6 +54,7 @@ robyn_onepagers( quiet = FALSE, export = TRUE, plot_folder = OutputCollect$plot_folder, + baseline_level = 0, ... ) @@ -111,6 +112,12 @@ wish to plot the one-pagers and export? Default will take top \item{calibrated}{Logical} +\item{baseline_level}{Integer, from 0 to 5. Aggregate baseline variables, +depending on the level of aggregation you need. Default is 0 for no +aggregation. 1 for Intercept only. 2 adding trend. 3 adding all prophet +decomposition variables. 4. Adding contextual variables. 5 Adding organic +variables. Results will be reflected on the waterfall chart.} + \item{solID}{Character vector. Model IDs to plot.} \item{exclude}{Character vector. Manually exclude variables from plot.} From 0014dd4409bbb46e0d3e964a9406ac1931c4e23d Mon Sep 17 00:00:00 2001 From: laresbernardo Date: Thu, 14 Dec 2023 09:22:37 +0100 Subject: [PATCH 10/11] docs: remove concept lares functions from demo.R --- demo/demo.R | 19 ------------------- 1 file changed, 19 deletions(-) diff --git a/demo/demo.R b/demo/demo.R index a2b086ec8..053a1c9d4 100644 --- a/demo/demo.R +++ b/demo/demo.R @@ -200,15 +200,6 @@ hyperparameters <- list( # facebook_S_shapes = c(0, 10) # facebook_S_scales = c(0, 0.1) -### Using lares >= 5.2.4, you can build default hyperparameters for paid media and organic vars -### (Update to stable or dev version using lares::updateLares()) -# hyperparameters <- lares::robyn_hypsbuilder( -# channels = c(InputCollect$paid_media_spends, InputCollect$organic_vars), -# media_type = c("offline", "offline", "offline", "online", "online", "online"), -# adstock = InputCollect$adstock, -# date_type = paste0(InputCollect$intervalType, "ly"), -# lagged = FALSE) - #### 2a-3: Third, add hyperparameters into robyn_inputs() InputCollect <- robyn_inputs(InputCollect = InputCollect, hyperparameters = hyperparameters) @@ -348,16 +339,6 @@ print(OutputCollect) ################################################################ #### Step 4: Select and save the any model -### Using lares >= 5.2.4, you can try this to help you pick a model: -### (Update to stable or dev version using lares::updateLares()) -# lares::robyn_modelselector( -# InputCollect, -# OutputCollect, -# metrics = c("rsq_train", "performance", "potential_improvement", -# "non_zeroes", "incluster_models"), -# wt = c(3, 1, 1, 1, 0.1) -# ) - ## Compare all model one-pagers and select one that mostly reflects your business reality print(OutputCollect) select_model <- "1_122_7" # Pick one of the models from OutputCollect to proceed From f945da901f1343cfd9a5cc5b669728634e31e986 Mon Sep 17 00:00:00 2001 From: laresbernardo Date: Thu, 14 Dec 2023 11:18:58 +0100 Subject: [PATCH 11/11] fix: den > 0 without min --- R/R/clusters.R | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/R/R/clusters.R b/R/R/clusters.R index 9520078ca..7faddad01 100644 --- a/R/R/clusters.R +++ b/R/R/clusters.R @@ -338,9 +338,8 @@ errors_scores <- function(df, balance = rep(1, 3), ts_validation = TRUE, ...) { } a <- min(x, na.rm = TRUE) b <- max(x, na.rm = TRUE) - den <- ((b - a) + min) - if (den != 0) { - return((max - min) * (x - a) / den) + if (b - a != 0) { + return((max - min) * (x - a) / (b - a) + min) } else { return(x) }