From 53ff1628cf94881f91af894b30602ddeec6600e3 Mon Sep 17 00:00:00 2001
From: simonpcouch <simonpatrickcouch@gmail.com>
Date: Tue, 10 Dec 2024 13:31:32 -0600
Subject: [PATCH] test functionality migrated from recipes (closes #54)

---
 R/utils.R                      |  2 +-
 tests/testthat/_snaps/utils.md | 33 +++++++++++++++++++++
 tests/testthat/test-utils.R    | 54 +++++++++++++++++++++++++++++++++-
 3 files changed, 87 insertions(+), 2 deletions(-)

diff --git a/R/utils.R b/R/utils.R
index 38ce547..f2900eb 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -370,7 +370,7 @@ check_selection <- function(selector, result, arg, call = caller_env()) {
       c(
         "!" = "{.arg {arg}} must select at least one column.",
         "x" = "Selector {.code {as_label(selector)}} did not match any columns \\
-               in {.arg .data}."
+               in {.arg {arg}}."
       ),
       call = caller_env()
     )
diff --git a/tests/testthat/_snaps/utils.md b/tests/testthat/_snaps/utils.md
index f0bef05..7f78056 100644
--- a/tests/testthat/_snaps/utils.md
+++ b/tests/testthat/_snaps/utils.md
@@ -6,6 +6,30 @@
       Error in `adjust_probability_threshold()`:
       ! `x` should be a <tailor> (`?tailor::tailor()`), not a string.
 
+# check_calibration_type errors informatively
+
+    Code
+      check_calibration_type("probability", "numeric", "regression")
+    Condition
+      Error in `check_calibration_type()`:
+      ! A regression tailor is incompatible with the adjustment `adjust_probability_calibration()`.
+
+---
+
+    Code
+      check_calibration_type("numeric", "probability", "binary")
+    Condition
+      Error in `check_calibration_type()`:
+      ! A binary tailor is incompatible with the adjustment `adjust_numeric_calibration()`.
+
+---
+
+    Code
+      check_calibration_type("numeric", "probability", "multiclass")
+    Condition
+      Error in `check_calibration_type()`:
+      ! A multiclass tailor is incompatible with the adjustment `adjust_numeric_calibration()`.
+
 # errors informatively without probably installed
 
     Code
@@ -59,3 +83,12 @@
       ! Only one tunable value is currently allowed per argument.
       `x` has `list(a = tune(), b = tune())`.
 
+# check_selection() errors informatively
+
+    Code
+      check_selection(quote(contains("boop")), numeric(0), ".data")
+    Condition
+      Error:
+      ! `.data` must select at least one column.
+      x Selector `contains("boop")` did not match any columns in `.data`.
+
diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R
index 378fdca..f8a405c 100644
--- a/tests/testthat/test-utils.R
+++ b/tests/testthat/test-utils.R
@@ -1,8 +1,41 @@
+test_that("is_tune works", {
+  expect_false(is_tune(1))
+  expect_false(is_tune("x"))
+  expect_false(is_tune(quote(x)))
+  expect_false(is_tune(quote(f(x))))
+  expect_false(is_tune(NULL))
+  expect_false(is_tune(list()))
+
+  expect_true(is_tune(quote(tune())))
+  expect_true(is_tune(quote(tune("my_param"))))
+})
+
 test_that("check_tailor raises informative error", {
   expect_snapshot(error = TRUE, adjust_probability_threshold("boop"))
   expect_no_condition(tailor() %>% adjust_probability_threshold(.5))
 })
 
+test_that("check_calibration_type errors informatively", {
+  expect_no_error(check_calibration_type("numeric", "numeric", "regression"))
+  expect_no_error(check_calibration_type("probability", "probability", "binary"))
+  expect_no_error(check_calibration_type("probability", "probability", "multiclass"))
+
+  expect_snapshot(
+    error = TRUE,
+    check_calibration_type("probability", "numeric", "regression")
+  )
+
+  expect_snapshot(
+    error = TRUE,
+    check_calibration_type("numeric", "probability", "binary")
+  )
+
+  expect_snapshot(
+    error = TRUE,
+    check_calibration_type("numeric", "probability", "multiclass")
+  )
+})
+
 test_that("errors informatively without probably installed", {
   testthat::local_mocked_bindings(requireNamespace = function(...) {FALSE})
 
@@ -56,7 +89,6 @@ test_that("tailor_fully_trained works", {
   )
 })
 
-
 test_that("tailor_requires_fit works", {
   skip_if_not_installed("probably")
 
@@ -164,3 +196,23 @@ test_that("find_tune_id() works", {
   x <- list(a = hardhat::tune(), b = hardhat::tune())
   expect_snapshot(error = TRUE, find_tune_id(x))
 })
+
+test_that("tune_id() works", {
+  # works when input is tune
+  expect_equal(tune_id(hardhat::tune()), "")
+  expect_equal(tune_id(hardhat::tune("param")), "param")
+
+  # returns character NA for non-tunable inputs
+  expect_equal(tune_id(NULL), NA_character_)
+  expect_equal(tune_id(1), NA_character_)
+  expect_equal(tune_id("x"), NA_character_)
+  expect_equal(tune_id(quote(x)), NA_character_)
+  expect_equal(tune_id(quote(f(x))), NA_character_)
+})
+
+test_that("check_selection() errors informatively", {
+  expect_snapshot(
+    check_selection(quote(contains("boop")), numeric(0), ".data"),
+    error = TRUE
+  )
+})