Fix metric checking for quantile regression

.Rbuildignore

@@ -21,3 +21,4 @@ _cache$
 ^\.vscode$
 ^[.]?air[.]toml$
 ^\.claude$
+^\.positai$

.gitignore

@@ -13,3 +13,4 @@ tests/testthat/Rplots.pdf
 docs
 revdep
 tests/testthat/_snaps/notes.new.md
+.positai

NEWS.md

@@ -1,5 +1,9 @@
 # tune (development version)
 
+## Bug Fixes
+
+* Resampling and tuning would fail for quantile regression models if they passed a quantile regression metric (#1186)
+
 # tune 2.1.0
 
 * Model tuning has been enabled for quantile regression models. (#1125)

R/metric-selection.R

@@ -328,23 +328,30 @@ check_metrics_arg <- function(mtr_set, wflow, ..., call = rlang::caller_env()) {
     )
 
     return(mtr_set)
+  } else {
+    if (!inherits(mtr_set, "metric_set")) {
+      cli::cli_abort(
+        "The {.arg metrics} argument should have class {.cls metric_set}, not {.cls {class(mtr_set)}}.",
+        call = call
+      )
+    }
   }
 
   is_numeric_metric_set <- inherits(mtr_set, "numeric_metric_set")
   is_class_prob_metric_set <- inherits(mtr_set, "class_prob_metric_set")
   is_surv_metric_set <- inherits(mtr_set, c("survival_metric_set"))
+  is_qnt_metric_set <- inherits(mtr_set, c("quantile_metric_set"))
 
-  if (
-    !is_numeric_metric_set && !is_class_prob_metric_set && !is_surv_metric_set
-  ) {
+  if (mode == "regression" && !is_numeric_metric_set) {
     cli::cli_abort(
-      "The {.arg metrics} argument should be the results of
-                   {.fn yardstick::metric_set}.",
+      "The parsnip model has {.code mode} value of {.val {mode}},
+                   but the {.arg metrics} is a metric set for a
+                   different model mode.",
       call = call
     )
   }
 
-  if (mode == "regression" && !is_numeric_metric_set) {
+  if (mode == "classification" && !is_class_prob_metric_set) {
     cli::cli_abort(
       "The parsnip model has {.code mode} value of {.val {mode}},
                    but the {.arg metrics} is a metric set for a
@@ -353,7 +360,7 @@ check_metrics_arg <- function(mtr_set, wflow, ..., call = rlang::caller_env()) {
     )
   }
 
-  if (mode == "classification" && !is_class_prob_metric_set) {
+  if (mode == "censored regression" && !is_surv_metric_set) {
     cli::cli_abort(
       "The parsnip model has {.code mode} value of {.val {mode}},
                    but the {.arg metrics} is a metric set for a
@@ -362,7 +369,7 @@ check_metrics_arg <- function(mtr_set, wflow, ..., call = rlang::caller_env()) {
     )
   }
 
-  if (mode == "censored regression" && !is_surv_metric_set) {
+  if (mode == "quantile regression" && !is_qnt_metric_set) {
     cli::cli_abort(
       "The parsnip model has {.code mode} value of {.val {mode}},
                    but the {.arg metrics} is a metric set for a

tests/testthat/_snaps/metric-args.md

@@ -7,6 +7,14 @@
       - `rmse()`, a numeric metric | direction: minimize
       - `rsq()`, a numeric metric  | direction: maximize
 
+---
+
+    Code
+      check_metrics_arg(rmse, wflow)
+    Condition
+      Error:
+      ! The `metrics` argument should have class <metric_set>, not <numeric_metric/metric/function>.
+
 ---
 
     Code
@@ -289,3 +297,27 @@
       Error in `last_fit()`:
       ! The parsnip model has `mode` value of "censored regression", but the `metrics` is a metric set for a different model mode.
 
+# metric inputs are checked for quantile regression models
+
+    Code
+      check_metrics_arg(NULL, wflow)
+    Output
+      A metric set, consisting of:
+      - `weighted_interval_score()`, a quantile metric | direction: minimize
+
+---
+
+    Code
+      check_metrics_arg(metric_set(rmse), wflow)
+    Condition
+      Error:
+      ! The parsnip model has `mode` value of "quantile regression", but the `metrics` is a metric set for a different model mode.
+
+---
+
+    Code
+      check_metrics_arg(metric_set(weighted_interval_score), wflow)
+    Output
+      A metric set, consisting of:
+      - `weighted_interval_score()`, a quantile metric | direction: minimize
+

tests/testthat/test-metric-args.R

@@ -21,12 +21,15 @@ test_that("metric inputs are checked for regression models", {
     metric_set(brier_survival_integrated, brier_survival, concordance_survival)
   met_reg <- metric_set(rmse)
   met_cls <- metric_set(brier_class)
+  met_qnt <- metric_set(weighted_interval_score)
 
   # ------------------------------------------------------------------------------
   # check inputs
 
   expect_snapshot(check_metrics_arg(NULL, wflow))
 
+  expect_snapshot(check_metrics_arg(rmse, wflow), error = TRUE)
+
   expect_snapshot(check_metrics_arg(met_reg, wflow))
   expect_snapshot(check_metrics_arg(met_cls, wflow), error = TRUE)
   expect_snapshot(check_metrics_arg(met_mix_int, wflow), error = TRUE)
@@ -180,3 +183,17 @@ test_that("metric inputs are checked for censored regression models", {
   expect_snapshot(last_fit(wflow, split, metrics = met_cls), error = TRUE)
   expect_snapshot(last_fit(wflow, split, metrics = met_reg), error = TRUE)
 })
+
+test_that("metric inputs are checked for quantile regression models", {
+  wflow <- workflow(
+    y ~ x,
+    linear_reg(engine = "quantreg", mode = "quantile regression")
+  )
+
+  expect_snapshot(check_metrics_arg(NULL, wflow))
+
+  expect_snapshot(check_metrics_arg(metric_set(rmse), wflow), error = TRUE)
+  expect_snapshot(
+    check_metrics_arg(metric_set(weighted_interval_score), wflow)
+  )
+})