styler for all scripts

Author: gufengzhou

R/R/allocator.R

@@ -108,7 +108,6 @@ robyn_allocator <- function(robyn_object = NULL,
                             quiet = FALSE,
                             ui = FALSE,
                             ...) {
-
   ### Use previously exported model using json_file
   if (!is.null(json_file)) {
     if (is.null(InputCollect)) {
@@ -141,12 +140,12 @@ robyn_allocator <- function(robyn_object = NULL,
   #   OutputCollect <- imported$OutputCollect
   #   select_model <- imported$select_model
   # } else {
-    if (is.null(select_model) && length(OutputCollect$allSolutions == 1)) {
-      select_model <- OutputCollect$allSolutions
-    }
-    if (any(is.null(InputCollect), is.null(OutputCollect), is.null(select_model))) {
-      stop("When 'robyn_object' is not provided, then InputCollect, OutputCollect, select_model must be provided")
-    }
+  if (is.null(select_model) && length(OutputCollect$allSolutions == 1)) {
+    select_model <- OutputCollect$allSolutions
+  }
+  if (any(is.null(InputCollect), is.null(OutputCollect), is.null(select_model))) {
+    stop("When 'robyn_object' is not provided, then InputCollect, OutputCollect, select_model must be provided")
+  }
   # }
 
   if (length(InputCollect$paid_media_spends) <= 1) {
@@ -238,9 +237,12 @@ robyn_allocator <- function(robyn_object = NULL,
   simulation_period <- initial_mean_period <- unlist(summarise_all(select(histFiltered, any_of(mediaSpendSorted)), length))
   nDates <- lapply(mediaSpendSorted, function(x) histFiltered$ds)
   names(nDates) <- mediaSpendSorted
-  if (!quiet) message(sprintf(
-    "Date Window: %s:%s (%s %ss)",
-    date_min, date_max, unique(initial_mean_period), InputCollect$intervalType))
+  if (!quiet) {
+    message(sprintf(
+      "Date Window: %s:%s (%s %ss)",
+      date_min, date_max, unique(initial_mean_period), InputCollect$intervalType
+    ))
+  }
   zero_spend_channel <- names(histSpendWindow[histSpendWindow == 0])
 
   initSpendUnitTotal <- sum(initSpendUnit)
@@ -359,14 +361,19 @@ robyn_allocator <- function(robyn_object = NULL,
   skip_these <- (channel_constr_low == 0 & channel_constr_up == 0)
   zero_constraint_channel <- mediaSpendSorted[skip_these]
   if (any(skip_these) && !quiet) {
-    message("Excluded variables (constrained to 0): ",
-            paste(zero_constraint_channel, collapse = ", "))
+    message(
+      "Excluded variables (constrained to 0): ",
+      paste(zero_constraint_channel, collapse = ", ")
+    )
   }
   if (!all(coefSelectorSorted)) {
     zero_coef_channel <- setdiff(names(coefSelectorSorted), mediaSpendSorted[coefSelectorSorted])
-    if (!quiet) message(
-      "Excluded variables (coefficients are 0): ",
-      paste(zero_coef_channel, collapse = ", "))
+    if (!quiet) {
+      message(
+        "Excluded variables (coefficients are 0): ",
+        paste(zero_coef_channel, collapse = ", ")
+      )
+    }
   } else {
     zero_coef_channel <- as.character()
   }
@@ -754,7 +761,9 @@ robyn_allocator <- function(robyn_object = NULL,
       select_model, scenario, eval_list,
       export, plot_folder, quiet
     )
-  } else plots <- NULL
+  } else {
+    plots <- NULL
+  }
 
   output <- list(
     dt_optimOut = dt_optimOut,

R/R/checks.R

@@ -38,12 +38,14 @@ check_novar <- function(dt_input, InputCollect = NULL) {
       "There are %s column(s) with no-variance: %s. \nPlease, remove the variable(s) to proceed...",
       length(novar), v2t(novar)
     )
-    if (!is.null(InputCollect)) msg <- sprintf(
-      "%s\n>>> Note: there's no variance on these variables because of the modeling window filter (%s:%s)",
-      msg,
-      InputCollect$window_start,
-      InputCollect$window_end
-    )
+    if (!is.null(InputCollect)) {
+      msg <- sprintf(
+        "%s\n>>> Note: there's no variance on these variables because of the modeling window filter (%s:%s)",
+        msg,
+        InputCollect$window_start,
+        InputCollect$window_end
+      )
+    }
     stop(msg)
   }
 }
@@ -164,9 +166,12 @@ check_prophet <- function(dt_holidays, prophet_country, prophet_vars, prophet_si
     prophet_vars <- tolower(prophet_vars)
     opts <- c("trend", "season", "monthly", "weekday", "holiday")
     if (!"holiday" %in% prophet_vars) {
-      if (!is.null(prophet_country)) warning(paste(
-        "Input 'prophet_country' is defined as", prophet_country,
-        "but 'holiday' is not setup within 'prophet_vars' parameter"))
+      if (!is.null(prophet_country)) {
+        warning(paste(
+          "Input 'prophet_country' is defined as", prophet_country,
+          "but 'holiday' is not setup within 'prophet_vars' parameter"
+        ))
+      }
       prophet_country <- NULL
     }
     if (!all(prophet_vars %in% opts)) {
@@ -177,7 +182,7 @@ check_prophet <- function(dt_holidays, prophet_country, prophet_vars, prophet_si
     }
     if ("holiday" %in% prophet_vars && (
       is.null(prophet_country) || length(prophet_country) > 1 |
-      isTRUE(!prophet_country %in% unique(dt_holidays$country)))) {
+        isTRUE(!prophet_country %in% unique(dt_holidays$country)))) {
       stop(paste(
         "You must provide 1 country code in 'prophet_country' input.",
         length(unique(dt_holidays$country)), "countries are included:",
@@ -651,16 +656,16 @@ check_calibration <- function(dt_input, date_var, calibration_input, dayInterval
 
 check_obj_weight <- function(calibration_input, objective_weights, refresh) {
   obj_len <- ifelse(is.null(calibration_input), 2, 3)
-  if(!is.null(objective_weights)) {
-    if((length(objective_weights) != obj_len)) {
+  if (!is.null(objective_weights)) {
+    if ((length(objective_weights) != obj_len)) {
       stop(paste0("objective_weights must have length of ", obj_len))
     }
-    if(any(objective_weights < 0) | any(objective_weights > 10)) {
+    if (any(objective_weights < 0) | any(objective_weights > 10)) {
       stop("objective_weights must be >= 0 & <= 10")
     }
   }
-  if(is.null(objective_weights) & refresh) {
-    if(obj_len == 2) {
+  if (is.null(objective_weights) & refresh) {
+    if (obj_len == 2) {
       objective_weights <- c(1, 10)
     } else {
       objective_weights <- c(1, 10, 10)

R/R/clusters.R

@@ -77,9 +77,10 @@ robyn_clusters <- function(input, dep_var_type,
       {
         suppressMessages(
           clusterKmeans(df,
-                        k = NULL, limit = limit_clusters, ignore = ignore,
-                        dim_red = dim_red, quiet = TRUE, seed = seed
-          ))
+            k = NULL, limit = limit_clusters, ignore = ignore,
+            dim_red = dim_red, quiet = TRUE, seed = seed
+          )
+        )
       },
       error = function(err) {
         message(paste("Couldn't automatically create clusters:", err))
@@ -109,8 +110,10 @@ robyn_clusters <- function(input, dep_var_type,
   stopifnot(k %in% min_clusters:30)
   suppressMessages(
     cls <- clusterKmeans(
-      df, k = k, limit = limit_clusters, ignore = ignore,
-      dim_red = dim_red, quiet = TRUE, seed = seed)
+      df,
+      k = k, limit = limit_clusters, ignore = ignore,
+      dim_red = dim_red, quiet = TRUE, seed = seed
+    )
   )
 
   # Select top models by minimum (weighted) distance to zero
@@ -181,8 +184,9 @@ confidence_calcs <- function(
     if (length(unique(df_outcome$solID)) < 3) {
       warning(paste("Cluster", j, "does not contain enough models to calculate CI"))
     } else {
-      if (cluster_by == "hyperparameters")
+      if (cluster_by == "hyperparameters") {
         all_paid <- unique(gsub(paste(paste0("_", HYPS_NAMES), collapse = "|"), "", all_paid))
+      }
       for (i in all_paid) {
         # Bootstrap CI
         if (dep_var_type == "conversion") {
@@ -317,7 +321,8 @@ errors_scores <- function(df, balance = rep(1, 3), ts_validation = TRUE, ...) {
     if (cluster_by == "hyperparameters") {
       outcome <- select(
         x, .data$solID, contains(HYPS_NAMES),
-        contains(c("nrmse", "decomp.rssd", "mape"))) %>%
+        contains(c("nrmse", "decomp.rssd", "mape"))
+      ) %>%
         removenacols(all = FALSE)
     }
   }

R/R/convergence.R

@@ -148,8 +148,8 @@ robyn_converge <- function(OutputModels,
   moo_cloud_plot <- df %>%
     mutate(nrmse = lares::winsorize(.data$nrmse, nrmse_win)) %>%
     ggplot(aes(
-    x = .data$nrmse, y = .data$decomp.rssd, colour = .data$ElapsedAccum
-  )) +
+      x = .data$nrmse, y = .data$decomp.rssd, colour = .data$ElapsedAccum
+    )) +
     scale_colour_gradient(low = "skyblue", high = "navyblue") +
     labs(
       title = ifelse(!calibrated, "Multi-objective evolutionary performance",

R/R/inputs.R

@@ -361,8 +361,10 @@ robyn_inputs <- function(dt_input = NULL,
     # Check for no-variance columns (after filtering modeling window)
     dt_mod_model_window <- InputCollect$dt_mod %>%
       select(-any_of(InputCollect$unused_vars)) %>%
-      filter(.data$ds >= InputCollect$window_start,
-             .data$ds <= InputCollect$window_end)
+      filter(
+        .data$ds >= InputCollect$window_start,
+        .data$ds <= InputCollect$window_end
+      )
     check_novar(dt_mod_model_window, InputCollect)
   }
 

R/R/json.R

@@ -64,7 +64,8 @@ robyn_write <- function(InputCollect,
   outputs_time <- sprintf("%s min", attr(OutputCollect, "runTime"))
   total_time <- sprintf(
     "%s min",
-    attr(OutputCollect, "runTime") + attr(OutputCollect$OutputModels, "runTime"))
+    attr(OutputCollect, "runTime") + attr(OutputCollect$OutputModels, "runTime")
+  )
   if (!is.null(OutputCollect)) {
     outputs <- list()
     outputs$select_model <- select_model
@@ -160,12 +161,12 @@ print.robyn_write <- function(x, ...) {
   print(glued("\n\nSummary Values on Selected Model:"))
 
   print(x$ExportedModel$summary %>%
-          select(-contains("boot"), -contains("ci_")) %>%
-          dplyr::rename_at("performance", list(~ ifelse(x$InputCollect$dep_var_type == "revenue", "ROI", "CPA"))) %>%
-          mutate(decompPer = formatNum(100 * .data$decompPer, pos = "%")) %>%
-          dplyr::mutate_if(is.numeric, function(x) ifelse(!is.infinite(x), x, 0)) %>%
-          dplyr::mutate_if(is.numeric, function(x) formatNum(x, 4, abbr = TRUE)) %>%
-          replace(., . == "NA", "-") %>% as.data.frame())
+    select(-contains("boot"), -contains("ci_")) %>%
+    dplyr::rename_at("performance", list(~ ifelse(x$InputCollect$dep_var_type == "revenue", "ROI", "CPA"))) %>%
+    mutate(decompPer = formatNum(100 * .data$decompPer, pos = "%")) %>%
+    dplyr::mutate_if(is.numeric, function(x) ifelse(!is.infinite(x), x, 0)) %>%
+    dplyr::mutate_if(is.numeric, function(x) formatNum(x, 4, abbr = TRUE)) %>%
+    replace(., . == "NA", "-") %>% as.data.frame())
 
   print(glued(
     "\n\nHyper-parameters:\n    Adstock: {x$InputCollect$adstock}"
@@ -178,8 +179,8 @@ print.robyn_write <- function(x, ...) {
     select(-contains("lambda"), -any_of(HYPS_OTHERS)) %>%
     tidyr::gather() %>%
     tidyr::separate(.data$key,
-                    into = c("channel", "none"),
-                    sep = regex, remove = FALSE
+      into = c("channel", "none"),
+      sep = regex, remove = FALSE
     ) %>%
     mutate(hyperparameter = gsub("^.*_", "", .data$key)) %>%
     select(.data$channel, .data$hyperparameter, .data$value) %>%

R/R/plots.R

@@ -589,10 +589,10 @@ robyn_onepagers <- function(
       rver <- utils::sessionInfo()$R.version
       onepagerTitle <- sprintf("One-pager for Model ID: %s", sid)
       onepagerCaption <- sprintf("Robyn v%s [R-%s.%s]", ver, rver$major, rver$minor)
-      get_height <-  length(unique(plotMediaShareLoopLine$rn)) / 5
+      get_height <- length(unique(plotMediaShareLoopLine$rn)) / 5
       pg <- (p2 + p5) / (p1 + p8) / (p3 + p7) / (p4 + p6) +
         patchwork::plot_layout(heights = c(get_height, get_height, get_height, 1), guides = "collect") +
-      #pg <- wrap_plots(p2, p5, p1, p8, p3, p7, p4, p6, ncol = 2) +
+        # pg <- wrap_plots(p2, p5, p1, p8, p3, p7, p4, p6, ncol = 2) +
         plot_annotation(
           title = onepagerTitle, subtitle = errors,
           theme = theme_lares(background = "white", legend = "none"),
@@ -1339,7 +1339,8 @@ refresh_plots_json <- function(OutputCollectRF, json_file, export = TRUE, ...) {
     ggsave(
       filename = paste0(
         chainData[[length(chainData)]]$ExportedModel$plot_folder,
-        "report_decomposition.png"),
+        "report_decomposition.png"
+      ),
       plot = pBarRF,
       dpi = 900, width = 12, height = 8, limitsize = FALSE
     )

R/R/refresh.R

@@ -450,10 +450,13 @@ robyn_refresh <- function(json_file = NULL,
         export = TRUE, quiet = TRUE, ...
       )
       plots <- refresh_plots_json(
-        OutputCollectRF, json_file = attr(json_temp, "json_file"), export, ...)
+        OutputCollectRF,
+        json_file = attr(json_temp, "json_file"), export, ...
+      )
     } else {
       plots <- try(refresh_plots(
-        InputCollectRF, OutputCollectRF, ReportCollect, export, ...))
+        InputCollectRF, OutputCollectRF, ReportCollect, export, ...
+      ))
     }
 
     if (export) {

R/R/response.R

@@ -179,10 +179,10 @@ robyn_response <- function(InputCollect = NULL,
   if (usecase == "all_historical_vec") {
     ds_list <- check_metric_dates(date_range = "all", all_dates[1:endRW], dayInterval, quiet, ...)
     metric_value <- NULL
-    #val_list <- check_metric_value(metric_value, metric_name, all_values, ds_list$metric_loc)
+    # val_list <- check_metric_value(metric_value, metric_name, all_values, ds_list$metric_loc)
   } else if (usecase == "unit_metric_default_last_n") {
     ds_list <- check_metric_dates(date_range = paste0("last_", length(metric_value)), all_dates[1:endRW], dayInterval, quiet, ...)
-    #val_list <- check_metric_value(metric_value, metric_name, all_values, ds_list$metric_loc)
+    # val_list <- check_metric_value(metric_value, metric_name, all_values, ds_list$metric_loc)
   } else {
     ds_list <- check_metric_dates(date_range, all_dates[1:endRW], dayInterval, quiet, ...)
   }
@@ -351,7 +351,7 @@ which_usecase <- function(metric_value, date_range) {
     TRUE ~ "unit_metric_selected_dates"
   )
   if (!is.null(date_range)) {
-    if (length(date_range) ==1 & date_range[1] == "all") {
+    if (length(date_range) == 1 & date_range[1] == "all") {
       usecase <- "all_historical_vec"
     }
   }

R/R/transformation.R

@@ -162,8 +162,8 @@ adstock_weibull <- function(x, shape, scale, windlen = length(x), type = "cdf")
     x_decayed = x_decayed,
     thetaVecCum = thetaVecCum,
     inflation_total = inflation_total,
-    x_imme = x_imme)
-  )
+    x_imme = x_imme
+  ))
 }
 
 #' @rdname adstocks
@@ -272,8 +272,10 @@ plot_adstock <- function(plot = TRUE) {
           dt_weibull <- data.frame(
             x = 1:100,
             decay_accumulated = adstock_weibull(
-              1:100, shape = shapeVec[v1], scale = scaleVec[v2],
-              type = tolower(types[t]))$thetaVecCum,
+              1:100,
+              shape = shapeVec[v1], scale = scaleVec[v2],
+              type = tolower(types[t])
+            )$thetaVecCum,
             shape = paste0("shape=", shapeVec[v1]),
             scale = as.factor(scaleVec[v2]),
             type = types[t]