Interprets logicals

This commit is contained in:
Andreas Gammelgaard Damsbo 2025-03-05 13:40:40 +01:00
parent c9ee46f6a4
commit 2e1e7822a4
No known key found for this signature in database

View File

@ -127,8 +127,7 @@ hms2character <- function(data) {
#'
#' @examples
#' redcapcast_data$record_id <- seq_len(nrow(redcapcast_data))
#' ds2dd(redcapcast_data, include.column.names=TRUE)
#' ds2dd(redcapcast_data, include.column.names = TRUE)
ds2dd <-
function(ds,
record.id = "record_id",
@ -136,8 +135,7 @@ ds2dd <-
field.type = "text",
field.label = NULL,
include.column.names = FALSE,
metadata = names(REDCapCAST::redcapcast_meta)
) {
metadata = names(REDCapCAST::redcapcast_meta)) {
dd <- data.frame(matrix(ncol = length(metadata), nrow = ncol(ds)))
colnames(dd) <- metadata
@ -178,12 +176,15 @@ ds2dd <-
if (is.null(field.label)) {
dd[, "field_label"] <- dd[, "field_name"]
} else
} else {
dd[, "field_label"] <- field.label
}
if (include.column.names){
list("DataDictionary"=dd,"Column names"=field.name)
} else dd
if (include.column.names) {
list("DataDictionary" = dd, "Column names" = field.name)
} else {
dd
}
}
@ -246,7 +247,10 @@ ds2dd <-
#' form.name = sample(c("b", "c"), size = 6, replace = TRUE, prob = rep(.5, 2))
#' ) |>
#' purrr::pluck("meta")
#' mtcars |> numchar2fct() |> ds2dd_detailed(add.auto.id = TRUE)
#' mtcars |>
#' dplyr::mutate(unknown = NA) |>
#' numchar2fct() |>
#' ds2dd_detailed(add.auto.id = TRUE)
#'
#' ## Using column name suffix to carry form name
#' data <- iris |>
@ -266,16 +270,21 @@ ds2dd_detailed <- function(data,
field.label.attr = "label",
field.validation = NULL,
metadata = names(REDCapCAST::redcapcast_meta),
convert.logicals = TRUE) {
convert.logicals = FALSE) {
short_names <- colnames(data) |>
lapply(\(.x) cut_string_length(.x, l = 90)) |>
purrr::reduce(c)
short_names <- colnames(data) |> lapply(\(.x) cut_string_length(.x,l=90)) |> purrr::reduce(c)
data <- stats::setNames(data,short_names)
data <- stats::setNames(data, short_names)
if (convert.logicals) {
data <- data |>
## Converts logical to factor, which overwrites attributes
dplyr::mutate(dplyr::across(dplyr::where(is.logical), as_factor))
## Problematic example:
## as.logical(sample(0:1,10,TRUE)) |> as.factor() |> as.numeric()
## Possible solution would be to subtract values by 1, so
## "0, FALSE | 1, TRUE" like native REDCap
}
## Handles the odd case of no id column present
@ -369,9 +378,14 @@ ds2dd_detailed <- function(data,
dd$field_type <- "text"
dd <-
dd |> dplyr::mutate(field_type = dplyr::if_else(data_classes == "factor",
"radio", field_type
))
dd |> dplyr::mutate(
field_type = dplyr::case_match(
data_classes,
"factor"~"radio",
"logical"~"truefalse",
.default = field_type
)
)
} else {
if (length(field.type) == 1 || length(field.type) == nrow(dd)) {
dd$field_type <- field.type
@ -432,7 +446,7 @@ ds2dd_detailed <- function(data,
hms2character() |>
stats::setNames(dd$field_name) |>
lapply(\(.x){
if (identical("factor",class(.x))){
if (identical("factor", class(.x))) {
as.numeric(.x)
} else {
.x
@ -679,7 +693,6 @@ vec2choice <- function(data) {
#' "test" |> compact_vec()
#' sample(letters[1:9], 20, TRUE) |> compact_vec()
compact_vec <- function(data, nm.sep = ": ", val.sep = "; ") {
# browser()
if (all(is.na(data))) {
return(data)
}