andreas/REDCapCAST
1
0
Fork 0
mirror of https://github.com/agdamsbo/REDCapCAST.git synced 2025-04-22 06:12:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

interpret single level vectors correctly

Browse Source
This commit is contained in:
Andreas Gammelgaard Damsbo 2025-03-04 13:54:58 +01:00
parent bb24a7d7bd
commit 3c4b132fb4
No known key found for this signature in database
2 changed files with 27 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
NEWS.md
View File

@ -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

37
R/as_logical.R
View File

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