From 3c4b132fb4c09693ffae5a1b5a6e63e9b26e2441 Mon Sep 17 00:00:00 2001
From: Andreas Gammelgaard Damsbo <andreas@gdamsbo.dk>
Date: Tue, 4 Mar 2025 13:54:58 +0100
Subject: [PATCH] interpret single level vectors correctly

---
 NEWS.md        |  2 +-
 R/as_logical.R | 37 ++++++++++++++++++++++++++-----------
 2 files changed, 27 insertions(+), 12 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 040433c..1659bf8 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -2,7 +2,7 @@
 
 * FIX: `as_factor()` now interprets empty variables with empty levels attribute as logicals to avoid returning factors with empty levels.
 
-* NEW: `as_logical()`: interprets vectors with two levels as logical if values matches supplied list of logical pairs like "TRUE"/"FALSE", "Yes"/"No" or 1/2. Eases interpretation of data from databases with minimal metadata.
+* NEW: `as_logical()`: interprets vectors with two levels as logical if values matches supplied list of logical pairs like "TRUE"/"FALSE", "Yes"/"No" or 1/2. Eases interpretation of data from databases with minimal metadata. Works on vectors and for data.frames. Interprets vectors with single value also matching to any of supplied levels (Chooses first match pair if several matches).
 
 # REDCapCAST 25.1.1
 
diff --git a/R/as_logical.R b/R/as_logical.R
index e3e2e38..6ff6a17 100644
--- a/R/as_logical.R
+++ b/R/as_logical.R
@@ -22,6 +22,9 @@
 #'   as_logical() |>
 #'   sapply(class)
 #' ds$A |> class()
+#' sample(c("TRUE",NA), 20, TRUE) |>
+#'   as_logical()
+#' as_logical(0)
 #' @name as_logical
 as_logical <- function(x,
                        values = list(
@@ -69,17 +72,29 @@ as_logical.default <- function(x,
       "factor",
       "numeric"
     ) %in% class(x)
-  ) &&
-    length(unique(x[!is.na(x)])) == 2) {
-    if (is.factor(x)) {
-      match_index <- which(sapply(values, \(.x){
-        all(.x %in% levels(x))
-      }))
-    } else {
-      match_index <- which(sapply(values, \(.x){
-        all(.x %in% x)
-      }))
-    }
+  )){
+   if (length(unique(x[!is.na(x)])) == 2) {
+     if (is.factor(x)) {
+       match_index <- which(sapply(values, \(.x){
+         all(.x %in% levels(x))
+       }))
+     } else {
+       match_index <- which(sapply(values, \(.x){
+         all(.x %in% x)
+       }))
+     }
+   } else if (length(unique(x[!is.na(x)])) == 1){
+     if (is.factor(x)) {
+       match_index <- which(sapply(values, \(.x){
+         any(.x %in% levels(x))
+       }))
+     } else {
+       match_index <- which(sapply(values, \(.x){
+         any(.x %in% x)
+       }))
+     }
+  }
+
     if (length(match_index) == 1) {
       out <- x == values[[match_index]][1]
     } else if (length(match_index) > 1) {