mirror of
https://github.com/agdamsbo/REDCapCAST.git
synced 2025-04-01 21:52:32 +02:00
Compare commits
6 Commits
3ae16b767f
...
821e4583dd
Author | SHA1 | Date | |
---|---|---|---|
821e4583dd | |||
58e63eb1cf | |||
10064d7ee0 | |||
0b5319f647 | |||
2e1e7822a4 | |||
c9ee46f6a4 |
4
NEWS.md
4
NEWS.md
@ -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.
|
||||
|
@ -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 <-
|
||||
|
@ -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)
|
||||
}
|
||||
|
@ -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
|
||||
}
|
||||
|
||||
|
||||
|
@ -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()
|
||||
}
|
||||
|
||||
|
||||
|
@ -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 ✔
|
||||
|
||||
|
@ -11,6 +11,7 @@ GithubActions
|
||||
JSON
|
||||
Lifecycle
|
||||
METACRAN
|
||||
MMRM
|
||||
Nav
|
||||
ORCID
|
||||
POSIXct
|
||||
@ -18,6 +19,7 @@ REDCap
|
||||
REDCapR
|
||||
REDCapRITS
|
||||
REDCapTidieR
|
||||
Stackoverflow
|
||||
WD
|
||||
al
|
||||
api
|
||||
|
@ -52,4 +52,7 @@ ds |>
|
||||
as_logical() |>
|
||||
sapply(class)
|
||||
ds$A |> class()
|
||||
sample(c("TRUE",NA), 20, TRUE) |>
|
||||
as_logical()
|
||||
as_logical(0)
|
||||
}
|
||||
|
@ -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)
|
||||
}
|
||||
|
@ -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 |>
|
||||
|
@ -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{
|
||||
|
@ -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")
|
||||
}
|
||||
|
@ -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}}
|
||||
}
|
||||
|
Loading…
x
Reference in New Issue
Block a user