Merge pull request #235 from olivroy/warnings

DESCRIPTION

@@ -51,7 +51,6 @@ Imports:
     prophet,
     methods,
     cli,
-    tidyverse,
     tidymodels
 Suggests:
     rstan,
@@ -79,4 +78,3 @@ Suggests:
 Roxygen: list(markdown = TRUE)
 VignetteBuilder: knitr
 RoxygenNote: 7.2.3
-

NAMESPACE

@@ -329,7 +329,6 @@ importFrom(tibble,type_sum)
 importFrom(yardstick,mae)
 importFrom(yardstick,mape)
 importFrom(yardstick,mase)
-importFrom(yardstick,metric_tweak)
 importFrom(yardstick,rmse)
 importFrom(yardstick,rsq)
 importFrom(yardstick,smape)

R/dev-constructor.R

@@ -13,8 +13,7 @@
 #'
 #'
 #' @examples
-#' library(stats)
-#' library(tidyverse)
+#' library(dplyr)
 #' library(lubridate)
 #' library(timetk)
 #'

R/dev-model_descriptions.R

@@ -37,7 +37,7 @@ get_model_description <- function(object, indicate_training = FALSE, upper_case
 
 #' @export
 get_model_description.default <- function(object, indicate_training = FALSE, upper_case = TRUE) {
-    glubort("No method for class '{class(object)[1]}'. Expecting an object of class 'workflow', 'model_spec', or 'model_fit'.")
+    cli::cli_abort("No method for class {.obj_type_friendly {object}}. Expecting an object of class 'workflow', 'model_spec', or 'model_fit'.")
 }
 
 #' @export
@@ -223,7 +223,7 @@ get_arima_description <- function(object, padding = FALSE) {
 
 #' @export
 get_arima_description.default <- function(object, padding = FALSE) {
-    glubort("No method for class '{class(object)[1]}'. Expecting an object of class 'Arima'.")
+    cli::cli_abort("No method for class {.obj_type_friendly {object}}. Expecting an object of class 'Arima'.")
 }
 
 #' @export
@@ -284,8 +284,8 @@ get_arima_description.Arima <- function(object, padding = FALSE) {
 #' @export
 get_tbats_description <- function(object) {
 
-    if (!(inherits(object, "tbats") || inherits(object, "bats"))) {
-        glubort("No method for class '{class(object)[1]}'. Expecting an object of class 'bats' or 'tbats'.")
+    if (!rlang::inherits_any(object, c("tbats", "bats"))) {
+        cli::cli_abort("No method for class {.obj_type_friendly {object}}. Expecting an object of class 'bats' or 'tbats'.")
     }
 
     as.character(object)

R/dev-xregs.R

@@ -210,9 +210,7 @@ prepare_xreg_recipe_from_predictors <- function(data, prepare = TRUE,
             }
 
             # Convert any ordered factors to factors
-            names_ordered <- data_copy %>%
-                dplyr::select_if(is.ordered) %>%
-                names()
+            names_ordered <- names(data_copy)[purrr::map_lgl(data_copy, is.ordered)]
 
             if (length(names_ordered) > 0) {
                 recipe_spec <- recipe_spec %>%
@@ -221,23 +219,17 @@ prepare_xreg_recipe_from_predictors <- function(data, prepare = TRUE,
             }
 
             # Convert factors to dummies
-            names_factor <- data_copy %>%
-                dplyr::select_if(is.factor)%>%
-                names()
+            names_factor <- names(data_copy)[purrr::map_lgl(data_copy, is.factor)]
 
-            names_character <- data_copy %>%
-                dplyr::select_if(is.character)%>%
-                names()
+            names_character <- names(data_copy)[purrr::map_lgl(data_copy, is.character)]
 
             if (length(c(names_factor, names_character)) > 0 && dummy_encode) {
                 recipe_spec <- recipe_spec %>%
                     recipes::step_dummy(recipes::all_nominal(), one_hot = one_hot)
             }
 
             # Drop any date features
-            names_date <- data_copy %>%
-                dplyr::select_if(timetk::is_date_class) %>%
-                names()
+            names_date <- names(data_copy)[purrr::map_lgl(data_copy, timetk::is_date_class)]
 
             if (length(c(names_date)) > 0) {
                 recipe_spec <- recipe_spec %>%
@@ -254,12 +246,14 @@ prepare_xreg_recipe_from_predictors <- function(data, prepare = TRUE,
             }
 
         }, error = function(e) {
-            rlang::warn(
-                paste0("Failed to return valid external regressors. Proceeding without regressors.\n---",
-                       '\nWhat most likely happened: \nIf all of the regressors have zero variance (meaning they add no predictive value to the model), they are removed leaving no valid regressors.')
-            )
-            recipe_spec <- NULL
-            return(recipe_spec)
+            cli::cli_warn(c(
+                "Failed to return valid external regressors. Proceeding without regressors.",
+                "---",
+                "What most likely happened:",
+                i = "If all of the regressors have zero variance (meaning they add no predictive value to the model), they are removed leaving no valid regressors."
+                ))
+            # recipe_spec
+            return(NULL)
         })
 
     } else {

R/helpers-modeltime_table.R

@@ -37,8 +37,8 @@
 #'
 #' @examples
 #' library(tidymodels)
-#' library(tidyverse)
 #' library(timetk)
+#' library(dplyr)
 #' library(lubridate)
 #'
 #' # Setup

R/modeltime-accuracy-table.R

@@ -60,7 +60,7 @@
 #'
 #'
 #' @examples
-#' library(tidyverse)
+#' library(dplyr)
 #' library(lubridate)
 #' library(timetk)
 #' library(parsnip)
@@ -102,8 +102,11 @@ table_modeltime_accuracy <- function(.data, .round_digits = 2,
                                      .interactive = TRUE, ...) {
 
     # Checks
+    # If using an argument inside cli inline markup that starts with . like `.data`,
+    # we must use {(.data)} for it. https://cli.r-lib.org/reference/inline-markup.html
+
     if (!inherits(.data, "data.frame")) {
-        glubort("No method for {class(.data)[1]}. Expecting the output of 'modeltime_accuracy()'.")
+        cli::cli_abort("No method for {.obj_type_friendly {(.data)}}. Expecting the output of 'modeltime_accuracy()'.")
     }
 
     if (!all(c(".model_id", ".model_desc") %in% names(.data))) {
@@ -114,11 +117,8 @@ table_modeltime_accuracy <- function(.data, .round_digits = 2,
     data_formatted <- .data
 
     if (!is.null(round)) {
-        suppressMessages({
-            # If grouped, avoid message: `mutate_if()` ignored the following grouping variables
             data_formatted <- data_formatted %>%
-                dplyr::mutate_if(is.double, .funs = ~ round(., digits = .round_digits))
-        })
+                dplyr::mutate(dplyr::across(dplyr::where(is.double), .fns = ~ round(.x, digits = .round_digits)))
     }
 
     # Output either reactable() or gt()
@@ -142,6 +142,13 @@ table_modeltime_accuracy <- function(.data, .round_digits = 2,
                 defaultExpanded = .expand_groups,
                 ...
             )
+        # TODO gt now allows opt_interactive
+       # gt %>%
+       #      gt::opt_interactive(
+       #          use_sorting = .show_sortable,
+       #          use_filters = .filterable,
+       #          use_search = .searchable,
+       #      )
 
     } else {
         # gt()

R/modeltime-accuracy.R

@@ -38,7 +38,7 @@
 #'
 #' @examples
 #' library(tidymodels)
-#' library(tidyverse)
+#' library(dplyr)
 #' library(lubridate)
 #' library(timetk)
 #'

R/modeltime-calibrate.R

@@ -39,7 +39,7 @@
 #'
 #'
 #' @examples
-#' library(tidyverse)
+#' library(dplyr)
 #' library(lubridate)
 #' library(timetk)
 #' library(parsnip)
@@ -96,7 +96,7 @@ modeltime_calibrate <- function(object, new_data, id = NULL,
 
     # Checks
     if (rlang::is_missing(new_data)) {
-        glubort("Missing 'new_data'. Try adding a test data set using rsample::testing(splits). See help for more info: ?modeltime_calibrate ")
+        cli::cli_abort("Missing 'new_data'. Try adding a test data set using rsample::testing(splits). See help for more info: {.help modeltime::modeltime_calibrate}.")
     }
 
     # Check `id` is in `new_data` names
@@ -105,12 +105,12 @@ modeltime_calibrate <- function(object, new_data, id = NULL,
         tryCatch({
             id
         }, error = function(e) {
-            rlang::abort("`id` must be a quoted character string that is the name of an identifier column. ")
+            rlang::abort("`id` must be a quoted character string that is the name of an identifier column.")
         })
 
-        if (!is.character(id)) rlang::abort("`id` must be a quoted character string that is the name of an identifier column. ")
+        if (!is.character(id)) rlang::abort("`id` must be a quoted character string that is the name of an identifier column.")
 
-        if (!id %in% names(new_data)) glubort("`id` is not a valid column name in `new_data`. Please review column names: {stringr::str_c(names(new_data), collapse = ', ')}")
+        if (!id %in% names(new_data)) cli::cli_abort("`id` is not a valid column name in `new_data`. Please review column names: {(names(new_data)}.")
 
     }
 
@@ -120,7 +120,12 @@ modeltime_calibrate <- function(object, new_data, id = NULL,
 #' @export
 modeltime_calibrate.default <- function(object, new_data, id = NULL,
                                         quiet = TRUE, ...) {
-    glubort("Received an object of class: {class(object)[1]}. Expected an object of class:\n 1. 'workflow' - That has been fitted (trained).\n 2. 'model_fit' - A fitted parsnip model.\n 3. 'mdl_time_tbl' - A Model Time Table made with 'modeltime_table()'.")
+    cli::cli_abort(c(
+        x = "Received an object of class: {.obj_type_friendly {object}}.",
+        i = "Expected an object of class:",
+        "1. 'workflow' - That has been fitted (trained).",
+        "2. 'model_fit' - A fitted parsnip model.",
+        "3. 'mdl_time_tbl' - A Model Time Table made with 'modeltime_table()'."))
 }
 
 #' @export

R/modeltime-fit-workflowset.R

@@ -17,7 +17,7 @@
 #' @examples
 #' library(tidymodels)
 #' library(workflowsets)
-#' library(tidyverse)
+#' library(dplyr)
 #' library(lubridate)
 #' library(timetk)
 #'
@@ -54,7 +54,7 @@
 modeltime_fit_workflowset <- function(object, data, ..., control = control_fit_workflowset()) {
 
     if (!inherits(object, "workflow_set")){
-        rlang::abort("object argument must be a `workflow_set` object generated by workflowsets::workflow_set() function.")
+        cli::cli_abort("object argument must be a `workflow_set` object generated by the {.fn workflowsets::workflow_set} function.")
     }
 
     # Parallel or Sequential
@@ -66,7 +66,7 @@ modeltime_fit_workflowset <- function(object, data, ..., control = control_fit_w
 
     names(models) <- NULL
 
-    .model_desc <- object %>% dplyr::pull(1) %>% stringr::str_to_upper()
+    .model_desc <- object %>% dplyr::pull(1) %>% toupper()
 
     modeltime_tbl <- models %>% as_modeltime_table_from_workflowset(.model_desc = .model_desc)
 

R/modeltime-forecast-plot.R

@@ -18,7 +18,7 @@
 #'
 #'
 #' @examples
-#' library(tidyverse)
+#' library(dplyr)
 #' library(lubridate)
 #' library(timetk)
 #' library(parsnip)
@@ -79,17 +79,21 @@ plot_modeltime_forecast <- function(
 
     # Checks
     if (!inherits(.data, "data.frame")) {
-        glubort("No method for {class(.data)[1]}. Expecting the output of 'modeltime_forecast()'.")
+        cli::cli_abort("No method for {.obj_type_friendly {(.data)}}. Expecting the output of 'modeltime_forecast()'.")
     }
 
     if (!all(c(".model_id", ".model_desc", ".key", ".index", ".value") %in% names(.data))) {
-        rlang::abort("Expecting the following names to be in the data frame: .key, .index, .value. Try using 'modeltime_forecast()' to return a data frame in the appropriate structure.")
+        rlang::abort(c("Expecting the following names to be in the data frame: `.key`, `.index`, `.value.`.",
+                     "Try using 'modeltime_forecast()' to return a data frame in the appropriate structure."))
     }
 
     if (.conf_interval_show) {
         if (!all(c(".conf_lo", ".conf_hi") %in% names(.data))) {
             .conf_interval_show <- FALSE
-            rlang::warn("Expecting the following names to be in the data frame: .conf_hi, .conf_lo. \nProceeding with '.conf_interval_show = FALSE' to visualize the forecast without confidence intervals.\nAlternatively, try using `modeltime_calibrate()` before forecasting to add confidence intervals.")
+            rlang::warn(c(
+                x = "Expecting the following names to be in the data frame: .conf_hi, .conf_lo.",
+                i = "Proceeding with '.conf_interval_show = FALSE' to visualize the forecast without confidence intervals.",
+                "Alternatively, try using `modeltime_calibrate()` before forecasting to add confidence intervals."))
         }
     }