much renaming to quantile_values

Author: dajmcdon

R/arx_forecaster.R

@@ -33,7 +33,7 @@
 #' out <- arx_forecaster(jhu, "death_rate",
 #'   c("case_rate", "death_rate"),
 #'   trainer = quantile_reg(),
-#'   args_list = arx_args_list(levels = 1:9 / 10)
+#'   args_list = arx_args_list(quantile_values = 1:9 / 10)
 #' )
 arx_forecaster <- function(epi_data,
                            outcome,
@@ -99,7 +99,7 @@ arx_forecaster <- function(epi_data,
 #' arx_fcast_epi_workflow(jhu, "death_rate",
 #'   c("case_rate", "death_rate"),
 #'   trainer = quantile_reg(),
-#'   args_list = arx_args_list(levels = 1:9 / 10)
+#'   args_list = arx_args_list(quantile_values = 1:9 / 10)
 #' )
 arx_fcast_epi_workflow <- function(
     epi_data,
@@ -134,18 +134,20 @@ arx_fcast_epi_workflow <- function(
   # --- postprocessor
   f <- frosting() %>% layer_predict() # %>% layer_naomit()
   if (inherits(trainer, "quantile_reg")) {
-    # add all levels to the forecaster and update postprocessor
-    tau <- sort(compare_quantile_args(
-      args_list$levels,
-      rlang::eval_tidy(trainer$args$tau)
+    # add all quantile_values to the forecaster and update postprocessor
+    quantile_values <- sort(compare_quantile_args(
+      args_list$quantile_values,
+      rlang::eval_tidy(trainer$args$quantile_values)
     ))
-    args_list$levels <- tau
-    trainer$args$tau <- rlang::enquo(tau)
-    f <- layer_quantile_distn(f, levels = tau) %>% layer_point_from_distn()
+    args_list$quantile_values <- quantile_values
+    trainer$args$quantile_values <- rlang::enquo(quantile_values)
+    f <- layer_quantile_distn(f, quantile_values = quantile_values) %>%
+      layer_point_from_distn()
   } else {
     f <- layer_residual_quantiles(
       f,
-      probs = args_list$levels, symmetrize = args_list$symmetrize,
+      quantile_values = args_list$quantile_values,
+      symmetrize = args_list$symmetrize,
       by_key = args_list$quantile_by_key
     )
   }
@@ -173,7 +175,7 @@ arx_fcast_epi_workflow <- function(
 #'   The default `NULL` will attempt to determine this automatically.
 #' @param target_date Date. The date for which the forecast is intended.
 #'   The default `NULL` will attempt to determine this automatically.
-#' @param levels Vector or `NULL`. A vector of probabilities to produce
+#' @param quantile_values Vector or `NULL`. A vector of probabilities to produce
 #'   prediction intervals. These are created by computing the quantiles of
 #'   training residuals. A `NULL` value will result in point forecasts only.
 #' @param symmetrize Logical. The default `TRUE` calculates
@@ -197,6 +199,7 @@ arx_fcast_epi_workflow <- function(
 #'   create a prediction. For this reason, setting `nafill_buffer < min(lags)`
 #'   will be treated as _additional_ allowed recent data rather than the
 #'   total amount of recent data to examine.
+#' @param ... Space to handle future expansions (unused).
 #'
 #'
 #' @return A list containing updated parameter choices with class `arx_flist`.
@@ -205,18 +208,19 @@ arx_fcast_epi_workflow <- function(
 #' @examples
 #' arx_args_list()
 #' arx_args_list(symmetrize = FALSE)
-#' arx_args_list(levels = c(.1, .3, .7, .9), n_training = 120)
+#' arx_args_list(quantile_values = c(.1, .3, .7, .9), n_training = 120)
 arx_args_list <- function(
     lags = c(0L, 7L, 14L),
     ahead = 7L,
     n_training = Inf,
     forecast_date = NULL,
     target_date = NULL,
-    levels = c(0.05, 0.95),
+    quantile_values = c(0.05, 0.95),
     symmetrize = TRUE,
     nonneg = TRUE,
     quantile_by_key = character(0L),
-    nafill_buffer = Inf) {
+    nafill_buffer = Inf,
+    ...) {
   # error checking if lags is a list
   .lags <- lags
   if (is.list(lags)) lags <- unlist(lags)
@@ -227,7 +231,7 @@ arx_args_list <- function(
   arg_is_date(forecast_date, target_date, allow_null = TRUE)
   arg_is_nonneg_int(ahead, lags)
   arg_is_lgl(symmetrize, nonneg)
-  arg_is_probabilities(levels, allow_null = TRUE)
+  arg_is_probabilities(quantile_values, allow_null = TRUE)
   arg_is_pos(n_training)
   if (is.finite(n_training)) arg_is_pos_int(n_training)
   if (is.finite(nafill_buffer)) arg_is_pos_int(nafill_buffer, allow_null = TRUE)
@@ -238,7 +242,7 @@ arx_args_list <- function(
       lags = .lags,
       ahead,
       n_training,
-      levels,
+      quantile_values,
       forecast_date,
       target_date,
       symmetrize,
@@ -259,8 +263,8 @@ print.arx_fcast <- function(x, ...) {
 }
 
 compare_quantile_args <- function(alist, tlist) {
-  default_alist <- eval(formals(arx_args_list)$levels)
-  default_tlist <- eval(formals(quantile_reg)$tau)
+  default_alist <- eval(formals(arx_args_list)$quantile_values)
+  default_tlist <- eval(formals(quantile_reg)$quantile_values)
   if (setequal(alist, default_alist)) {
     if (setequal(tlist, default_tlist)) {
       return(sort(unique(union(alist, tlist))))

R/canned-epipred.R

@@ -8,13 +8,13 @@ validate_forecaster_inputs <- function(epi_data, outcome, predictors) {
   arg_is_chr(predictors)
   arg_is_chr_scalar(outcome)
   if (!outcome %in% names(epi_data)) {
-    cli::cli_abort("{outcome} was not found in the training data.")
+    cli::cli_abort("{.var {outcome}} was not found in the training data.")
   }
   check <- hardhat::check_column_names(epi_data, predictors)
   if (!check$ok) {
     cli::cli_abort(c(
       "At least one predictor was not found in the training data.",
-      "!" = "The following required columns are missing: {check$missing_names}."
+      "!" = "The following required columns are missing: {.val {check$missing_names}}."
     ))
   }
   invisible(TRUE)
@@ -41,8 +41,8 @@ arx_lags_validator <- function(predictors, lags) {
         predictors_miss <- setdiff(predictors, names(lags))
         cli::cli_abort(c(
           "If lags is a named list, then all predictors must be present.",
-          i = "The predictors are '{predictors}'.",
-          i = "So lags is missing '{predictors_miss}'."
+          i = "The predictors are {.var {predictors}}.",
+          i = "So lags is missing {.var {predictors_miss}}'."
         ))
       }
     }

R/epipredict-package.R

@@ -1,5 +1,6 @@
 #' @importFrom tibble tibble
 #' @importFrom rlang := !!
 #' @importFrom stats poly predict lm residuals quantile
+#' @importFrom cli cli_abort
 #' @import epiprocess parsnip
 NULL

R/extract.R

@@ -13,7 +13,7 @@
 #' @examples
 #' f <- frosting() %>%
 #'   layer_predict() %>%
-#'   layer_residual_quantiles(probs = c(0.0275, 0.975), symmetrize = FALSE) %>%
+#'   layer_residual_quantiles(quantile_values = c(0.0275, 0.975), symmetrize = FALSE) %>%
 #'   layer_naomit(.pred)
 #'
 #' extract_argument(f, "layer_residual_quantiles", "symmetrize")
@@ -27,10 +27,10 @@ extract_argument.layer <- function(x, name, arg, ...) {
   arg_is_chr_scalar(name, arg)
   in_layer_name <- class(x)[1]
   if (name != in_layer_name) {
-    cli_stop("Requested {name} not found. This is a(n) {in_layer_name}.")
+    cli_abort("Requested {.val {name}} not found. This is a(n) {.cls {in_layer_name}}.")
   }
   if (!arg %in% names(x)) {
-    cli_stop("Requested argument {arg} not found in {name}.")
+    cli_abort("Requested argument {.val {arg}} not found in {.val {name}}.")
   }
   x[[arg]]
 }
@@ -41,10 +41,10 @@ extract_argument.step <- function(x, name, arg, ...) {
   arg_is_chr_scalar(name, arg)
   in_step_name <- class(x)[1]
   if (name != in_step_name) {
-    cli_stop("Requested {name} not found. This is a {in_step_name}.")
+    cli_abort("Requested {.val {name}} not found. This is a {.cls {in_step_name}}.")
   }
   if (!arg %in% names(x)) {
-    cli_stop("Requested argument {arg} not found in {name}.")
+    cli_abort("Requested argument {.val {arg}} not found in {.val {name}}.")
   }
   x[[arg]]
 }
@@ -55,7 +55,7 @@ extract_argument.recipe <- function(x, name, arg, ...) {
   step_names <- map_chr(x$steps, ~ class(.x)[1])
   has_step <- name %in% step_names
   if (!has_step) {
-    cli_stop("recipe object does not contain a {name}.")
+    cli_abort("recipe object does not contain a {.val {name}}.")
   }
   step_locations <- which(name == step_names)
   out <- map(x$steps[step_locations], extract_argument, name = name, arg = arg)
@@ -69,7 +69,7 @@ extract_argument.frosting <- function(x, name, arg, ...) {
   layer_names <- map_chr(x$layers, ~ class(.x)[1])
   has_layer <- name %in% layer_names
   if (!has_layer) {
-    cli_stop("frosting object does not contain a {name} layer.")
+    cli_abort("frosting object does not contain a {.val {name}}.")
   }
   layer_locations <- which(name == layer_names)
   out <- map(x$layers[layer_locations], extract_argument, name = name, arg = arg)
@@ -83,15 +83,15 @@ extract_argument.epi_workflow <- function(x, name, arg, ...) {
   type <- sub("_.*", "", name)
   if (type %in% c("check", "step")) {
     if (!workflows:::has_preprocessor_recipe(x)) {
-      cli_stop("The workflow must have a recipe preprocessor.")
+      cli_abort("The workflow must have a recipe preprocessor.")
     }
     out <- extract_argument(x$pre$actions$recipe$recipe, name, arg)
   }
   if (type %in% "layer") {
     out <- extract_argument(extract_frosting(x), name, arg)
   }
   if (!type %in% c("check", "step", "layer")) {
-    cli_stop("{name} must begin with one of step, check, or layer")
+    cli_abort("{.val {name}} must begin with one of step, check, or layer")
   }
   return(out)
 }

R/flatline_forecaster.R

@@ -58,7 +58,7 @@ flatline_forecaster <- function(
   f <- frosting() %>%
     layer_predict() %>%
     layer_residual_quantiles(
-      probs = args_list$levels,
+      quantile_values = args_list$quantile_values,
       symmetrize = args_list$symmetrize,
       by_key = args_list$quantile_by_key
     ) %>%
@@ -101,7 +101,7 @@ flatline_forecaster <- function(
 #' @examples
 #' flatline_args_list()
 #' flatline_args_list(symmetrize = FALSE)
-#' flatline_args_list(levels = c(.1, .3, .7, .9), n_training = 120)
+#' flatline_args_list(quantile_values = c(.1, .3, .7, .9), n_training = 120)
 flatline_args_list <- function(
     ahead = 7L,
     n_training = Inf,
@@ -111,14 +111,15 @@ flatline_args_list <- function(
     symmetrize = TRUE,
     nonneg = TRUE,
     quantile_by_key = character(0L),
-    nafill_buffer = Inf) {
+    nafill_buffer = Inf,
+    ...) {
   arg_is_scalar(ahead, n_training)
   arg_is_chr(quantile_by_key, allow_empty = TRUE)
   arg_is_scalar(forecast_date, target_date, allow_null = TRUE)
   arg_is_date(forecast_date, target_date, allow_null = TRUE)
   arg_is_nonneg_int(ahead)
   arg_is_lgl(symmetrize, nonneg)
-  arg_is_probabilities(levels, allow_null = TRUE)
+  arg_is_probabilities(quantile_values, allow_null = TRUE)
   arg_is_pos(n_training)
   if (is.finite(n_training)) arg_is_pos_int(n_training)
   if (is.finite(nafill_buffer)) arg_is_pos_int(nafill_buffer, allow_null = TRUE)
@@ -129,7 +130,7 @@ flatline_args_list <- function(
       n_training,
       forecast_date,
       target_date,
-      levels,
+      quantile_values,
       symmetrize,
       nonneg,
       quantile_by_key,

R/layer_point_from_distn.R

@@ -24,7 +24,7 @@
 #'   step_epi_ahead(death_rate, ahead = 7) %>%
 #'   step_epi_naomit()
 #'
-#' wf <- epi_workflow(r, quantile_reg(tau = c(.25, .5, .75))) %>% fit(jhu)
+#' wf <- epi_workflow(r, quantile_reg(quantile_values = c(.25, .5, .75))) %>% fit(jhu)
 #'
 #' latest <- get_test_data(recipe = r, x = jhu)
 #'

R/layer_quantile_distn.R

@@ -3,11 +3,11 @@
 #' This function calculates quantiles when the prediction was _distributional_.
 #' Currently, the only distributional engine is `quantile_reg()`.
 #' If this engine is used, then this layer will grab out estimated (or extrapolated)
-#' quantiles at the requested levels.
+#' quantiles at the requested quantile values.
 #'
 #' @param frosting a `frosting` postprocessor
 #' @param ... Unused, include for consistency with other layers.
-#' @param levels a vector of probabilities (quantiles) to extract
+#' @param quantile_values a vector of probabilities to extract
 #' @param truncate Do we truncate the distribution to an interval
 #' @param name character. The name for the output column.
 #' @param id a random id string
@@ -25,7 +25,8 @@
 #'   step_epi_ahead(death_rate, ahead = 7) %>%
 #'   step_epi_naomit()
 #'
-#' wf <- epi_workflow(r, quantile_reg(tau = c(.25, .5, .75))) %>% fit(jhu)
+#' wf <- epi_workflow(r, quantile_reg(quantile_values = c(.25, .5, .75))) %>%
+#'   fit(jhu)
 #'
 #' latest <- get_test_data(recipe = r, x = jhu)
 #'
@@ -39,31 +40,31 @@
 #' p
 layer_quantile_distn <- function(frosting,
                                  ...,
-                                 levels = c(.25, .75),
+                                 quantile_values = c(.25, .75),
                                  truncate = c(-Inf, Inf),
                                  name = ".pred_distn",
                                  id = rand_id("quantile_distn")) {
   rlang::check_dots_empty()
   arg_is_chr_scalar(name, id)
-  arg_is_probabilities(levels)
+  arg_is_probabilities(quantile_values)
   stopifnot(
     length(truncate) == 2L, is.numeric(truncate), truncate[1] < truncate[2]
   )
 
   add_layer(
     frosting,
     layer_quantile_distn_new(
-      levels = levels,
+      quantile_values = quantile_values,
       truncate = truncate,
       name = name,
       id = id
     )
   )
 }
 
-layer_quantile_distn_new <- function(levels, truncate, name, id) {
+layer_quantile_distn_new <- function(quantile_values, truncate, name, id) {
   layer("quantile_distn",
-    levels = levels,
+    quantile_values = quantile_values,
     truncate = truncate,
     name = name,
     id = id
@@ -75,14 +76,15 @@ slather.layer_quantile_distn <-
   function(object, components, workflow, new_data, ...) {
     dstn <- components$predictions$.pred
     if (!inherits(dstn, "distribution")) {
-      rlang::abort(
-        c(
-          "`layer_quantile_distn` requires distributional predictions.",
-          "These are of class {class(dstn)}."
-        )
-      )
+      cli_abort(c(
+          "`layer_quantile_distn()` requires distributional predictions.",
+          "These are of class {.cls {class(dstn)}}."
+      ))
     }
-    dstn <- dist_quantiles(quantile(dstn, object$levels), object["levels"])
+    dstn <- dist_quantiles(
+      quantile(dstn, object$quantile_values),
+      object$quantile_values
+    )
 
     truncate <- object$truncate
     if (!all(is.infinite(truncate))) {
@@ -100,9 +102,9 @@ print.layer_quantile_distn <- function(
   title <- "Creating predictive quantiles"
   td <- "<calculated>"
   td <- rlang::enquos(td)
-  ext <- x$levels
+  ext <- x$quantile_values
   print_layer(td,
-    title = title, width = width, conjunction = "levels",
+    title = title, width = width, conjunction = "quantile_values",
     extra_text = ext
   )
 }