Enumerate in print.epi_recipe and print.frosting funs

Author: rachlobay

NAMESPACE

@@ -52,9 +52,11 @@ S3method(print,alist)
 S3method(print,arx_class)
 S3method(print,arx_fcast)
 S3method(print,canned_epipred)
+S3method(print,epi_recipe)
 S3method(print,epi_workflow)
 S3method(print,flat_fcast)
 S3method(print,flatline)
+S3method(print,frosting)
 S3method(print,layer_add_forecast_date)
 S3method(print,layer_add_target_date)
 S3method(print,layer_naomit)
@@ -144,8 +146,6 @@ export(new_default_epi_recipe_blueprint)
 export(new_epi_recipe_blueprint)
 export(pivot_quantiles)
 export(prep)
-export(print_frosting)
-export(print_preprocessor_recipe)
 export(quantile_reg)
 export(remove_frosting)
 export(slather)

R/epi_recipe.R

@@ -399,8 +399,63 @@ kill_levels <- function(x, keys) {
 }
 
 #' @export
+print.epi_recipe <- function(x, form_width = 30, ...) {
+  cli::cli_div(theme = list(.pkg = list("vec-trunc" = Inf, "vec-last" = ", ")))
+
+  cli::cli_h1("Recipe")
+  cli::cli_h3("Inputs")
+
+  tab <- table(x$var_info$role, useNA = "ifany")
+  tab <- stats::setNames(tab, names(tab))
+  names(tab)[is.na(names(tab))] <- "undeclared role"
+
+  roles <- c("outcome", "predictor", "case_weights", "undeclared role")
+
+  tab <- c(
+    tab[names(tab) == roles[1]],
+    tab[names(tab) == roles[2]],
+    tab[names(tab) == roles[3]],
+    sort(tab[!names(tab) %in% roles], TRUE),
+    tab[names(tab) == roles[4]]
+  )
+
+  cli::cli_text("Number of variables by role")
+
+  spaces_needed <- max(nchar(names(tab))) - nchar(names(tab)) +
+    max(nchar(tab)) - nchar(tab)
+
+  cli::cli_verbatim(
+    glue::glue("{names(tab)}: {strrep('\ua0', spaces_needed)}{tab}")
+  )
+
+  if ("tr_info" %in% names(x)) {
+    cli::cli_h3("Training information")
+    nmiss <- x$tr_info$nrows - x$tr_info$ncomplete
+    nrows <- x$tr_info$nrows
+
+    cli::cli_text(
+      "Training data contained {nrows} data points and {cli::no(nmiss)} \\
+       incomplete row{?s}."
+    )
+  }
+
+  if (!is.null(x$steps)) {
+    cli::cli_h3("Operations")
+  }
+
+  i = 1
+  for (step in x$steps) {
+    cat(paste0(i, ". "))
+    print(step, form_width = form_width)
+    i = i + 1
+  }
+  cli::cli_end()
+
+  invisible(x)
+}
+
 # Currently only used in the workflow printing
-print_preprocessor_recipe <- function (x) {
+print_preprocessor_recipe <- function(x, ...) {
 
   recipe <- workflows::extract_preprocessor(x)
   steps <- recipe$steps
@@ -421,7 +476,7 @@ print_preprocessor_recipe <- function (x) {
   step_names <- map_chr(steps, workflows:::pull_step_name)
 
   if (n_steps <= 10L) {
-    cli:::cli_ol(step_names)
+    cli::cli_ol(step_names)
     return(invisible(x))
   }
 

R/frosting.R

@@ -269,6 +269,23 @@ apply_frosting.epi_workflow <-
   }
 
 #' @export
+print.frosting <- function(x, form_width = 30, ...) {
+  cli::cli_div(
+    theme = list(.pkg = list(`vec-trunc` = Inf, `vec-last` = ", "))
+  )
+  cli::cli_h1("Frosting")
+
+  if (!is.null(x$layers)) cli::cli_h3("Layers")
+  i = 1
+  for (layer in x$layers){
+    cat(paste0(i, ". "))
+    print(layer, form_width = form_width)
+    i = i + 1
+  }
+  cli::cli_end()
+  invisible(x)
+}
+
 # Currently only used in the workflow printing
 print_frosting <- function(x, ...) {
 
@@ -285,7 +302,7 @@ print_frosting <- function(x, ...) {
   layer_names <- map_chr(layers, pull_layer_name)
 
   if (n_layers <= 10L) {
-    cli:::cli_ol(layer_names)
+    cli::cli_ol(layer_names)
     return(invisible(x))
   }
 

R/print_epi_step.R

@@ -42,7 +42,7 @@ print_epi_step <- function(
   )
   more_dots <- ifelse(first_line == length(elements), "", ", ...")
   cli::cli_bullets(
-    c(`*` = "\n    {title}: \\\n    {.pkg {cli::cli_vec(elements[seq_len(first_line)])}}\\\n    {more_dots} \\\n    {conjunction} \\\n    {.pkg {extra_text}} \\\n    {vline_seperator} \\\n    {.emph {trained_text}}\\\n    {comma_seperator} \\\n    {.emph {case_weights_text}}\n    "))
+    c("\n    {title}: \\\n    {.pkg {cli::cli_vec(elements[seq_len(first_line)])}}\\\n    {more_dots} \\\n    {conjunction} \\\n    {.pkg {extra_text}} \\\n    {vline_seperator} \\\n    {.emph {trained_text}}\\\n    {comma_seperator} \\\n    {.emph {case_weights_text}}\n    "))
   cli::cli_end(theme_div_id)
   invisible(NULL)
 }

R/print_layer.R

@@ -24,6 +24,6 @@ print_layer <- function(
   )
   more_dots <- ifelse(first_line == length(elements), "", ", ...")
   cli::cli_bullets(
-    c(`*` = "\n    {title}: \\\n    {.pkg {elements[seq_len(first_line)]}}\\\n    {more_dots} \\\n    {conjunction} \\\n    {.pkg {extra_text}}"))
+    c("\n    {title}: \\\n    {.pkg {elements[seq_len(first_line)]}}\\\n    {more_dots} \\\n    {conjunction} \\\n    {.pkg {extra_text}}"))
   invisible(NULL)
 }