Merge branch 'main' into sparse-glmnet-predict

Author: topepo

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: parsnip
 Title: A Common API to Modeling and Analysis Functions
-Version: 1.2.1.9002
+Version: 1.2.1.9004
 Authors@R: c(
     person("Max", "Kuhn", , "[email protected]", role = c("aut", "cre")),
     person("Davis", "Vaughan", , "[email protected]", role = "aut"),
@@ -25,23 +25,23 @@ Imports:
     ggplot2,
     globals,
     glue,
-    hardhat (>= 1.4.0),
+    hardhat (>= 1.4.0.9003),
     lifecycle,
     magrittr,
     pillar,
     prettyunits,
     purrr (>= 1.0.0),
     rlang (>= 1.1.0),
-    sparsevctrs (>= 0.1.0.9000),
+    sparsevctrs (>= 0.1.0.9002),
     stats,
     tibble (>= 2.1.1),
     tidyr (>= 1.3.0),
     utils,
     vctrs (>= 0.6.0),
     withr
 Suggests: 
-    C50,
     bench,
+    C50,
     covr,
     dials (>= 1.1.0),
     earth,
@@ -69,16 +69,17 @@ Suggests:
     xgboost (>= 1.5.0.1)
 VignetteBuilder: 
     knitr
+Remotes: 
+    r-lib/sparsevctrs,
+    tidymodels/hardhat
 ByteCompile: true
 Config/Needs/website: C50, dbarts, earth, glmnet, keras, kernlab, kknn,
-    LiblineaR, mgcv, nnet, parsnip, randomForest, ranger, rpart, rstanarm,
-    tidymodels/tidymodels, tidyverse/tidytemplate, rstudio/reticulate,
+    LiblineaR, mgcv, nnet, parsnip, quantreg, randomForest, ranger, rpart, 
+    rstanarm, tidymodels/tidymodels, tidyverse/tidytemplate, rstudio/reticulate,
     xgboost
 Config/rcmdcheck/ignore-inconsequential-notes: true
 Config/testthat/edition: 3
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-Remotes:  
-    r-lib/sparsevctrs
 RoxygenNote: 7.3.2

NAMESPACE

@@ -185,6 +185,7 @@ export(.dat)
 export(.extract_surv_status)
 export(.extract_surv_time)
 export(.facts)
+export(.get_prediction_column_names)
 export(.lvls)
 export(.model_param_name_key)
 export(.obs)
@@ -202,7 +203,6 @@ export(bag_mars)
 export(bag_mlp)
 export(bag_tree)
 export(bart)
-export(bartMachine_interval_calc)
 export(boost_tree)
 export(case_weights_allowed)
 export(cforest_train)
@@ -264,6 +264,7 @@ export(make_classes)
 export(make_engine_list)
 export(make_seealso_list)
 export(mars)
+export(matrix_to_quantile_pred)
 export(max_mtry_formula)
 export(maybe_data_frame)
 export(maybe_matrix)
@@ -311,7 +312,6 @@ export(rand_forest)
 export(repair_call)
 export(req_pkgs)
 export(required_pkgs)
-export(rpart_train)
 export(rule_fit)
 export(set_args)
 export(set_dependency)
@@ -377,6 +377,7 @@ importFrom(generics,tune_args)
 importFrom(generics,varying_args)
 importFrom(ggplot2,autoplot)
 importFrom(glue,glue_collapse)
+importFrom(hardhat,contr_one_hot)
 importFrom(hardhat,extract_fit_engine)
 importFrom(hardhat,extract_fit_time)
 importFrom(hardhat,extract_parameter_dials)

NEWS.md

@@ -1,25 +1,51 @@
 # parsnip (development version)
 
+## New Features
+
+* A new model mode (`"quantile regression"`) was added. Including:
+  * A `linear_reg()` engine for `"quantreg"`. 
+  * Predictions are encoded via a custom vector type. See [hardhat::quantile_pred()].
+  * Predicted quantile levels are designated when the new mode is specified. See `?set_mode`.
+  
 * `fit_xy()` can now take dgCMatrix input for `x` argument (#1121).
 
 * `fit_xy()` can now take sparse tibbles as data values (#1165).
 
 * `predict()` can now take dgCMatrix and sparse tibble input for `new_data` argument, and error informatively when model doesn't support it (#1167).
 
-* Transitioned package errors and warnings to use cli (#1147 and #1148 by
-  @shum461, #1153 by @RobLBaker and @wright13, #1154 by @JamesHWade, #1160, 
-  #1161, #1081).
+* New `extract_fit_time()` method has been added that returns the time it took to train the model (#853).
+
+## Other Changes
+
+* Transitioned package errors and warnings to use cli (#1147 and #1148 by @shum461, #1153 by @RobLBaker and @wright13, #1154 by @JamesHWade, #1160, #1161, #1081).
 
 * `fit_xy()` currently raises an error for `gen_additive_mod()` model specifications as the default engine (`"mgcv"`) specifies smoothing terms in model formulas. However, some engines specify smooths via additional arguments, in which case the restriction on `fit_xy()` is excessive. parsnip will now only raise an error when fitting a `gen_additive_mod()` with `fit_xy()` when using the `"mgcv"` engine (#775).
 
 * Aligned `null_model()` with other model types; the model type now has an engine argument that defaults to `"parsnip"` and is checked with the same machinery that checks other model types in the package (#1083).
 
-* New `extract_fit_time()` method has been added that returns the time it took to train the model (#853).
+* If linear regression is requested with a Poisson family, an error will occur and refer the user to `poisson_reg()` (#1219).
+
+* The deprecated function `rpart_train()` was removed after its deprecation period (#1044).
+
+## Bug Fixes
+
+* Make sure that parsnip does not convert ordered factor predictions to be unordered.
 
 * Ensure that `knit_engine_docs()` has the required packages installed (#1156).
 
 * Fixed bug where some models fit using `fit_xy()` couldn't predict (#1166).
 
+* Fixed bug related to using local (non-package) models (#1229)
+
+* `tunable()` now references a dials object for the `mixture` parameter (#1236)
+
+## Breaking Change
+
+* For quantile prediction, the `quantile` argument to `predict()` has been deprecate in facor of `quantile_levels`. This does not affect models with mode `"quantile regression"`. 
+
+* The quantile regression prediction type was disabled for the deprecated `surv_reg()` model. 
+
+
 # parsnip 1.2.1
 
 * Added a missing `tidy()` method for survival analysis glmnet models (#1086).

R/aaa-import-standalone-types-check.R

@@ -1,7 +1,3 @@
-# Standalone file: do not edit by hand
-# Source: <https://github.com/r-lib/rlang/blob/main/R/standalone-types-check.R>
-# ----------------------------------------------------------------------
-#
 # ---
 # repo: r-lib/rlang
 # file: standalone-types-check.R
@@ -13,6 +9,9 @@
 #
 # ## Changelog
 #
+# 2024-08-15:
+# - `check_character()` gains an `allow_na` argument (@martaalcalde, #1724)
+#
 # 2023-03-13:
 # - Improved error messages of number checkers (@teunbrand)
 # - Added `allow_infinite` argument to `check_number_whole()` (@mgirlich).
@@ -461,15 +460,28 @@ check_formula <- function(x,
 
 # Vectors -----------------------------------------------------------------
 
+# TODO: Figure out what to do with logical `NA` and `allow_na = TRUE`
+
 check_character <- function(x,
                             ...,
+                            allow_na = TRUE,
                             allow_null = FALSE,
                             arg = caller_arg(x),
                             call = caller_env()) {
+
   if (!missing(x)) {
     if (is_character(x)) {
+      if (!allow_na && any(is.na(x))) {
+        abort(
+          sprintf("`%s` can't contain NA values.", arg),
+          arg = arg,
+          call = call
+        )
+      }
+
       return(invisible(NULL))
     }
+
     if (allow_null && is_null(x)) {
       return(invisible(NULL))
     }
@@ -479,7 +491,6 @@ check_character <- function(x,
     x,
     "a character vector",
     ...,
-    allow_na = FALSE,
     allow_null = allow_null,
     arg = arg,
     call = call

R/aaa_models.R

@@ -1,6 +1,6 @@
 # Initialize model environments
 
-all_modes <- c("classification", "regression", "censored regression")
+all_modes <- c("classification", "regression", "censored regression", "quantile regression")
 
 # ------------------------------------------------------------------------------
 
@@ -195,8 +195,8 @@ stop_missing_engine <- function(cls, call) {
 }
 
 check_mode_for_new_engine <- function(cls, eng, mode, call = caller_env()) {
-  all_modes <- get_from_env(paste0(cls, "_modes"))
-  if (!(mode %in% all_modes)) {
+  model_modes <- get_from_env(paste0(cls, "_modes"))
+  if (!(mode %in% model_modes)) {
     cli::cli_abort(
       "{.val {mode}} is not a known mode for model {.fn {cls}}.",
       call = call
@@ -796,7 +796,7 @@ is_discordant_info <- function(model, mode, eng, candidate,
   if (component == "predict" & !is.null(pred_type)) {
 
     current <- dplyr::filter(current, type == pred_type)
-    p_type <- paste0("and prediction type '", pred_type, "'")
+    p_type <- "and prediction type {.val {pred_type}} "
   } else {
     p_type <- ""
   }
@@ -809,9 +809,12 @@ is_discordant_info <- function(model, mode, eng, candidate,
 
   if (!same_info) {
     cli::cli_abort(
-      "The combination of engine {.var {eng}} and mode {.var {mode}} \\
-      {.val {p_type}} already has {component} data for model {.var {model}} \\
-      and the new information being registered is different.",
+      paste0(
+        "The combination of engine {.var {eng}} and mode {.var {mode}} ",
+        p_type,
+        "already has {component} data for model {.var {model}}
+         and the new information being registered is different."
+      ),
       call = call
     )
   }

R/aaa_quantiles.R

@@ -0,0 +1,17 @@
+#' Reformat quantile predictions
+#'
+#' @param x A matrix of predictions with rows as samples and columns as quantile
+#' levels.
+#' @param object A parsnip `model_fit` object from a quantile regression model.
+#' @keywords internal
+#' @export
+matrix_to_quantile_pred <- function(x, object) {
+  if (!is.matrix(x)) {
+    x <- as.matrix(x)
+  }
+  rownames(x) <- NULL
+  n_pred_quantiles <- ncol(x)
+  quantile_levels <- object$spec$quantile_levels
+
+  tibble::new_tibble(x = list(.pred_quantile = hardhat::quantile_pred(x, quantile_levels)))
+}

R/arguments.R

@@ -21,10 +21,12 @@ check_eng_args <- function(args, obj, core_args) {
   common_args <- intersect(protected_args, names(args))
   if (length(common_args) > 0) {
     args <- args[!(names(args) %in% common_args)]
-    common_args <- paste0(common_args, collapse = ", ")
     cli::cli_warn(
-      "The argument{?s} {.arg {common_args}} cannot be manually
-       modified and {?was/were} removed."
+      c(
+        "The argument{?s} {.arg {common_args}} cannot be manually modified
+         and {?was/were} removed."
+      ),
+      class = "parsnip_protected_arg_warning"
     )
   }
   args
@@ -49,6 +51,8 @@ check_eng_args <- function(args, obj, core_args) {
 #'   set_args(mtry = 3, importance = TRUE) %>%
 #'   set_mode("regression")
 #'
+#' linear_reg() %>%
+#'   set_mode("quantile regression", quantile_levels = c(0.2, 0.5, 0.8))
 #' @export
 set_args <- function(object, ...) {
   UseMethod("set_args")
@@ -89,12 +93,18 @@ set_args.default <- function(object,...) {
 
 #' @rdname set_args
 #' @export
-set_mode <- function(object, mode) {
+set_mode <- function(object, mode, ...) {
   UseMethod("set_mode")
 }
 
+#' @rdname set_args
+#' @param quantile_levels A vector of values between zero and one (only for the
+#' `"quantile regression"` mode); otherwise, it is `NULL`. The model uses these
+#' values to appropriately train quantile regression models to make predictions
+#' for these values (e.g., `quantile_levels = 0.5` is the median).
 #' @export
-set_mode.model_spec <- function(object, mode) {
+set_mode.model_spec <- function(object, mode, quantile_levels = NULL, ...) {
+  check_dots_empty()
   cls <- class(object)[1]
   if (rlang::is_missing(mode)) {
     spec_modes <- rlang::env_get(get_model_env(), paste0(cls, "_modes"))
@@ -111,11 +121,21 @@ set_mode.model_spec <- function(object, mode) {
 
   object$mode <- mode
   object$user_specified_mode <- TRUE
+  if (mode == "quantile regression") {
+      hardhat::check_quantile_levels(quantile_levels)
+  } else {
+    if (!is.null(quantile_levels)) {
+      cli::cli_warn("{.arg quantile_levels} is only used when the mode is
+                     {.val quantile regression}.")
+    }
+  }
+
+  object$quantile_levels <- quantile_levels
   object
 }
 
 #' @export
-set_mode.default <- function(object, mode) {
+set_mode.default <- function(object, mode, ...) {
   error_set_object(object, func = "set_mode")
 
   invisible(FALSE)
@@ -240,7 +260,7 @@ make_form_call <- function(object, env = NULL) {
 }
 
 # TODO we need something to indicate that case weights are being used.
-make_xy_call <- function(object, target, env) {
+make_xy_call <- function(object, target, env, call = rlang::caller_env()) {
   fit_args <- object$method$fit$args
   uses_weights <- has_weights(env)
 
@@ -265,7 +285,7 @@ make_xy_call <- function(object, target, env) {
       data.frame = rlang::expr(maybe_data_frame(x)),
       matrix = rlang::expr(maybe_matrix(x)),
       dgCMatrix = rlang::expr(maybe_sparse_matrix(x)),
-      cli::cli_abort("Invalid data type target: {target}.")
+      cli::cli_abort("Invalid data type target: {target}.", call = call)
     )
   if (uses_weights) {
     object$method$fit$args[[ unname(data_args["weights"]) ]] <- rlang::expr(weights)

R/autoplot.R

@@ -41,14 +41,15 @@ autoplot.glmnet <- function(object, ..., min_penalty = 0, best_penalty = NULL,
 }
 
 
-map_glmnet_coefs <- function(x) {
+map_glmnet_coefs <- function(x, call = rlang::caller_env()) {
   coefs <- coef(x)
   # If parsnip is used to fit the model, glmnet should be attached and this will
   # work. If an object is loaded from a new session, they will need to load the
   # package.
   if (is.null(coefs)) {
     cli::cli_abort(
-      "Please load the {.pkg glmnet} package before running {.fun autoplot}."
+      "Please load the {.pkg glmnet} package before running {.fun autoplot}.",
+      call = call
     )
   }
   p <- x$dim[1]
@@ -89,9 +90,10 @@ top_coefs <- function(x, top_n = 5) {
     dplyr::slice(seq_len(top_n))
 }
 
-autoplot_glmnet <- function(x, min_penalty = 0, best_penalty = NULL, top_n = 3L, ...) {
+autoplot_glmnet <- function(x, min_penalty = 0, best_penalty = NULL, top_n = 3L,
+                            call = rlang::caller_env(), ...) {
   tidy_coefs <-
-    map_glmnet_coefs(x) %>%
+    map_glmnet_coefs(x, call = call) %>%
     dplyr::filter(penalty >= min_penalty)
 
   actual_min_penalty <- min(tidy_coefs$penalty)