Convert logical inputs to factors

.Rbuildignore

@@ -20,3 +20,4 @@ contributors.md
 ^data-raw$
 ^[\.]?air\.toml$
 ^\.vscode$
+^revdep$

.gitignore

@@ -5,3 +5,4 @@ inst/doc
 .Ruserdata
 .DS_Store
 docs
+revdep

R/class-accuracy.R

@@ -94,6 +94,10 @@ accuracy_vec <- function(
   estimate <- as_factor_from_class_pred(estimate)
 
   estimator <- finalize_estimator(truth, metric_class = "accuracy")
+  if (is.logical(truth)) {
+    truth <- factor(truth)
+    estimate <- if (is.logical(estimate)) factor(estimate) else estimate
+  }
   check_class_metric(truth, estimate, case_weights, estimator)
 
   if (na_rm) {

R/class-bal_accuracy.R

@@ -92,6 +92,11 @@ bal_accuracy_vec <- function(
 
   estimator <- finalize_estimator(truth, estimator)
 
+  if (is.logical(truth)) {
+    event_level <- "second"  # TRUE is second level of levels(factor(truth))
+    truth <- factor(truth)
+    estimate <- if (is.logical(estimate)) factor(estimate) else estimate
+  }
   check_class_metric(truth, estimate, case_weights, estimator)
 
   if (na_rm) {

R/class-detection_prevalence.R

@@ -93,6 +93,11 @@ detection_prevalence_vec <- function(
 
   estimator <- finalize_estimator(truth, estimator)
 
+  if (is.logical(truth)) {
+    event_level <- "second"  # TRUE is second level of levels(factor(truth))
+    truth <- factor(truth)
+    estimate <- if (is.logical(estimate)) factor(estimate) else estimate
+  }
   check_class_metric(truth, estimate, case_weights, estimator)
 
   if (na_rm) {

R/class-f_meas.R

@@ -120,6 +120,11 @@ f_meas_vec <- function(
 
   estimator <- finalize_estimator(truth, estimator)
 
+  if (is.logical(truth)) {
+    event_level <- "second"  # TRUE is second level of levels(factor(truth))
+    truth <- factor(truth)
+    estimate <- if (is.logical(estimate)) factor(estimate) else estimate
+  }
   check_class_metric(truth, estimate, case_weights, estimator)
 
   if (na_rm) {

R/class-j_index.R

@@ -114,6 +114,11 @@ j_index_vec <- function(
 
   estimator <- finalize_estimator(truth, estimator)
 
+  if (is.logical(truth)) {
+    event_level <- "second"  # TRUE is second level of levels(factor(truth))
+    truth <- factor(truth)
+    estimate <- if (is.logical(estimate)) factor(estimate) else estimate
+  }
   check_class_metric(truth, estimate, case_weights, estimator)
 
   if (na_rm) {

R/class-kap.R

@@ -117,6 +117,10 @@ kap_vec <- function(
 
   estimator <- finalize_estimator(truth, metric_class = "kap")
 
+  if (is.logical(truth)) {
+    truth <- factor(truth)
+    estimate <- if (is.logical(estimate)) factor(estimate) else estimate
+  }
   check_class_metric(truth, estimate, case_weights, estimator)
 
   if (na_rm) {

R/class-mcc.R

@@ -100,6 +100,10 @@ mcc_vec <- function(truth, estimate, na_rm = TRUE, case_weights = NULL, ...) {
 
   estimator <- finalize_estimator(truth, metric_class = "mcc")
 
+  if (is.logical(truth)) {
+    truth <- factor(truth)
+    estimate <- if (is.logical(estimate)) factor(estimate) else estimate
+  }
   check_class_metric(truth, estimate, case_weights, estimator)
 
   if (na_rm) {

R/class-npv.R

@@ -117,6 +117,11 @@ npv_vec <- function(
 
   estimator <- finalize_estimator(truth, estimator)
 
+  if (is.logical(truth)) {
+    event_level <- "second"  # TRUE is second level of levels(factor(truth))
+    truth <- factor(truth)
+    estimate <- if (is.logical(estimate)) factor(estimate) else estimate
+  }
   check_class_metric(truth, estimate, case_weights, estimator)
 
   if (na_rm) {

R/class-ppv.R

@@ -129,6 +129,11 @@ ppv_vec <- function(
 
   estimator <- finalize_estimator(truth, estimator)
 
+  if (is.logical(truth)) {
+    event_level <- "second"  # TRUE is second level of levels(factor(truth))
+    truth <- factor(truth)
+    estimate <- if (is.logical(estimate)) factor(estimate) else estimate
+  }
   check_class_metric(truth, estimate, case_weights, estimator)
 
   if (na_rm) {

R/class-precision.R

@@ -119,6 +119,11 @@ precision_vec <- function(
 
   estimator <- finalize_estimator(truth, estimator)
 
+  if (is.logical(truth)) {
+    event_level <- "second"  # TRUE is second level of levels(factor(truth))
+    truth <- factor(truth)
+    estimate <- if (is.logical(estimate)) factor(estimate) else estimate
+  }
   check_class_metric(truth, estimate, case_weights, estimator)
 
   if (na_rm) {

R/class-recall.R

@@ -119,6 +119,11 @@ recall_vec <- function(
 
   estimator <- finalize_estimator(truth, estimator)
 
+  if (is.logical(truth)) {
+    event_level <- "second"  # TRUE is second level of levels(factor(truth))
+    truth <- factor(truth)
+    estimate <- if (is.logical(estimate)) factor(estimate) else estimate
+  }
   check_class_metric(truth, estimate, case_weights, estimator)
 
   if (na_rm) {

R/class-sens.R

@@ -148,6 +148,11 @@ sens_vec <- function(
 
   estimator <- finalize_estimator(truth, estimator)
 
+  if (is.logical(truth)) {
+    event_level <- "second"  # TRUE is second level of levels(factor(truth))
+    truth <- factor(truth)
+    estimate <- if (is.logical(estimate)) factor(estimate) else estimate
+  }
   check_class_metric(truth, estimate, case_weights, estimator)
 
   if (na_rm) {

R/class-spec.R

@@ -113,6 +113,11 @@ spec_vec <- function(
 
   estimator <- finalize_estimator(truth, estimator)
 
+  if (is.logical(truth)) {
+    event_level <- "second"  # TRUE is second level of levels(factor(truth))
+    truth <- factor(truth)
+    estimate <- if (is.logical(estimate)) factor(estimate) else estimate
+  }
   check_class_metric(truth, estimate, case_weights, estimator)
 
   if (na_rm) {

R/conf_mat.R

@@ -224,6 +224,10 @@ conf_mat_impl <- function(truth, estimate, case_weights, call = caller_env()) {
   estimate <- as_factor_from_class_pred(estimate, call = call)
 
   estimator <- "not binary"
+  if (is.logical(truth)) {
+    truth <- factor(truth)
+    estimate <- if (is.logical(estimate)) factor(estimate) else estimate
+  }
   check_class_metric(truth, estimate, case_weights, estimator, call = call)
 
   if (length(levels(truth)) < 2) {

R/prob-brier_class.R

@@ -91,6 +91,9 @@ brier_class_vec <- function(
 
   estimator <- finalize_estimator(truth, metric_class = "brier_class")
 
+  if (is.logical(truth)) {
+    truth <- factor(truth)
+  }
   check_prob_metric(truth, estimate, case_weights, estimator)
 
   if (na_rm) {

R/prob-classification_cost.R

@@ -148,6 +148,10 @@ classification_cost_vec <- function(
 
   estimator <- finalize_estimator(truth, metric_class = "classification_cost")
 
+  if (is.logical(truth)) {
+    event_level <- "second"  # TRUE is second level of levels(factor(truth))
+    truth <- factor(truth)
+  }
   check_prob_metric(truth, estimate, case_weights, estimator)
 
   if (na_rm) {

R/prob-gain_capture.R

@@ -93,6 +93,10 @@ gain_capture_vec <- function(
 
   estimator <- finalize_estimator(truth, estimator, "gain_capture")
 
+  if (is.logical(truth)) {
+    event_level <- "second"  # TRUE is second level of levels(factor(truth))
+    truth <- factor(truth)
+  }
   check_prob_metric(truth, estimate, case_weights, estimator)
 
   if (na_rm) {

R/prob-gain_curve.R

@@ -143,6 +143,10 @@ gain_curve_vec <- function(
 
   estimator <- finalize_estimator(truth, metric_class = "gain_curve")
 
+  if (is.logical(truth)) {
+    event_level <- "second"  # TRUE is second level of levels(factor(truth))
+    truth <- factor(truth)
+  }
   check_prob_metric(truth, estimate, case_weights, estimator)
 
   if (na_rm) {

R/prob-mn_log_loss.R

@@ -117,6 +117,10 @@ mn_log_loss_vec <- function(
 
   estimator <- finalize_estimator(truth, metric_class = "mn_log_loss")
 
+  if (is.logical(truth)) {
+    event_level <- "second"  # TRUE is second level of levels(factor(truth))
+    truth <- factor(truth)
+  }
   check_prob_metric(truth, estimate, case_weights, estimator)
 
   if (na_rm) {

R/prob-pr_auc.R

@@ -90,6 +90,10 @@ pr_auc_vec <- function(
 
   estimator <- finalize_estimator(truth, estimator, "pr_auc")
 
+  if (is.logical(truth)) {
+    event_level <- "second"  # TRUE is second level of levels(factor(truth))
+    truth <- factor(truth)
+  }
   check_prob_metric(truth, estimate, case_weights, estimator)
 
   if (na_rm) {

R/prob-pr_curve.R

@@ -99,6 +99,10 @@ pr_curve_vec <- function(
 
   estimator <- finalize_estimator(truth, metric_class = "pr_curve")
 
+  if (is.logical(truth)) {
+    event_level <- "second"  # TRUE is second level of levels(factor(truth))
+    truth <- factor(truth)
+  }
   check_prob_metric(truth, estimate, case_weights, estimator)
 
   if (na_rm) {

R/prob-roc_auc.R

@@ -137,6 +137,10 @@ roc_auc_vec <- function(
     case_weights = case_weights
   )
 
+  if (is.logical(truth)) {
+    event_level <- "second"  # TRUE is second level of levels(factor(truth))
+    truth <- factor(truth)
+  }
   check_prob_metric(truth, estimate, case_weights, estimator)
 
   if (na_rm) {

R/prob-roc_aunp.R

@@ -127,6 +127,9 @@ roc_aunp_vec <- function(
 
   estimator <- "macro_weighted"
 
+  if (is.logical(truth)) {
+    truth <- factor(truth)
+  }
   check_prob_metric(truth, estimate, case_weights, estimator)
 
   if (na_rm) {

R/prob-roc_aunu.R

@@ -127,6 +127,9 @@ roc_aunu_vec <- function(
 
   estimator <- "macro"
 
+  if (is.logical(truth)) {
+    truth <- factor(truth)
+  }
   check_prob_metric(truth, estimate, case_weights, estimator)
 
   if (na_rm) {

R/prob-roc_curve.R

@@ -106,6 +106,10 @@ roc_curve_vec <- function(
 
   estimator <- finalize_estimator(truth, metric_class = "roc_curve")
 
+  if (is.logical(truth)) {
+    event_level <- "second"  # TRUE is second level of levels(factor(truth))
+    truth <- factor(truth)
+  }
   check_prob_metric(truth, estimate, case_weights, estimator)
 
   if (na_rm) {

tests/testthat/_snaps/class-accuracy.md

@@ -6,3 +6,21 @@
       Error in `accuracy_vec()`:
       ! `truth` should not a <class_pred> object.
 
+# reject character input
+
+    Code
+      accuracy_vec(two_class_example$truth == "Class1", c("TRUE", "FALSE")[as.integer(
+        two_class_example$predicted)])
+    Condition
+      Error in `accuracy_vec()`:
+      ! `estimate` should be a factor, not a a character vector.
+
+---
+
+    Code
+      accuracy_vec(c("TRUE", "FALSE")[as.integer(two_class_example$truth)],
+      two_class_example$predicted == "Class1")
+    Condition
+      Error in `accuracy_vec()`:
+      ! `truth` should be a factor, not a a character vector.
+

tests/testthat/test-class-accuracy.R

@@ -120,3 +120,22 @@ test_that("Multi class - sklearn equivalent", {
     py_res$multiclass
   )
 })
+
+test_that("reject character input", {
+  expect_snapshot(
+    error = TRUE,
+    accuracy_vec(
+      two_class_example$truth == 'Class1',
+      c("TRUE", "FALSE")[as.integer(two_class_example$predicted)]
+    )
+  )
+
+  expect_snapshot(
+    error = TRUE,
+    accuracy_vec(
+      c("TRUE", "FALSE")[as.integer(two_class_example$truth)],
+      two_class_example$predicted == 'Class1'
+    )
+  )
+})
+

tests/testthat/test-class-bal_accuracy.R

@@ -116,3 +116,15 @@ test_that("Two class weighted - sklearn equivalent", {
     py_res$case_weight$binary
   )
 })
+
+
+test_that("logical inputs work", {
+  expect_equal(
+    bal_accuracy_vec(
+      two_class_example$truth == 'Class1',
+      two_class_example$predicted == 'Class1'
+    ) |>
+      round(4),
+    0.8366
+  )
+})

tests/testthat/test-prob-roc_auc.R

@@ -532,3 +532,14 @@ test_that("errors with class_pred input", {
     roc_auc_vec(cp_truth, estimate)
   )
 })
+
+test_that("logical inputs work", {
+  expect_equal(
+    roc_auc_vec(
+      two_class_example$truth == 'Class1',
+      two_class_example$Class1
+    ) |>
+      round(4),
+    0.9393
+  )
+})