Compare commits

...

6 Commits

13 changed files with 141 additions and 66 deletions

View File

@ -4,6 +4,10 @@
* 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).
* NEW: `easy_redcap()`: new parameter `data_format` to specify data format as c("wide", "list", "redcap", "long"). For now "redcap" and "long" is treated equally. This was added to ease MMRM analyses. In that case, missing baseline values can be carried forward as "last observation carried forward" using the `tidyr::fill()` function specifying variables to fill. Interesting discussion on filling data [here on Stackoverflow](https://stackoverflow.com/a/13810615). `redcap_read_tables()` now has the option "none" for the `split_forms` parameter to allow not splitting the data.
* FIX: `ds2dd_detailed()`: The `convert_logicals` parameter has been turned off by default and logicals are now interpreted as field type "truefalse". Converting logicals to factors would result in the numeric values being 1 for FALSE and 2 for TRUE, which is opposite of the traditional notation and could lead to serous problems if not handled correctly. This should solve it.
# REDCapCAST 25.1.1
The newly introduced extension of `forcats::fct_drop()` has been corrected to work as intended as a method.

View File

@ -86,6 +86,11 @@ REDCap_split <- function(records,
metadata,
primary_table_name = "",
forms = c("repeating", "all")) {
# Processing metadata to reflect focused dataset
# metadata <- focused_metadata(metadata, names(records))
# Requires new testing setup. Not doing that now.
# Process user input
records <- process_user_input(records)
metadata <-

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

View File

@ -26,11 +26,13 @@ get_api_key <- function(key.name, ...) {
#'
#' @param project.name The name of the current project (for key storage with
#' \link[keyring]{key_set}, using the default keyring)
#' @param widen.data argument to widen the exported data
#' @param widen.data argument to widen the exported data. [DEPRECATED], use
#' `data_format`instead
#' @param uri REDCap database API uri
#' @param raw_or_label argument passed on to
#' \link[REDCapCAST]{read_redcap_tables}. Default is "both" to get labelled
#' data.
#' @param data_format Choose the data
#' @param ... arguments passed on to \link[REDCapCAST]{read_redcap_tables}.
#'
#' @return data.frame or list depending on widen.data
@ -41,27 +43,54 @@ get_api_key <- function(key.name, ...) {
#' easy_redcap("My_new_project", fields = c("record_id", "age", "hypertension"))
#' }
easy_redcap <- function(project.name,
widen.data = TRUE,
uri,
raw_or_label = "both",
data_format = c("wide", "list", "redcap", "long"),
widen.data = NULL,
...) {
data_format <- match.arg(data_format)
# Interpretation of "widen.data" is kept and will override "data_format"
# for legacy sake
if (isTRUE(widen.data)) {
data_format <- "wide"
}
if (data_format %in% c("wide", "list")) {
split_action <- "all"
} else {
split_action <- "none"
}
key <- get_api_key(
key.name = paste0(project.name, "_REDCAP_API"),
prompt = "Provide REDCap API key:"
)
out <- read_redcap_tables(
redcap_data <- read_redcap_tables(
uri = uri,
token = key,
raw_or_label = raw_or_label,
split_forms = split_action,
...
)
if (widen.data) {
out <- out |>
# For now, long data format is just legacy REDCap
# All options are written out for future improvements
if (data_format == "wide") {
out <- redcap_data |>
redcap_wider() |>
suffix2label()
} else if (data_format == "list") {
# The read_redcap_tables() output is a list of tables (forms)
out <- redcap_data
} else if (data_format == "long") {
out <- redcap_data
} else if (data_format == "redcap") {
out <- redcap_data
}
out
}

View File

@ -26,7 +26,7 @@
#' \link[REDCapCAST]{fct_drop} to drop empty levels.
#'
#' @param split_forms Whether to split "repeating" or "all" forms, default is
#' all.
#' all. Give "none" to export native semi-long REDCap format
#' @param ... passed on to \link[REDCapR]{redcap_read}
#'
#' @return list of instruments
@ -42,22 +42,24 @@ read_redcap_tables <- function(uri,
fields = NULL,
events = NULL,
forms = NULL,
raw_or_label = c("raw","label","both"),
split_forms = "all",
raw_or_label = c("raw", "label", "both"),
split_forms = c("all", "repeating", "none"),
...) {
raw_or_label <- match.arg(raw_or_label, c("raw","label","both"))
raw_or_label <- match.arg(raw_or_label, c("raw", "label", "both"))
split_forms <- match.arg(split_forms)
# Getting metadata
m <-
REDCapR::redcap_metadata_read(redcap_uri = uri, token = token)[["data"]]
if (!is.null(fields)) {
fields_test <- fields %in% c(m$field_name,paste0(unique(m$form_name),"_complete"))
fields_test <- fields %in% c(m$field_name, paste0(unique(m$form_name), "_complete"))
if (any(!fields_test)) {
print(paste0("The following field names are invalid: ",
paste(fields[!fields_test], collapse = ", "), "."))
print(paste0(
"The following field names are invalid: ",
paste(fields[!fields_test], collapse = ", "), "."
))
stop("Not all supplied field names are valid")
}
}
@ -67,8 +69,10 @@ read_redcap_tables <- function(uri,
forms_test <- forms %in% unique(m$form_name)
if (any(!forms_test)) {
print(paste0("The following form names are invalid: ",
paste(forms[!forms_test], collapse = ", "), "."))
print(paste0(
"The following form names are invalid: ",
paste(forms[!forms_test], collapse = ", "), "."
))
stop("Not all supplied form names are valid")
}
}
@ -82,13 +86,15 @@ read_redcap_tables <- function(uri,
event_test <- events %in% unique(arm_event_inst$data$unique_event_name)
if (any(!event_test)) {
print(paste0("The following event names are invalid: ",
paste(events[!event_test], collapse = ", "), "."))
print(paste0(
"The following event names are invalid: ",
paste(events[!event_test], collapse = ", "), "."
))
stop("Not all supplied event names are valid")
}
}
if (raw_or_label=="both"){
if (raw_or_label == "both") {
rorl <- "raw"
} else {
rorl <- raw_or_label
@ -106,10 +112,10 @@ read_redcap_tables <- function(uri,
...
)[["data"]]
if (raw_or_label=="both"){
d <- apply_field_label(data=d,meta=m)
if (raw_or_label == "both") {
d <- apply_field_label(data = d, meta = m)
d <- apply_factor_labels(data=d,meta=m)
d <- apply_factor_labels(data = d, meta = m)
}
@ -123,15 +129,16 @@ read_redcap_tables <- function(uri,
# Processing metadata to reflect focused dataset
m <- focused_metadata(m, names(d))
# Splitting
out <- REDCap_split(d,
m,
forms = split_forms,
primary_table_name = ""
)
sanitize_split(out)
if (split_forms != "none") {
REDCap_split(d,
m,
forms = split_forms,
primary_table_name = ""
) |> sanitize_split()
} else {
d
}
}
@ -171,7 +178,7 @@ clean_field_label <- function(data) {
#' @export
#'
#' @examples
#' format_redcap_factor(sample(1:3,20,TRUE),"1, First. | 2, second | 3, THIRD")
#' format_redcap_factor(sample(1:3, 20, TRUE), "1, First. | 2, second | 3, THIRD")
format_redcap_factor <- function(data, meta) {
lvls <- strsplit(meta, " | ", fixed = TRUE) |>
unlist() |>
@ -196,13 +203,13 @@ format_redcap_factor <- function(data, meta) {
#' @return data.frame
#' @export
#'
apply_field_label <- function(data,meta){
apply_field_label <- function(data, meta) {
purrr::imap(data, \(.x, .i){
if (.i %in% meta$field_name) {
# Does not handle checkboxes
out <- set_attr(.x,
label = clean_field_label(meta$field_label[meta$field_name == .i]),
attr = "label"
label = clean_field_label(meta$field_label[meta$field_name == .i]),
attr = "label"
)
out
} else {
@ -219,8 +226,8 @@ apply_field_label <- function(data,meta){
#' @return data.frame
#' @export
#'
apply_factor_labels <- function(data,meta=NULL){
if (is.list(data) && !is.data.frame(data)){
apply_factor_labels <- function(data, meta = NULL) {
if (is.list(data) && !is.data.frame(data)) {
meta <- data$meta
data <- data$data
} else if (is.null(meta)) {
@ -234,5 +241,3 @@ apply_factor_labels <- function(data,meta=NULL){
}
}) |> dplyr::bind_cols()
}

View File

@ -1,5 +1,6 @@
── R CMD check results ─────────────────────────────────────────────────────────────────────── REDCapCAST 25.1.1 ────
Duration: 31.2s
── R CMD check results ─────────────────────────────────────────────────────────────────────────────────────────────────────────────── REDCapCAST 25.3.1 ────
Duration: 28.5s
0 errors ✔ | 0 warnings ✔ | 0 notes ✔

View File

@ -11,6 +11,7 @@ GithubActions
JSON
Lifecycle
METACRAN
MMRM
Nav
ORCID
POSIXct
@ -18,6 +19,7 @@ REDCap
REDCapR
REDCapRITS
REDCapTidieR
Stackoverflow
WD
al
api

View File

@ -52,4 +52,7 @@ ds |>
as_logical() |>
sapply(class)
ds$A |> class()
sample(c("TRUE",NA), 20, TRUE) |>
as_logical()
as_logical(0)
}

View File

@ -49,5 +49,5 @@ Migrated from stRoke ds2dd(). Fits better with the functionality of
}
\examples{
redcapcast_data$record_id <- seq_len(nrow(redcapcast_data))
ds2dd(redcapcast_data, include.column.names=TRUE)
ds2dd(redcapcast_data, include.column.names = TRUE)
}

View File

@ -16,7 +16,7 @@ ds2dd_detailed(
field.label.attr = "label",
field.validation = NULL,
metadata = names(REDCapCAST::redcapcast_meta),
convert.logicals = TRUE
convert.logicals = FALSE
)
}
\arguments{
@ -91,7 +91,10 @@ iris |>
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 |>

View File

@ -4,20 +4,30 @@
\alias{easy_redcap}
\title{Secure API key storage and data acquisition in one}
\usage{
easy_redcap(project.name, widen.data = TRUE, uri, raw_or_label = "both", ...)
easy_redcap(
project.name,
uri,
raw_or_label = "both",
data_format = c("wide", "list", "redcap", "long"),
widen.data = NULL,
...
)
}
\arguments{
\item{project.name}{The name of the current project (for key storage with
\link[keyring]{key_set}, using the default keyring)}
\item{widen.data}{argument to widen the exported data}
\item{uri}{REDCap database API uri}
\item{raw_or_label}{argument passed on to
\link[REDCapCAST]{read_redcap_tables}. Default is "both" to get labelled
data.}
\item{data_format}{Choose the data}
\item{widen.data}{argument to widen the exported data. [DEPRECATED], use
`data_format`instead}
\item{...}{arguments passed on to \link[REDCapCAST]{read_redcap_tables}.}
}
\value{

View File

@ -19,5 +19,5 @@ Applying \link[REDCapCAST]{as_factor} to the data.frame or variable, will
coerce to a factor.
}
\examples{
format_redcap_factor(sample(1:3,20,TRUE),"1, First. | 2, second | 3, THIRD")
format_redcap_factor(sample(1:3, 20, TRUE), "1, First. | 2, second | 3, THIRD")
}

View File

@ -12,7 +12,7 @@ read_redcap_tables(
events = NULL,
forms = NULL,
raw_or_label = c("raw", "label", "both"),
split_forms = "all",
split_forms = c("all", "repeating", "none"),
...
)
}
@ -40,7 +40,7 @@ read_redcap_tables(
\link[REDCapCAST]{fct_drop} to drop empty levels.}
\item{split_forms}{Whether to split "repeating" or "all" forms, default is
all.}
all. Give "none" to export native semi-long REDCap format}
\item{...}{passed on to \link[REDCapR]{redcap_read}}
}