andreas/REDCapCAST
1
0
Fork 0
mirror of https://github.com/agdamsbo/REDCapCAST.git synced 2026-06-19 13:17:30 +02:00
Code Issues Projects Releases Packages 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
commit 3c4b132fb4
No known key found for this signature in database
2 changed files with 27 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

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