Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Remove tidyverse dependency #235

Merged
merged 16 commits into from
Oct 4, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 0 additions & 2 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -51,7 +51,6 @@ Imports:
prophet,
methods,
cli,
tidyverse,
tidymodels
Suggests:
rstan,
Expand Down Expand Up @@ -79,4 +78,3 @@ Suggests:
Roxygen: list(markdown = TRUE)
VignetteBuilder: knitr
RoxygenNote: 7.2.3

1 change: 0 additions & 1 deletion NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -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)
3 changes: 1 addition & 2 deletions R/dev-constructor.R
Original file line number Diff line number Diff line change
Expand Up @@ -13,8 +13,7 @@
#'
#'
#' @examples
#' library(stats)
#' library(tidyverse)
#' library(dplyr)
#' library(lubridate)
#' library(timetk)
#'
Expand Down
8 changes: 4 additions & 4 deletions R/dev-model_descriptions.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down
30 changes: 12 additions & 18 deletions R/dev-xregs.R
Original file line number Diff line number Diff line change
Expand Up @@ -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 %>%
Expand All @@ -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 %>%
Expand All @@ -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 {
Expand Down
2 changes: 1 addition & 1 deletion R/helpers-modeltime_table.R
Original file line number Diff line number Diff line change
Expand Up @@ -37,8 +37,8 @@
#'
#' @examples
#' library(tidymodels)
#' library(tidyverse)
#' library(timetk)
#' library(dplyr)
#' library(lubridate)
#'
#' # Setup
Expand Down
19 changes: 13 additions & 6 deletions R/modeltime-accuracy-table.R
Original file line number Diff line number Diff line change
Expand Up @@ -60,7 +60,7 @@
#'
#'
#' @examples
#' library(tidyverse)
#' library(dplyr)
#' library(lubridate)
#' library(timetk)
#' library(parsnip)
Expand Down Expand Up @@ -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))) {
Expand All @@ -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()
Expand All @@ -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()
Expand Down
2 changes: 1 addition & 1 deletion R/modeltime-accuracy.R
Original file line number Diff line number Diff line change
Expand Up @@ -38,7 +38,7 @@
#'
#' @examples
#' library(tidymodels)
#' library(tidyverse)
#' library(dplyr)
#' library(lubridate)
#' library(timetk)
#'
Expand Down
17 changes: 11 additions & 6 deletions R/modeltime-calibrate.R
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,7 @@
#'
#'
#' @examples
#' library(tidyverse)
#' library(dplyr)
#' library(lubridate)
#' library(timetk)
#' library(parsnip)
Expand Down Expand Up @@ -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
Expand All @@ -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)}.")

}

Expand All @@ -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
Expand Down
6 changes: 3 additions & 3 deletions R/modeltime-fit-workflowset.R
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,7 @@
#' @examples
#' library(tidymodels)
#' library(workflowsets)
#' library(tidyverse)
#' library(dplyr)
#' library(lubridate)
#' library(timetk)
#'
Expand Down Expand Up @@ -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
Expand All @@ -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)

Expand Down
12 changes: 8 additions & 4 deletions R/modeltime-forecast-plot.R
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,7 @@
#'
#'
#' @examples
#' library(tidyverse)
#' library(dplyr)
#' library(lubridate)
#' library(timetk)
#' library(parsnip)
Expand Down Expand Up @@ -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."))
}
}

Expand Down
Loading