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) {