@@ -61,7 +61,6 @@ robyn_write <- function(InputCollect,
6161
6262 # ExportedModel JSON
6363 if (! is.null(OutputCollect )) {
64-
6564 # Modeling associated data
6665 collect <- list ()
6766 collect $ ts_validation <- OutputCollect $ OutputModels $ ts_validation
@@ -71,7 +70,8 @@ robyn_write <- function(InputCollect,
7170 collect $ outputs_time <- sprintf(" %s min" OutputCollect , " runTime"
7271 collect $ total_time <- sprintf(
7372 " %s min" OutputCollect , " runTime" +
74- attr(OutputCollect $ OutputModels , " runTime"
73+ attr(OutputCollect $ OutputModels , " runTime"
74+ )
7575 collect $ total_iters <- OutputCollect $ OutputModels $ iterations *
7676 OutputCollect $ OutputModels $ trials
7777 collect $ conv_msg <- gsub(" \\ :.*" " " OutputCollect $ OutputModels $ convergence $ conv_msg )
@@ -94,11 +94,14 @@ robyn_write <- function(InputCollect,
9494 outputs $ performance <- df %> %
9595 filter(.data $ rn %in% InputCollect $ paid_media_spends ) %> %
9696 group_by(.data $ solID ) %> %
97- summarise(metric = perf_metric ,
98- performance = ifelse(
99- perf_metric == " ROAS"
100- sum(.data $ xDecompAgg ) / sum(.data $ total_spend ),
101- sum(.data $ total_spend ) / sum(.data $ xDecompAgg )), .groups = " drop"
97+ summarise(
98+ metric = perf_metric ,
99+ performance = ifelse(
100+ perf_metric == " ROAS"
101+ sum(.data $ xDecompAgg ) / sum(.data $ total_spend ),
102+ sum(.data $ total_spend ) / sum(.data $ xDecompAgg )
103+ ), .groups = " drop"
104+ )
102105 outputs $ summary <- df %> %
103106 mutate(
104107 metric = perf_metric ,
@@ -136,7 +139,7 @@ robyn_write <- function(InputCollect,
136139
137140 extras <- list (... )
138141 if (isTRUE(add_data ) & ! " raw_data" %in% names(extras )) {
139- extras [[" raw_data" <- InputCollect $ dt_input
142+ extras [[" raw_data" <- as_tibble( InputCollect $ dt_input )
140143 }
141144 if (length(extras ) > 0 ) {
142145 ret [[" Extras" <- extras
@@ -153,7 +156,8 @@ robyn_write <- function(InputCollect,
153156 if (! all(c(" solID" " cluster" %in% names(pareto_df ))) {
154157 warning(paste(
155158 " Input 'pareto_df' is not a valid data.frame;"
156- " must contain 'solID' and 'cluster' columns."
159+ " must contain 'solID' and 'cluster' columns."
160+ ))
157161 } else {
158162 all_c <- unique(pareto_df $ cluster )
159163 pareto_df <- lapply(all_c , function (x ) {
@@ -192,7 +196,8 @@ print.robyn_write <- function(x, ...) {
192196 " \n\n Model's Performance and Errors:\n {performance}{errors}"
193197 performance = ifelse(" performance" %in% names(x $ ExportedModel ), sprintf(
194198 " Total Model %s = %s\n "
195- x $ ExportedModel $ performance $ metric , signif(x $ ExportedModel $ performance $ performance , 4 )), " "
199+ x $ ExportedModel $ performance $ metric , signif(x $ ExportedModel $ performance $ performance , 4 )
200+ ), " "
196201 errors = paste(
197202 sprintf(
198203 " Adj.R2 (train): %s"
@@ -204,34 +209,36 @@ print.robyn_write <- function(x, ...) {
204209 )
205210 ))
206211
207- print(glued(" \n\n Summary Values on Selected Model:"
212+ if (" ExportedModel" %in% names(x )) {
213+ print(glued(" \n\n Summary Values on Selected Model:"
208214
209- print(x $ ExportedModel $ summary %> %
210- select(- contains(" boot" - contains(" ci_" > %
211- dplyr :: rename_at(" performance" list (~ ifelse(x $ InputCollect $ dep_var_type == " revenue" " ROAS" " CPA" > %
212- mutate(decompPer = formatNum(100 * .data $ decompPer , pos = " %" > %
213- dplyr :: mutate_if(is.numeric , function (x ) ifelse(! is.infinite(x ), x , 0 )) %> %
214- dplyr :: mutate_if(is.numeric , function (x ) formatNum(x , 4 , abbr = TRUE )) %> %
215- replace(. , . == " NA" " -" > % as.data.frame())
215+ print(x $ ExportedModel $ summary %> %
216+ select(- contains(" boot" - contains(" ci_" > %
217+ dplyr :: rename_at(" performance" list (~ ifelse(x $ InputCollect $ dep_var_type == " revenue" " ROAS" " CPA" > %
218+ mutate(decompPer = formatNum(100 * .data $ decompPer , pos = " %" > %
219+ dplyr :: mutate_if(is.numeric , function (x ) ifelse(! is.infinite(x ), x , 0 )) %> %
220+ dplyr :: mutate_if(is.numeric , function (x ) formatNum(x , 4 , abbr = TRUE )) %> %
221+ replace(. , . == " NA" " -" > % as.data.frame())
216222
217- print(glued(
218- " \n\n Hyper-parameters:\n Adstock: {x$InputCollect$adstock}"
219- ))
223+ print(glued(
224+ " \n\n Hyper-parameters:\n Adstock: {x$InputCollect$adstock}"
225+ ))
220226
221- # Nice and tidy table format for hyper-parameters
222- HYPS_NAMES <- c(HYPS_NAMES , " penalty"
223- regex <- paste(paste0(" _" HYPS_NAMES ), collapse = " |"
224- hyper_df <- as.data.frame(x $ ExportedModel $ hyper_values ) %> %
225- select(- contains(" lambda" - any_of(HYPS_OTHERS )) %> %
226- tidyr :: gather() %> %
227- tidyr :: separate(.data $ key ,
228- into = c(" channel" " none"
229- sep = regex , remove = FALSE
230- ) %> %
231- mutate(hyperparameter = gsub(" ^.*_" " " .data $ key )) %> %
232- select(.data $ channel , .data $ hyperparameter , .data $ value ) %> %
233- tidyr :: spread(key = " hyperparameter" value = " value"
234- print(hyper_df )
227+ # Nice and tidy table format for hyper-parameters
228+ HYPS_NAMES <- c(HYPS_NAMES , " penalty"
229+ regex <- paste(paste0(" _" HYPS_NAMES ), collapse = " |"
230+ hyper_df <- as.data.frame(x $ ExportedModel $ hyper_values ) %> %
231+ select(- contains(" lambda" - any_of(HYPS_OTHERS )) %> %
232+ tidyr :: gather() %> %
233+ tidyr :: separate(.data $ key ,
234+ into = c(" channel" " none"
235+ sep = regex , remove = FALSE
236+ ) %> %
237+ mutate(hyperparameter = gsub(" ^.*_" " " .data $ key )) %> %
238+ select(.data $ channel , .data $ hyperparameter , .data $ value ) %> %
239+ tidyr :: spread(key = " hyperparameter" value = " value"
240+ print(hyper_df )
241+ }
235242}
236243
237244
@@ -342,7 +349,9 @@ robyn_recreate <- function(json_file, quiet = FALSE, ...) {
342349 quiet = quiet ,
343350 ...
344351 )
345- } else OutputCollect <- NULL
352+ } else {
353+ OutputCollect <- NULL
354+ }
346355 } else {
347356 # Use case: skip feature engineering when InputCollect is provided
348357 InputCollect <- args [[" InputCollect"
@@ -373,7 +382,8 @@ robyn_chain <- function(json_file) {
373382 temp <- list.files(plot_folder )
374383 mods <- unique(temp [
375384 (startsWith(temp , " RobynModel" | grepl(" \\ .json+$" temp )) &
376- grepl(" ^[^_]*_[^_]*_[^_]*$" temp )])
385+ grepl(" ^[^_]*_[^_]*_[^_]*$" temp )
386+ ])
377387 avlb <- gsub(" RobynModel-|\\ .json" " " mods )
378388 if (length(ids ) == length(mods )) {
379389 chain <- rep_len(chain , length(mods ))
@@ -394,7 +404,14 @@ robyn_chain <- function(json_file) {
394404 filename <- mods [avlb == ids [i ]]
395405 json_new <- robyn_read(filename , quiet = TRUE )
396406 } else {
397- message(" Skipping chain. File can't be found: " filename )
407+ last_try <- gsub(chain [1 ], " " filename )
408+ if (file.exists(last_try )) {
409+ json_new <- robyn_read(last_try , quiet = TRUE )
410+ message(" Stored original model in new file: " filename )
411+ jsonlite :: write_json(json_new , filename , pretty = TRUE )
412+ } else {
413+ message(" Skipping chain. File can't be found: " filename )
414+ }
398415 }
399416 }
400417 }
0 commit comments