Compare commits

..

No commits in common. "7948bfc65da474207da0e2491fd10770b82310b6" and "5979b972e11e45ef2377f66ce7598d8324e99bc8" have entirely different histories.

20 changed files with 237 additions and 390 deletions

View File

@ -20,6 +20,7 @@ export(strsplitx)
importFrom(REDCapR,redcap_event_instruments) importFrom(REDCapR,redcap_event_instruments)
importFrom(REDCapR,redcap_metadata_read) importFrom(REDCapR,redcap_metadata_read)
importFrom(REDCapR,redcap_read) importFrom(REDCapR,redcap_read)
importFrom(dplyr,left_join)
importFrom(keyring,key_get) importFrom(keyring,key_get)
importFrom(keyring,key_list) importFrom(keyring,key_list)
importFrom(keyring,key_set) importFrom(keyring,key_set)

View File

@ -4,9 +4,7 @@
* Fix: `ds2dd()`: uses correct default dd column names. Will be deprecated. * Fix: `ds2dd()`: uses correct default dd column names. Will be deprecated.
* Fix: `easy_redcap()`: fixed to actually allow project naming. also specifically asks for uri. widening updated to work. * Fix: `easy_redcap()`: fixed to actually allow project naming. also specifically asks for uri.
* Fix: `redcap_wider()`: updated to accept more formats and allow handling of simple projects without repeating instruments and not longitudinal.
* Fix: `read_redcap_tables()`: now handles non-longitudinal project without repeatable instruments. * Fix: `read_redcap_tables()`: now handles non-longitudinal project without repeatable instruments.

View File

