glue->paste, dropping zoo

Author: dsweber2

DESCRIPTION

@@ -46,8 +46,7 @@ Imports:
     tidyselect,
     tsibble,
     vctrs,
-    workflows (>= 1.0.0),
-    zoo
+    workflows (>= 1.0.0)
 Suggests:
     covidcast,
     data.table,

R/epi_check_training_set.R

@@ -16,7 +16,7 @@ epi_check_training_set <- function(x, rec) {
   if (!is.null(old_ok)) {
     if (all(old_ok %in% colnames(x))) { # case 1
       if (!all(old_ok %in% new_ok)) {
-        cli::cli_warn(c(
+        cli::cli_warn(paste(
           "The recipe specifies additional keys. Because these are available,",
           "they are being added to the metadata of the training data."
         ))

R/epi_recipe.R

@@ -94,7 +94,7 @@ epi_recipe.epi_df <-
     ## Check and add roles when available
     if (!is.null(roles)) {
       if (length(roles) != length(vars)) {
-        cli::cli_abort(c(
+        cli::cli_abort(paste(
           "The number of roles should be the same as the number of ",
           "variables."
         ))
@@ -456,7 +456,7 @@ prep.epi_recipe <- function(
   }
   skippers <- map_lgl(x$steps, recipes:::is_skipable)
   if (any(skippers) & !retain) {
-    cli::cli_warn(c(
+    cli::cli_warn(paste(
       "Since some operations have `skip = TRUE`, using ",
       "`retain = TRUE` will allow those steps results to ",
       "be accessible."

R/frosting.R

@@ -370,7 +370,7 @@ apply_frosting.epi_workflow <-
     }
 
     if (!has_postprocessor_frosting(workflow)) {
-      cli::cli_warn(c(
+      cli::cli_warn(paste(
         "Only postprocessors of class {.cls frosting} are allowed.",
         "Returning unpostprocessed predictions."
       ))

R/layer_cdc_flatline_quantiles.R

@@ -177,15 +177,15 @@ slather.layer_cdc_flatline_quantiles <-
     if (length(object$by_key) > 0L) {
       cols_in_preds <- hardhat::check_column_names(p, object$by_key)
       if (!cols_in_preds$ok) {
-        cli::cli_warn(c(
+        cli::cli_warn(paste(
           "Predicted values are missing key columns: {.val {cols_in_preds$missing_names}}.",
           "Ignoring these."
         ))
       }
       if (inherits(the_fit, "_flatline")) {
         cols_in_resids <- hardhat::check_column_names(r, object$by_key)
         if (!cols_in_resids$ok) {
-          cli::cli_warn(c(
+          cli::cli_warn(paste(
             "Existing residuals are missing key columns: {.val {cols_in_resids$missing_names}}.",
             "Ignoring these."
           ))
@@ -202,7 +202,7 @@ slather.layer_cdc_flatline_quantiles <-
         )
         cols_in_resids <- hardhat::check_column_names(key_cols, object$by_key)
         if (!cols_in_resids$ok) {
-          cli::cli_warn(c(
+          cli::cli_warn(paste(
             "Requested residuals are missing key columns: {.val {cols_in_resids$missing_names}}.",
             "Ignoring these."
           ))

R/layer_residual_quantiles.R

@@ -93,7 +93,7 @@ slather.layer_residual_quantiles <-
       common <- intersect(object$by_key, names(key_cols))
       excess <- setdiff(object$by_key, names(key_cols))
       if (length(excess) > 0L) {
-        cli::cli_warn(c(
+        cli::cli_warn(paste(
           "Requested residual grouping key(s) {.val {excess}} are unavailable ",
           "in the original data. Grouping by the remainder: {.val {common}}."
         ))
@@ -104,7 +104,7 @@ slather.layer_residual_quantiles <-
         if (length(common_in_r) == length(common)) {
           r <- dplyr::left_join(key_cols, r, by = common_in_r)
         } else {
-          cli::cli_warn(c(
+          cli::cli_warn(paste(
             "Some grouping keys are not in data.frame returned by the",
             "`residuals()` method. Groupings may not be correct."
           ))
@@ -159,7 +159,7 @@ grab_residuals <- function(the_fit, components) {
     } else if (is.vector(drop(r))) { # also success
       return(tibble(.resid = drop(r)))
     } else { # failure
-      cli::cli_warn(c(
+      cli::cli_warn(paste(
         "The `residuals()` method for objects of class {.cls {cl}} results in an",
         "object that is neither a data frame with a column named `.resid`,",
         "nor something coercible to a vector.",

R/pivot_quantiles.R

@@ -74,7 +74,7 @@ pivot_quantiles_longer <- function(.data, ..., .ignore_length_check = FALSE) {
             tidyr::unnest(tidyselect::all_of(col), names_sep = "_")
         }
       } else {
-        cli::cli_abort(c(
+        cli::cli_abort(paste(
           "Some selected columns contain different numbers of quantiles.",
           "The result would be a {.emph very} long {.cls tibble}.",
           "To do this anyway, rerun with `.ignore_length_check = TRUE`."

R/step_adjust_latency.R

@@ -119,7 +119,7 @@ step_adjust_latency <-
       recipe$steps,
       function(recipe_step) inherits(recipe_step, rel_step_type)
     ))) {
-      cli::cli_abort(glue::glue(
+      cli::cli_abort(paste(
         "There is no `{rel_step_type}` defined before this.",
         " For the method `extend_{shift_name}` of `step_adjust_latency`,",
         " at least one {shift_name} must be previously defined."
@@ -168,13 +168,13 @@ step_adjust_latency_new <-
 #' @export
 prep.step_adjust_latency <- function(x, training, info = NULL, ...) {
   if ((x$method == "extend_ahead") && (!("outcome" %in% info$role))) {
-    cli::cli_abort(glue::glue(
-      "If `method` is `\"extend_ahead\"`, then a step ",
+    cli::cli_abort(paste(
+      "If `method` is {.val extend_ahead}, then a step ",
       "must have already added an outcome."
     ))
   } else if (!("predictor" %in% info$role)) {
-    cli::cli_abort(glue::glue(
-      "If `method` is `\"extend_lags\"` or `\"locf\"`, then a step ",
+    cli::cli_abort(paste(
+      "If `method` is {.val extend_lags} or {.val locf}, then a step ",
       "must have already added a predictor."
     ))
   }
@@ -210,8 +210,8 @@ prep.step_adjust_latency <- function(x, training, info = NULL, ...) {
         ((time_type == "yearquarter") && (latency >= 1)) ||
         ((time_type == "year") && (latency >= 1))
     ) {
-      cli::cli_warn(c(
-        "!" = glue::glue(
+      cli::cli_warn(paste(
+        "!" = paste(
           "The shift has been adjusted by {latency}, ",
           "which is questionable for it's `time_type` of ",
           "{time_type}"

R/utils-latency.R

@@ -1,5 +1,6 @@
 #' offset each relevant column by it's appropriate latency
 #' works for either adjusting aheads or lags
+#' note that this may introduce new NA values when one column is shifted farther than another
 #' @param shift_cols a tibble which must have the columns `column`, the name of
 #'   the column to adjust, `latency` the latency of the original column relative
 #'   to the `as_of` date, `new_name`, the names in `column` adjusted by the
@@ -20,7 +21,6 @@ extend_either <- function(new_data, shift_cols, keys) {
         key_cols = keys
       )
     }) %>%
-    map(function(x) zoo::na.trim(x)) %>%
     reduce(
       dplyr::full_join,
       by = keys
@@ -146,21 +146,21 @@ set_asof <- function(new_data, info) {
   max_time <- max(time_values)
   # make sure the as_of is sane
   if (!inherits(as_of, class(time_values)) & !inherits(as_of, "POSIXt")) {
-    cli::cli_abort(glue::glue(
+    cli::cli_abort(paste(
       "the data matrix `as_of` value is {as_of}, ",
       "and not a valid `time_type` with type ",
       "matching `time_value`'s type of ",
       "{typeof(new_data$time_value)}."
     ))
   }
   if (is.null(as_of) || is.na(as_of)) {
-    cli::cli_warn(glue::glue(
+    cli::cli_warn(paste(
       "epi_data's `as_of` was {as_of}, setting to ",
       "the latest time value, {max_time}."
     ))
     as_of <- max_time
   } else if (as_of < max_time) {
-    cli::cli_abort(glue::glue(
+    cli::cli_abort(paste(
       "`as_of` ({(as_of)}) is before the most ",
       "recent data ({max_time}). Remove before ",
       "predicting."

R/utils-misc.R

@@ -43,7 +43,7 @@ grab_forged_keys <- function(forged, mold, new_data) {
   # 3. these are the keys in the test data as input
   new_df_keys <- epi_keys(new_data, extra_keys = setdiff(new_keys, keys[1:2]))
   if (!(setequal(old_keys, new_df_keys) && setequal(new_keys, new_df_keys))) {
-    cli::cli_warn(c(
+    cli::cli_warn(paste(
       "Not all epi keys that were present in the training data are available",
       "in `new_data`. Predictions will have only the available keys."
     ))

R/utils-shift.R

@@ -12,7 +12,7 @@ adjust_latency <- function(object, new_data) {
   } else if (method == "extend_ahead") {
     as_of <- attributes(new_data)$metadata$as_of
     if (FALSE && (typeof(as_of) != typeof(new_data$time_value))) {
-      cli::cli_abort(glue::glue(
+      cli::cli_abort(paste(
         "the data matrix `as_of` value is {as_of}, ",
         "and not a valid `time_type` with type ",
         "matching `time_value`'s type of ",
@@ -27,13 +27,13 @@ adjust_latency <- function(object, new_data) {
       max_time <- max(time_values)
       shift_amount <- as.Date(as_of) - max_time
       if (is.null(as_of) || is.na(as_of)) {
-        cli::cli_warn(glue::glue(
+        cli::cli_warn(paste(
           "epi_data's `as_of` was {as_of}, setting to ",
           "the latest time value, {max_time}."
         ))
         as_of <- max_time
       } else if (as_of < max_time) {
-        cli::cli_abort(glue::glue(
+        cli::cli_abort(paste(
           "`as_of` ({(as_of)}) is before the most ",
           "recent data ({max_time}). Remove before ",
           "predicting."
@@ -47,7 +47,7 @@ adjust_latency <- function(object, new_data) {
         ((time_type == "yearmonth") && (shift_amount >= 2)) ||
         ((time_type == "yearquarter") && (shift_amount >= 1)) ||
         ((time_type == "year") && (shift_amount >= 1))) {
-        cli::cli_warn(c(
+        cli::cli_warn(paste(
           "!" = glue::glue(
             "The ahead has been adjusted by {shift_amount}, ",
             "which is questionable for it's `time_type` of ",
@@ -63,7 +63,7 @@ adjust_latency <- function(object, new_data) {
       cli::cli_abort("the `time_value` column of `new_data` is empty")
     }
   } else {
-    cli::cli_abort(glue::glue(
+    cli::cli_abort(paste(
       "Latency adjustment method {method} has not yet ",
       "been implemented for `step_epi_ahead`."
     ))