Merge pull request #517 from tidymodels/type-checkers

add rlang type checkers

Author: EmilHvitfeldt

DESCRIPTION

@@ -7,7 +7,7 @@ Authors@R: c(
     person("Davis", "Vaughan", , "davis@posit.co", role = "aut"),
     person("Emil", "Hvitfeldt", , "emil.hvitfeldt@posit.co", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-0679-1945")),
-    person(given = "Posit Software, PBC", role = c("cph", "fnd"))
+    person("Posit Software, PBC", role = c("cph", "fnd"))
   )
 Description: Tidy tools for quantifying how well model fits to a data set
     such as confusion matrices, class probability curve summaries, and
@@ -24,7 +24,7 @@ Imports:
     generics (>= 0.1.2),
     hardhat (>= 1.3.0),
     lifecycle (>= 1.0.3),
-    rlang (>= 1.1.0),
+    rlang (>= 1.1.4),
     tibble,
     tidyselect (>= 1.2.0),
     utils,
@@ -42,10 +42,84 @@ Suggests:
     tidyr
 VignetteBuilder: 
     knitr
-Config/Needs/website:
-    tidyverse/tidytemplate
+Config/Needs/website: tidyverse/tidytemplate
 Config/testthat/edition: 3
+Config/usethis/last-upkeep: 2024-10-24
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.0
+RoxygenNote: 7.3.2
+Collate: 
+    'aaa-metrics.R'
+    'import-standalone-types-check.R'
+    'aaa-new.R'
+    'aaa.R'
+    'check-metric.R'
+    'class-accuracy.R'
+    'class-bal_accuracy.R'
+    'class-detection_prevalence.R'
+    'class-f_meas.R'
+    'class-j_index.R'
+    'class-kap.R'
+    'class-mcc.R'
+    'class-npv.R'
+    'class-ppv.R'
+    'class-precision.R'
+    'class-recall.R'
+    'class-sens.R'
+    'class-spec.R'
+    'conf_mat.R'
+    'data.R'
+    'deprecated-prob_helpers.R'
+    'deprecated-template.R'
+    'estimator-helpers.R'
+    'event-level.R'
+    'fair-aaa.R'
+    'fair-demographic_parity.R'
+    'fair-equal_opportunity.R'
+    'fair-equalized_odds.R'
+    'import-standalone-obj-type.R'
+    'import-standalone-survival.R'
+    'metric-tweak.R'
+    'misc.R'
+    'missings.R'
+    'num-ccc.R'
+    'num-huber_loss.R'
+    'num-iic.R'
+    'num-mae.R'
+    'num-mape.R'
+    'num-mase.R'
+    'num-mpe.R'
+    'num-msd.R'
+    'num-poisson_log_loss.R'
+    'num-pseudo_huber_loss.R'
+    'num-rmse.R'
+    'num-rpd.R'
+    'num-rpiq.R'
+    'num-rsq.R'
+    'num-rsq_trad.R'
+    'num-smape.R'
+    'prob-average_precision.R'
+    'prob-binary-thresholds.R'
+    'prob-brier_class.R'
+    'prob-classification_cost.R'
+    'prob-gain_capture.R'
+    'prob-gain_curve.R'
+    'prob-helpers.R'
+    'prob-lift_curve.R'
+    'prob-mn_log_loss.R'
+    'prob-pr_auc.R'
+    'prob-pr_curve.R'
+    'prob-roc_auc.R'
+    'prob-roc_aunp.R'
+    'prob-roc_aunu.R'
+    'prob-roc_curve.R'
+    'reexports.R'
+    'surv-brier_survival.R'
+    'surv-brier_survival_integrated.R'
+    'surv-concordance_survival.R'
+    'surv-roc_auc_survival.R'
+    'surv-roc_curve_survival.R'
+    'template.R'
+    'validation.R'
+    'yardstick-package.R'

R/aaa-metrics.R

@@ -1,7 +1,7 @@
 #' General Function to Estimate Performance
 #'
-#' This function estimates one or more common performance estimates depending 
-#' on the class of `truth` (see **Value** below) and returns them in a three 
+#' This function estimates one or more common performance estimates depending
+#' on the class of `truth` (see **Value** below) and returns them in a three
 #' column tibble. If you wish to modify the metrics used or how they are used
 #' see [metric_set()].
 #'
@@ -305,8 +305,8 @@ format.metric_set <- function(x, ...) {
 
     for (i in seq_along(metrics)) {
       cli::cli_text(
-        "- {.fun {metric_names[i]}}, \\
-           {tolower(metric_types[i])}{metric_desc_paddings[i]} | \\
+        "- {.fun {metric_names[i]}},
+           {tolower(metric_types[i])}{metric_desc_paddings[i]} |
            {metric_descs[i]}"
       )
     }
@@ -585,7 +585,7 @@ validate_inputs_are_functions <- function(fns, call = caller_env()) {
   if (!all_fns) {
     not_fn <- which(!is_fun_vec)
     cli::cli_abort(
-      "All inputs to {.fn metric_set} must be functions. \\
+      "All inputs to {.fn metric_set} must be functions.
       These inputs are not: {not_fn}.",
       call = call
     )
@@ -660,8 +660,8 @@ validate_function_class <- function(fns) {
   if ("metric_factory" %in% fn_cls) {
     factories <- fn_cls[fn_cls == "metric_factory"]
     cli::cli_abort(
-      c("{cli::qty(factories)}The input{?s} {.arg {names(factories)}} \\
-         {?is a/are} {.help [groupwise metric](yardstick::new_groupwise_metric)} \\
+      c("{cli::qty(factories)}The input{?s} {.arg {names(factories)}}
+         {?is a/are} {.help [groupwise metric](yardstick::new_groupwise_metric)}
          {?factory/factories} and must be passed a data-column before
          addition to a metric set.",
         "i" = "Did you mean to type e.g. `{names(factories)[1]}(col_name)`?"),

R/aaa-new.R

@@ -64,10 +64,9 @@ new_static_survival_metric <- function(fn, direction) {
   new_metric(fn, direction, class = "static_survival_metric")
 }
 
+#' @include import-standalone-types-check.R
 new_metric <- function(fn, direction, class = NULL) {
-  if (!is.function(fn)) {
-    cli::cli_abort("{.arg fn} must be a function.")
-  }
+  check_function(fn)
 
   direction <- arg_match(
     direction,

R/class-kap.R

@@ -177,18 +177,16 @@ make_weighting_matrix <- function(weighting, n_levels, call = caller_env()) {
 
 
 validate_weighting <- function(x, call = caller_env()) {
-  if (!is_string(x)) {
-    cli::cli_abort("{.arg weighting} must be a string.", call = call)
-  }
+  check_string(x, arg = "weighting", call = call)
 
   ok <- is_no_weighting(x) ||
     is_linear_weighting(x) ||
     is_quadratic_weighting(x)
 
   if (!ok) {
     cli::cli_abort(
-      "{.arg weighting} must be {.val none}, {.val linear}, or \\
-      {.val quadratic}, not {.val {x}}.",
+      "{.arg weighting} must be {.val none}, {.val linear}, or
+       {.val quadratic}, not {.val {x}}.",
       call = call
     )
   }

R/class-precision.R

@@ -179,7 +179,7 @@ precision_multiclass <- function(data, estimator) {
 
 warn_precision_undefined_binary <- function(event, count) {
   message <- c(
-    "While computing binary {.fn precision}, no predicted events were \\
+    "While computing binary {.fn precision}, no predicted events were
     detected (i.e. `true_positive + false_positive = 0`).",
     "Precision is undefined in this case, and `NA` will be returned."
   )
@@ -204,11 +204,11 @@ warn_precision_undefined_binary <- function(event, count) {
 
 warn_precision_undefined_multiclass <- function(events, counts) {
   message <- c(
-    "While computing multiclass {.fn precision}, some levels had no predicted \\
+    "While computing multiclass {.fn precision}, some levels had no predicted
     events (i.e. `true_positive + false_positive = 0`).",
-    "Precision is undefined in this case, and those levels will be removed \\
+    "Precision is undefined in this case, and those levels will be removed
     from the averaged result.",
-    "Note that the following number of true events actually occurred for each \\
+    "Note that the following number of true events actually occurred for each
     problematic event level:",
     paste0("'", events, "': ", counts, collapse = ", ")
   )

R/class-recall.R

@@ -180,7 +180,7 @@ recall_multiclass <- function(data, estimator) {
 
 warn_recall_undefined_binary <- function(event, count) {
   message <- c(
-    "While computing binary {.fn recall}, no true events were detected \\
+    "While computing binary {.fn recall}, no true events were detected
     (i.e. `true_positive + false_negative = 0`).",
     "Recall is undefined in this case, and `NA` will be returned."
   )
@@ -205,11 +205,11 @@ warn_recall_undefined_binary <- function(event, count) {
 
 warn_recall_undefined_multiclass <- function(events, counts) {
   message <- c(
-    "While computing multiclass {.fn recall}, some levels had no true events \\
+    "While computing multiclass {.fn recall}, some levels had no true events
     (i.e. `true_positive + false_negative = 0`).",
-    "Recall is undefined in this case, and those levels will be removed from \\
+    "Recall is undefined in this case, and those levels will be removed from
     the averaged result.",
-    "Note that the following number of predicted events actually occurred for \\
+    "Note that the following number of predicted events actually occurred for
     each problematic event level:",
     paste0("'", events, "': ", counts, collapse = ", ")
   )

R/class-sens.R

@@ -49,7 +49,7 @@
 #'
 #' @param case_weights The optional column identifier for case weights.
 #'   This should be an unquoted column name that evaluates to a numeric column
-#'   in `data`. For `_vec()` functions, a numeric vector, 
+#'   in `data`. For `_vec()` functions, a numeric vector,
 #'   [hardhat::importance_weights()], or [hardhat::frequency_weights()].
 #'
 #' @param event_level A single string. Either `"first"` or `"second"` to specify
@@ -277,7 +277,7 @@ sens_multiclass <- function(data, estimator) {
 
 warn_sens_undefined_binary <- function(event, count) {
   message <- c(
-    "While computing binary {.fn sens}, no true events were detected \\
+    "While computing binary {.fn sens}, no true events were detected
     (i.e. `true_positive + false_negative = 0`).",
     "Sensitivity is undefined in this case, and `NA` will be returned."
   )
@@ -302,11 +302,11 @@ warn_sens_undefined_binary <- function(event, count) {
 
 warn_sens_undefined_multiclass <- function(events, counts) {
   message <- c(
-    "While computing multiclass {.fn sens}, some levels had no true events \\
+    "While computing multiclass {.fn sens}, some levels had no true events
     (i.e. `true_positive + false_negative = 0`).",
-    "Sensitivity is undefined in this case, and those levels will be removed \\
+    "Sensitivity is undefined in this case, and those levels will be removed
     from the averaged result.",
-    "Note that the following number of predicted events actually occurred for \\
+    "Note that the following number of predicted events actually occurred for
     each problematic event level:",
     paste0("'", events, "': ", counts, collapse = ", ")
   )

R/class-spec.R

@@ -248,7 +248,7 @@ spec_multiclass <- function(data, estimator) {
 
 warn_spec_undefined_binary <- function(event, count) {
   message <- c(
-    "While computing binary {.fn spec}, no true negatives were detected \\
+    "While computing binary {.fn spec}, no true negatives were detected
     (i.e. `true_negative + false_positive = 0`).",
     "Specificity is undefined in this case, and `NA` will be returned."
   )
@@ -273,11 +273,11 @@ warn_spec_undefined_binary <- function(event, count) {
 
 warn_spec_undefined_multiclass <- function(events, counts) {
   message <- c(
-    "While computing multiclass {.fn spec}, some levels had no true negatives \\
+    "While computing multiclass {.fn spec}, some levels had no true negatives
     (i.e. `true_negative + false_positive = 0`).",
-    "Specificity is undefined in this case, and those levels will be removed \\
+    "Specificity is undefined in this case, and those levels will be removed
     from the averaged result.",
-    "Note that the following number of predicted negatives actually occurred \\
+    "Note that the following number of predicted negatives actually occurred
     for each problematic event level:",
     paste0("'", events, "': ", counts, collapse = ", ")
   )

R/conf_mat.R

@@ -297,7 +297,7 @@ flatten <- function(xtab, call = caller_env()) {
   n_row <- nrow(xtab)
   if (n_row != n_col) {
     cli::cli_abort(
-      "{.arg x} must have equal dimensions. \\
+      "{.arg x} must have equal dimensions.
       {.arg x} has {n_col} columns and {n_row} rows.",
       call = call
     )

R/fair-aaa.R

@@ -143,7 +143,7 @@ new_groupwise_metric <- function(fn, name, aggregate, direction = "minimize") {
 
           if (by_str %in% gp_vars) {
             cli::cli_abort(
-              "Metric is internally grouped by {.field {by_str}}; grouping \\
+              "Metric is internally grouped by {.field {by_str}}; grouping
               {.arg data} by {.field {by_str}} is not well-defined."
             )
           }