@ -92,13 +92,13 @@ REDCap_split <- function(records,
metadata <- metadata <-
as.data.frame(process_user_input(metadata)) as.data.frame(process_user_input(metadata))
# Process repeat instrument names to match the redcap naming
records$redcap_repeat_instrument <- clean_redcap_name(records$redcap_repeat_instrument)
# Get the variable names in the dataset # Get the variable names in the dataset
vars_in_data <- names(records) vars_in_data <- names(records)
# Process repeat instrument names to match the redcap naming
if (is.repeated_longitudinal(records)){
records$redcap_repeat_instrument <- clean_redcap_name(records$redcap_repeat_instrument)
# Match arg for forms # Match arg for forms
forms <- match.arg(forms, c("repeating", "all")) forms <- match.arg(forms, c("repeating", "all"))
@ -116,7 +116,6 @@ REDCap_split <- function(records,
as.character(records$redcap_repeat_instrument) as.character(records$redcap_repeat_instrument)
) )
} }
}
# Standardize variable names for metadata # Standardize variable names for metadata
# names(metadata) <- metadata_names # names(metadata) <- metadata_names
@ -139,8 +138,6 @@ REDCap_split <- function(records,
) )
) )
if ("redcap_repeat_instrument" %in% vars_in_data) { if ("redcap_repeat_instrument" %in% vars_in_data) {
# Variables to be at the beginning of each repeating instrument # Variables to be at the beginning of each repeating instrument
repeat_instrument_fields <- grep("^redcap_repeat.*", repeat_instrument_fields <- grep("^redcap_repeat.*",
@ -199,5 +196,5 @@ REDCap_split <- function(records,
} }
out out
}
}

View File

@ -10,7 +10,7 @@ get_api_key <- function(key.name) {
if (key.name %in% keyring::key_list()$service) { if (key.name %in% keyring::key_list()$service) {
keyring::key_get(service = key.name) keyring::key_get(service = key.name)
} else { } else {
keyring::key_set(service = key.name, prompt = "Provide REDCap API key:") keyring::key_set(service = key.name, prompt = "Write REDCap API key:")
keyring::key_get(service = key.name) keyring::key_get(service = key.name)
} }
} }
@ -19,25 +19,41 @@ get_api_key <- function(key.name) {
#' Secure API key storage and data acquisition in one #' Secure API key storage and data acquisition in one
#' #'
#' @param project.name The name of the current project (for key storage with #' @param project.name The name of the current project (for key storage with
#' `keyring::key_set()`, using the default keyring) #' `keyring::key_set()`)
#' @param widen.data argument to widen the exported data #' @param widen.data argument to widen the exported data
#' @param uri REDCap database API uri #' @param uri REDCap database API uri
#' @param ... arguments passed on to `REDCapCAST::read_redcap_tables()` #' @param ... arguments passed on to `REDCapCAST::read_redcap_tables()`
#' #'
#' @return data.frame or list depending on widen.data #' @return data.frame or list depending on widen.data
#' @importFrom purrr reduce
#' @importFrom dplyr left_join
#' @export #' @export
easy_redcap <- function(project.name, widen.data = TRUE, uri, ...) { easy_redcap <- function(project.name, widen.data = TRUE, uri, ...) {
key <- get_api_key(key.name = paste0(project.name, "_REDCAP_API")) key <- get_api_key(key.name = paste0(project.name, "_REDCAP_API"))
out <- read_redcap_tables( out <- read_redcap_tables(
uri = uri,
token = key, token = key,
uri = uri,
... ...
) )
all_names <- out |>
lapply(names) |>
Reduce(c, x = _) |>
unique()
if (widen.data) { if (widen.data) {
if (!any(c("redcap_event_name", "redcap_repeat_instrument") %in%
all_names)) {
if (length(out) == 1) {
out <- out[[1]]
} else {
out <- out |> purrr::reduce(dplyr::left_join)
}
} else {
out <- out |> redcap_wider() out <- out |> redcap_wider()
} }
}
out out
} }

View File

@ -31,12 +31,20 @@ read_redcap_tables <- function(uri,
events = NULL, events = NULL,
forms = NULL, forms = NULL,
raw_or_label = "label", raw_or_label = "label",
split_forms = "all") { split_forms = "all",
generics = c(
"redcap_event_name",
"redcap_repeat_instrument",
"redcap_repeat_instance"
)) {
# Getting metadata # Getting metadata
m <- m <-
REDCapR::redcap_metadata_read (redcap_uri = uri, token = token)[["data"]] REDCapR::redcap_metadata_read (redcap_uri = uri, token = token)[["data"]]
if (!is.null(fields)){ if (!is.null(fields)){
fields_test <- fields %in% unique(m$field_name) fields_test <- fields %in% unique(m$field_name)
if (any(!fields_test)){ if (any(!fields_test)){
@ -47,6 +55,7 @@ read_redcap_tables <- function(uri,
if (!is.null(forms)){ if (!is.null(forms)){
forms_test <- forms %in% unique(m$form_name) forms_test <- forms %in% unique(m$form_name)
if (any(!forms_test)){ if (any(!forms_test)){
@ -56,10 +65,8 @@ read_redcap_tables <- function(uri,
} }
if (!is.null(events)){ if (!is.null(events)){
arm_event_inst <- REDCapR::redcap_event_instruments( arm_event_inst <- REDCapR::redcap_event_instruments(redcap_uri = uri,
redcap_uri = uri, token = token)
token = token
)
event_test <- events %in% unique(arm_event_inst$data$unique_event_name) event_test <- events %in% unique(arm_event_inst$data$unique_event_name)
@ -88,17 +95,28 @@ read_redcap_tables <- function(uri,
} }
# Processing metadata to reflect focused dataset # Processing metadata to reflect focused dataset
if (!is.null(c(fields,forms,events))){
m <- focused_metadata(m,names(d)) m <- focused_metadata(m,names(d))
}
if (any(generics %in% names(d))){
# Splitting # Splitting
out <- REDCap_split(d, l <- REDCap_split(d,
m, m,
forms = split_forms, forms = split_forms,
primary_table_name = "" primary_table_name = "")
)
sanitize_split(out) # Sanitizing split list by removing completely empty rows apart from colnames
# in "generics"
sanitize_split(l,c(names(d)[1],generics))
} else {
# If none of generics are present, the data base is not longitudinal,
# and does not have repeatable events, and therefore splitting does not
# make sense. But now we handle that as well.
d
}
} }

View File

@ -5,70 +5,40 @@ utils::globalVariables(c("redcap_wider",
#' @title Redcap Wider #' @title Redcap Wider
#' @description Converts a list of REDCap data frames from long to wide format. #' @description Converts a list of REDCap data frames from long to wide format.
#' Handles longitudinal projects, but not yet repeated instruments. #' Handles longitudinal projects, but not yet repeated instruments.
#' @param data A list of data frames. #' @param list A list of data frames.
#' @param event.glue A dplyr::glue string for repeated events naming #' @param event.glue A dplyr::glue string for repeated events naming
#' @param inst.glue A dplyr::glue string for repeated instruments naming #' @param inst.glue A dplyr::glue string for repeated instruments naming
#' @return The list of data frames in wide format. #' @return The list of data frames in wide format.
#' @export #' @export
#' @importFrom tidyr pivot_wider #' @importFrom tidyr pivot_wider
#' @importFrom tidyselect all_of #' @importFrom tidyselect all_of
#' @importFrom purrr reduce
#' #'
#' @examples #' @examples
#' # Longitudinal #' list <- list(data.frame(record_id = c(1,2,1,2),
#' list1 <- list(data.frame(record_id = c(1,2,1,2),
#' redcap_event_name = c("baseline", "baseline", "followup", "followup"), #' redcap_event_name = c("baseline", "baseline", "followup", "followup"),
#' age = c(25,26,27,28)), #' age = c(25,26,27,28)),
#' data.frame(record_id = c(1,2), #' data.frame(record_id = c(1,2),
#' redcap_event_name = c("baseline", "baseline"), #' redcap_event_name = c("baseline", "baseline"),
#' gender = c("male", "female"))) #' gender = c("male", "female")))
#' redcap_wider(list1) #' redcap_wider(list)
#' # Simpel with two instruments
#' list2 <- list(data.frame(record_id = c(1,2),
#' age = c(25,26)),
#' data.frame(record_id = c(1,2),
#' gender = c("male", "female")))
#' redcap_wider(list2)
#' # Simple with single instrument
#' list3 <- list(data.frame(record_id = c(1,2),
#' age = c(25,26)))
#' redcap_wider(list3)
#' # Longitudinal with repeatable instruments
#' list4 <- list(data.frame(record_id = c(1,2,1,2),
#' redcap_event_name = c("baseline", "baseline", "followup", "followup"),
#' age = c(25,26,27,28)),
#' data.frame(record_id = c(1,1,1,1,2,2,2,2),
#' redcap_event_name = c("baseline", "baseline", "followup", "followup",
#' "baseline", "baseline", "followup", "followup"),
#' redcap_repeat_instrument = "walk",
#' redcap_repeat_instance=c(1,2,1,2,1,2,1,2),
#' dist = c(40, 32, 25, 33, 28, 24, 23, 36)),
#' data.frame(record_id = c(1,2),
#' redcap_event_name = c("baseline", "baseline"),
#' gender = c("male", "female")))
#'redcap_wider(list4)
redcap_wider <- redcap_wider <-
function(data, function(list,
event.glue = "{.value}_{redcap_event_name}", event.glue = "{.value}_{redcap_event_name}",
inst.glue = "{.value}_{redcap_repeat_instance}") { inst.glue = "{.value}_{redcap_repeat_instance}") {
all_names <- unique(do.call(c, lapply(list, names)))
if (!is.repeated_longitudinal(data)) { if (!any(c("redcap_event_name", "redcap_repeat_instrument") %in%
if (is.list(data)) { all_names)) {
if (length(data) == 1) { stop(
out <- data[[1]] "The dataset does not include a 'redcap_event_name' variable.
} else { redcap_wider only handles projects with repeating instruments or
out <- data |> purrr::reduce(dplyr::left_join) longitudinal projects"
} )
} else if (is.data.frame(data)){
out <- data
} }
id.name <- all_names[1]
} else { l <- lapply(list, function(i) {
id.name <- do.call(c, lapply(data, names))[[1]]
l <- lapply(data, function(i) {
rep_inst <- "redcap_repeat_instrument" %in% names(i) rep_inst <- "redcap_repeat_instrument" %in% names(i)
if (rep_inst) { if (rep_inst) {
@ -111,17 +81,13 @@ redcap_wider <-
names_glue = event.glue names_glue = event.glue
) )
s[colnames(s) != "redcap_event_name"] s[colnames(s) != "redcap_event_name"]
} else { } else
i[colnames(i) != "redcap_event_name"] (i[colnames(i) != "redcap_event_name"])
} } else
} else { (i)
i
}
}) })
out <- data.frame(Reduce(f = dplyr::full_join, x = l)) ## Additional conditioning is needed to handle repeated instruments.
}
out data.frame(Reduce(f = dplyr::full_join, x = l))
} }

211
R/utils.r
View File

@ -1,3 +1,5 @@
#' focused_metadata #' focused_metadata
#' @description Extracts limited metadata for variables in a dataset #' @description Extracts limited metadata for variables in a dataset
#' @param metadata A dataframe containing metadata #' @param metadata A dataframe containing metadata
@ -6,6 +8,7 @@
#' @export #' @export
#' #'
focused_metadata <- function(metadata, vars_in_data) { focused_metadata <- function(metadata, vars_in_data) {
if (any(c("tbl_df", "tbl") %in% class(metadata))) { if (any(c("tbl_df", "tbl") %in% class(metadata))) {
metadata <- data.frame(metadata) metadata <- data.frame(metadata)
} }
@ -14,11 +17,9 @@ focused_metadata <- function(metadata, vars_in_data) {
field_type <- grepl(".*[Ff]ield[._][Tt]ype$", names(metadata)) field_type <- grepl(".*[Ff]ield[._][Tt]ype$", names(metadata))
fields <- fields <-
metadata[ metadata[!metadata[, field_type] %in% c("descriptive", "checkbox") &
!metadata[, field_type] %in% c("descriptive", "checkbox") &
metadata[, field_name] %in% vars_in_data, metadata[, field_name] %in% vars_in_data,
field_name field_name]
]
# Process checkbox fields # Process checkbox fields
if (any(metadata[, field_type] == "checkbox")) { if (any(metadata[, field_type] == "checkbox")) {
@ -28,21 +29,18 @@ focused_metadata <- function(metadata, vars_in_data) {
# Processing # Processing
checkbox_basenames <- checkbox_basenames <-
metadata[ metadata[metadata[, field_type] == "checkbox" &
metadata[, field_type] == "checkbox" &
metadata[, field_name] %in% vars_check, metadata[, field_name] %in% vars_check,
field_name field_name]
]
fields <- c(fields, checkbox_basenames) fields <- c(fields, checkbox_basenames)
} }
# Process instrument status fields # Process instrument status fields
form_names <- form_names <-
unique(metadata[, grepl( unique(metadata[, grepl(".*[Ff]orm[._][Nn]ame$",
".*[Ff]orm[._][Nn]ame$", names(metadata))][metadata[, field_name]
names(metadata)
)][metadata[, field_name]
%in% fields]) %in% fields])
form_complete_fields <- paste0(form_names, "_complete") form_complete_fields <- paste0(form_names, "_complete")
@ -56,34 +54,33 @@ focused_metadata <- function(metadata, vars_in_data) {
timestamp_fields <- timestamps timestamp_fields <- timestamps
fields <- c(fields, timestamp_fields) fields <- c(fields, timestamp_fields)
} }
# Process ".*\\.factor" fields supplied by REDCap's export data R script # Process ".*\\.factor" fields supplied by REDCap's export data R script
if (any(grepl("\\.factor$", vars_in_data))) { if (any(grepl("\\.factor$", vars_in_data))) {
factor_fields <- factor_fields <-
do.call( do.call("rbind",
"rbind",
apply(fields, apply(fields,
1, 1,
function(x, y) { function(x, y) {
field_indices <- grepl(paste0("^", x[1], "\\.factor$"), y) field_indices <- grepl(paste0("^", x[1], "\\.factor$"), y)
if (any(field_indices)) { if (any(field_indices))
data.frame( data.frame(
field_name = y[field_indices], field_name = y[field_indices],
form_name = x[2], form_name = x[2],
stringsAsFactors = FALSE, stringsAsFactors = FALSE,
row.names = NULL row.names = NULL
) )
}
}, },
y = vars_in_data y = vars_in_data))
)
)
fields <- c(fields, factor_fields[, 1]) fields <- c(fields, factor_fields[, 1])
} }
metadata[metadata[, field_name] %in% fields, ] metadata[metadata[, field_name] %in% fields, ]
} }
#' clean_redcap_name #' clean_redcap_name
@ -98,17 +95,12 @@ focused_metadata <- function(metadata, vars_in_data) {
#' @export #' @export
#' #'
clean_redcap_name <- function(x){ clean_redcap_name <- function(x){
gsub(
" ", "_", gsub(" ", "_",
gsub( gsub("[' ']$","",
"[' ']$", "", gsub("[^a-z0-9' '_]", "",
gsub(
"[^a-z0-9' '_]", "",
tolower(x) tolower(x)
) )))}
)
)
}
#' Sanitize list of data frames #' Sanitize list of data frames
@ -124,14 +116,11 @@ clean_redcap_name <- function(x) {
#' #'
sanitize_split <- function(l, sanitize_split <- function(l,
generic.names = c( generic.names = c(
"record_id",
"redcap_event_name", "redcap_event_name",
"redcap_repeat_instrument", "redcap_repeat_instrument",
"redcap_repeat_instance" "redcap_repeat_instance"
)) { )) {
generic.names <- c(get_id_name(l),
generic.names,
paste0(names(l), "_complete"))
lapply(l, function(i) { lapply(l, function(i) {
if (ncol(i) > 2) { if (ncol(i) > 2) {
s <- data.frame(i[, !colnames(i) %in% generic.names]) s <- data.frame(i[, !colnames(i) %in% generic.names])
@ -143,19 +132,6 @@ sanitize_split <- function(l,
} }
#' Get the id name
#'
#' @param data data frame or list
#'
#' @return character vector
get_id_name <- function(data) {
if ("list" %in% class(data)) {
do.call(c, lapply(data, names))[[1]]
} else {
names(data)[[1]]
}
}
#' Match fields to forms #' Match fields to forms
#' #'
#' @param metadata A data frame containing field names and form names #' @param metadata A data frame containing field names and form names
@ -167,23 +143,20 @@ get_id_name <- function(data) {
#' #'
#' #'
match_fields_to_form <- function(metadata, vars_in_data) { match_fields_to_form <- function(metadata, vars_in_data) {
metadata <- data.frame(metadata) metadata <- data.frame(metadata)
field_form_name <- grepl(".*([Ff]ield|[Ff]orm)[._][Nn]ame$",names(metadata)) field_form_name <- grepl(".*([Ff]ield|[Ff]orm)[._][Nn]ame$",names(metadata))
field_type <- grepl(".*[Ff]ield[._][Tt]ype$",names(metadata)) field_type <- grepl(".*[Ff]ield[._][Tt]ype$",names(metadata))
fields <- metadata[ fields <- metadata[!metadata[,field_type] %in% c("descriptive", "checkbox"),
!metadata[, field_type] %in% c("descriptive", "checkbox"), field_form_name]
field_form_name
]
names(fields) <- c("field_name", "form_name") names(fields) <- c("field_name", "form_name")
# Process instrument status fields # Process instrument status fields
form_names <- unique(metadata[, grepl( form_names <- unique(metadata[,grepl(".*[Ff]orm[._][Nn]ame$",
".*[Ff]orm[._][Nn]ame$", names(metadata))])
names(metadata)
)])
form_complete_fields <- data.frame( form_complete_fields <- data.frame(
field_name = paste0(form_names, "_complete"), field_name = paste0(form_names, "_complete"),
form_name = form_names, form_name = form_names,
@ -203,65 +176,57 @@ match_fields_to_form <- function(metadata, vars_in_data) {
) )
fields <- rbind(fields, timestamp_fields) fields <- rbind(fields, timestamp_fields)
} }
# Process checkbox fields # Process checkbox fields
if (any(metadata[,field_type] == "checkbox")) { if (any(metadata[,field_type] == "checkbox")) {
checkbox_basenames <- metadata[ checkbox_basenames <- metadata[metadata[,field_type] == "checkbox",
metadata[, field_type] == "checkbox", field_form_name]
field_form_name
]
checkbox_fields <- checkbox_fields <-
do.call( do.call("rbind",
"rbind",
apply(checkbox_basenames, apply(checkbox_basenames,
1, 1,
function(x, y) { function(x, y)
data.frame( data.frame(
field_name = field_name =
y[grepl(paste0("^", x[1], "___((?!\\.factor).)+$"), y[grepl(paste0("^", x[1], "___((?!\\.factor).)+$"),
y, y, perl = TRUE)],
perl = TRUE
)],
form_name = x[2], form_name = x[2],
stringsAsFactors = FALSE, stringsAsFactors = FALSE,
row.names = NULL row.names = NULL
) ),
}, y = vars_in_data))
y = vars_in_data
)
)
fields <- rbind(fields, checkbox_fields) fields <- rbind(fields, checkbox_fields)
} }
# Process ".*\\.factor" fields supplied by REDCap's export data R script # Process ".*\\.factor" fields supplied by REDCap's export data R script
if (any(grepl("\\.factor$", vars_in_data))) { if (any(grepl("\\.factor$", vars_in_data))) {
factor_fields <- factor_fields <-
do.call( do.call("rbind",
"rbind",
apply(fields, apply(fields,
1, 1,
function(x, y) { function(x, y) {
field_indices <- grepl(paste0("^", x[1], "\\.factor$"), y) field_indices <- grepl(paste0("^", x[1], "\\.factor$"), y)
if (any(field_indices)) { if (any(field_indices))
data.frame( data.frame(
field_name = y[field_indices], field_name = y[field_indices],
form_name = x[2], form_name = x[2],
stringsAsFactors = FALSE, stringsAsFactors = FALSE,
row.names = NULL row.names = NULL
) )
}
}, },
y = vars_in_data y = vars_in_data))
)
)
fields <- rbind(fields, factor_fields) fields <- rbind(fields, factor_fields)
} }
fields fields
} }
#' Split a data frame into separate tables for each form #' Split a data frame into separate tables for each form
@ -291,12 +256,10 @@ match_fields_to_form <- function(metadata, vars_in_data) {
#' #'
#' # Create the fields #' # Create the fields
#' fields <- matrix( #' fields <- matrix(
#' c( #' c("form_a_name", "form_a",
#' "form_a_name", "form_a",
#' "form_a_age", "form_a", #' "form_a_age", "form_a",
#' "form_b_name", "form_b", #' "form_b_name", "form_b",
#' "form_b_gender", "form_b" #' "form_b_gender", "form_b"),
#' ),
#' ncol = 2, byrow = TRUE #' ncol = 2, byrow = TRUE
#' ) #' )
#' #'
@ -306,17 +269,14 @@ split_non_repeating_forms <-
function(table, universal_fields, fields) { function(table, universal_fields, fields) {
forms <- unique(fields[[2]]) forms <- unique(fields[[2]])
x <- lapply( x <- lapply(forms,
forms,
function (x) { function (x) {
table[names(table) %in% union( table[names(table) %in% union(universal_fields,
universal_fields, fields[fields[, 2] == x, 1])]
fields[fields[, 2] == x, 1] })
)]
}
)
structure(x, names = forms) structure(x, names = forms)
} }
@ -346,33 +306,26 @@ strsplitx <- function(x,
out <- base::strsplit(x = x, split = split, perl = perl, ...) out <- base::strsplit(x = x, split = split, perl = perl, ...)
} else if (type == "before") { } else if (type == "before") {
# split before the delimiter and keep it # split before the delimiter and keep it
out <- base::strsplit( out <- base::strsplit(x = x,
x = x,
split = paste0("(?<=.)(?=", split, ")"), split = paste0("(?<=.)(?=", split, ")"),
perl = TRUE, perl = TRUE,
... ...)
)
} else if (type == "after") { } else if (type == "after") {
# split after the delimiter and keep it # split after the delimiter and keep it
out <- base::strsplit( out <- base::strsplit(x = x,
x = x,
split = paste0("(?<=", split, ")"), split = paste0("(?<=", split, ")"),
perl = TRUE, perl = TRUE,
... ...)
)
} else if (type == "around") { } else if (type == "around") {
# split around the defined delimiter # split around the defined delimiter
out <- base::strsplit(gsub( out <- base::strsplit(gsub("~~", "~", # Removes double ~
"~~", "~", # Removes double ~ gsub("^~", "", # Removes leading ~
gsub(
"^~", "", # Removes leading ~
gsub( gsub(
# Splits and inserts ~ at all delimiters # Splits and inserts ~ at all delimiters
paste0("(", split, ")"), "~\\1~", x paste0("(", split, ")"), "~\\1~", x
) ))), "~")
)
), "~")
} else { } else {
# wrong type input # wrong type input
stop("type must be 'classic', 'after', 'before' or 'around'!") stop("type must be 'classic', 'after', 'before' or 'around'!")
@ -400,24 +353,25 @@ strsplitx <- function(x,
#' d2w(list(2:8,c(2,6,4,23),2), everything=TRUE) #' d2w(list(2:8,c(2,6,4,23),2), everything=TRUE)
#' #'
d2w <- function(x, lang = "en", neutrum=FALSE, everything=FALSE) { d2w <- function(x, lang = "en", neutrum=FALSE, everything=FALSE) {
# In Danish the written 1 depends on the counted word # In Danish the written 1 depends on the counted word
if (neutrum) nt <- "t" else nt <- "n" if (neutrum) nt <- "t" else nt <- "n"
# A sapply() call with nested lapply() to handle vectors, data.frames and lists # A sapply() call with nested lapply() to handle vectors, data.frames and lists
convert <- function(x, lang, neutrum) { convert <- function(x, lang, neutrum) {
zero_nine <- data.frame( zero_nine = data.frame(
num = 0:9, num = 0:9,
en = c( en = c(
"zero", 'zero',
"one", 'one',
"two", 'two',
"three", 'three',
"four", 'four',
"five", 'five',
"six", 'six',
"seven", 'seven',
"eight", 'eight',
"nine" 'nine'
), ),
da = c( da = c(
"nul", "nul",
@ -452,6 +406,7 @@ d2w <- function(x, lang = "en", neutrum = FALSE, everything = FALSE) {
v <- strsplitx(z,"[0-9]",type="around") v <- strsplitx(z,"[0-9]",type="around")
Reduce(paste,sapply(v,convert,lang = lang, neutrum = neutrum)) Reduce(paste,sapply(v,convert,lang = lang, neutrum = neutrum))
})) }))
}) })
} else { } else {
out <- sapply(x,convert,lang = lang, neutrum = neutrum) out <- sapply(x,convert,lang = lang, neutrum = neutrum)
@ -461,31 +416,3 @@ d2w <- function(x, lang = "en", neutrum = FALSE, everything = FALSE) {
out out
} }
#' Test if repeatable or longitudinal
#'
#' @param data data set
#' @param generics default is "redcap_event_name", "redcap_repeat_instrument"
#' and "redcap_repeat_instance"
#'
#' @return logical
#' @examples
#' is.repeated_longitudinal(c("record_id", "age", "record_id", "gender"))
#' is.repeated_longitudinal(redcapcast_data)
#' is.repeated_longitudinal(list(redcapcast_data))
is.repeated_longitudinal <- function(data, generics = c(
"redcap_event_name",
"redcap_repeat_instrument",
"redcap_repeat_instance"
)) {
if ("list" %in% class(data)) {
names <- data |>
lapply(names) |>
purrr::list_c()
} else if ("data.frame" %in% class(data)) {
names <- names(data)
} else if ("character" %in% class(data)) {
names <- data
}
any(generics %in% names)
}

View File

@ -3,10 +3,6 @@
redcapcast_data <- REDCapR::redcap_read(redcap_uri = keyring::key_get("DB_URI"), redcapcast_data <- REDCapR::redcap_read(redcap_uri = keyring::key_get("DB_URI"),
token = keyring::key_get("cast_api"), token = keyring::key_get("cast_api"),
raw_or_label = "label" raw_or_label = "label"
)$data |> dplyr::tibble() )$data
# redcapcast_data <- easy_redcap(project.name = "redcapcast_pacakge",
# uri = keyring::key_get("DB_URI"),
# widen.data = FALSE)
usethis::use_data(redcapcast_data, overwrite = TRUE) usethis::use_data(redcapcast_data, overwrite = TRUE)

Binary file not shown.

View File

@ -8,7 +8,7 @@ easy_redcap(project.name, widen.data = TRUE, uri, ...)
} }
\arguments{ \arguments{
\item{project.name}{The name of the current project (for key storage with \item{project.name}{The name of the current project (for key storage with
`keyring::key_set()`, using the default keyring)} `keyring::key_set()`)}
\item{widen.data}{argument to widen the exported data} \item{widen.data}{argument to widen the exported data}

View File

@ -1,17 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/utils.r
\name{get_id_name}
\alias{get_id_name}
\title{Get the id name}
\usage{
get_id_name(data)
}
\arguments{
\item{data}{data frame or list}
}
\value{
character vector
}
\description{
Get the id name
}

View File

@ -1,28 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/utils.r
\name{is.repeated_longitudinal}
\alias{is.repeated_longitudinal}
\title{Test if repeatable or longitudinal}
\usage{
is.repeated_longitudinal(
data,
generics = c("redcap_event_name", "redcap_repeat_instrument", "redcap_repeat_instance")
)
}
\arguments{
\item{data}{data set}
\item{generics}{default is "redcap_event_name", "redcap_repeat_instrument"
and "redcap_repeat_instance"}
}
\value{
logical
}
\description{
Test if repeatable or longitudinal
}
\examples{
is.repeated_longitudinal(c("record_id", "age", "record_id", "gender"))
is.repeated_longitudinal(redcapcast_data)
is.repeated_longitudinal(list(redcapcast_data))
}

View File

@ -12,7 +12,8 @@ read_redcap_tables(
events = NULL, events = NULL,
forms = NULL, forms = NULL,
raw_or_label = "label", raw_or_label = "label",
split_forms = "all" split_forms = "all",
generics = c("redcap_event_name", "redcap_repeat_instrument", "redcap_repeat_instance")
) )
} }
\arguments{ \arguments{

View File

@ -5,13 +5,13 @@
\title{Redcap Wider} \title{Redcap Wider}
\usage{ \usage{
redcap_wider( redcap_wider(
data, list,
event.glue = "{.value}_{redcap_event_name}", event.glue = "{.value}_{redcap_event_name}",
inst.glue = "{.value}_{redcap_repeat_instance}" inst.glue = "{.value}_{redcap_repeat_instance}"
) )
} }
\arguments{ \arguments{
\item{data}{A list of data frames.} \item{list}{A list of data frames.}
\item{event.glue}{A dplyr::glue string for repeated events naming} \item{event.glue}{A dplyr::glue string for repeated events naming}
@ -25,36 +25,11 @@ Converts a list of REDCap data frames from long to wide format.
Handles longitudinal projects, but not yet repeated instruments. Handles longitudinal projects, but not yet repeated instruments.
} }
\examples{ \examples{
# Longitudinal list <- list(data.frame(record_id = c(1,2,1,2),
list1 <- list(data.frame(record_id = c(1,2,1,2),
redcap_event_name = c("baseline", "baseline", "followup", "followup"), redcap_event_name = c("baseline", "baseline", "followup", "followup"),
age = c(25,26,27,28)), age = c(25,26,27,28)),
data.frame(record_id = c(1,2), data.frame(record_id = c(1,2),
redcap_event_name = c("baseline", "baseline"), redcap_event_name = c("baseline", "baseline"),
gender = c("male", "female"))) gender = c("male", "female")))
redcap_wider(list1) redcap_wider(list)
# Simpel with two instruments
list2 <- list(data.frame(record_id = c(1,2),
age = c(25,26)),
data.frame(record_id = c(1,2),
gender = c("male", "female")))
redcap_wider(list2)
# Simple with single instrument
list3 <- list(data.frame(record_id = c(1,2),
age = c(25,26)))
redcap_wider(list3)
# Longitudinal with repeatable instruments
list4 <- list(data.frame(record_id = c(1,2,1,2),
redcap_event_name = c("baseline", "baseline", "followup", "followup"),
age = c(25,26,27,28)),
data.frame(record_id = c(1,1,1,1,2,2,2,2),
redcap_event_name = c("baseline", "baseline", "followup", "followup",
"baseline", "baseline", "followup", "followup"),
redcap_repeat_instrument = "walk",
redcap_repeat_instance=c(1,2,1,2,1,2,1,2),
dist = c(40, 32, 25, 33, 28, 24, 23, 36)),
data.frame(record_id = c(1,2),
redcap_event_name = c("baseline", "baseline"),
gender = c("male", "female")))
redcap_wider(list4)
} }

View File

@ -6,7 +6,7 @@
\usage{ \usage{
sanitize_split( sanitize_split(
l, l,
generic.names = c("redcap_event_name", "redcap_repeat_instrument", generic.names = c("record_id", "redcap_event_name", "redcap_repeat_instrument",
"redcap_repeat_instance") "redcap_repeat_instance")
) )
} }

View File

@ -36,12 +36,10 @@ universal_fields <- c("id")
# Create the fields # Create the fields
fields <- matrix( fields <- matrix(
c( c("form_a_name", "form_a",
"form_a_name", "form_a",
"form_a_age", "form_a", "form_a_age", "form_a",
"form_b_name", "form_b", "form_b_name", "form_b",
"form_b_gender", "form_b" "form_b_gender", "form_b"),
),
ncol = 2, byrow = TRUE ncol = 2, byrow = TRUE
) )

View File

@ -3,11 +3,10 @@
#devtools::install_github("pegeler/REDCapRITS/R@longitudinal-data") #devtools::install_github("pegeler/REDCapRITS/R@longitudinal-data")
# Debugging reading in longitudinal datasets ------------------------------ # Debugging reading in longitudinal datasets ------------------------------
# setwd(here::here(""))
# Reading in the files # Reading in the files
file_paths <- file.path( file_paths <- file.path(
"test-data/test_splitr", "../test-data/test_splitr/",
c( c(
records = "WARRIORtestForSoftwa_DATA_2018-06-21_1431.csv", records = "WARRIORtestForSoftwa_DATA_2018-06-21_1431.csv",
metadata = "WARRIORtestForSoftwareUpgrades_DataDictionary_2018-06-21.csv" metadata = "WARRIORtestForSoftwareUpgrades_DataDictionary_2018-06-21.csv"

View File

@ -35,7 +35,7 @@ redcapcast_meta |> gt::gt()
list <- list <-
REDCap_split(records = redcapcast_data, REDCap_split(records = redcapcast_data,
metadata = redcapcast_meta, metadata = redcapcast_meta,
forms = "repeating")|> sanitize_split() forms = "repeating")
str(list) str(list)
``` ```
@ -43,7 +43,7 @@ str(list)
list <- list <-
REDCap_split(records = redcapcast_data, REDCap_split(records = redcapcast_data,
metadata = redcapcast_meta, metadata = redcapcast_meta,
forms = "all") |> sanitize_split() forms = "all")
str(list) str(list)
``` ```
@ -60,7 +60,7 @@ The function works very similar to the `REDCapR::redcap_read()` in allowing to s
## Pivotting to wider format ## Pivotting to wider format
```{r} ```{r}
redcap_wider(list) |> str() # redcap_wider(ds)
``` ```