mirror of
https://github.com/agdamsbo/REDCapCAST.git
synced 2024-11-22 13:30:23 +01:00
Compare commits
11 Commits
5979b972e1
...
7948bfc65d
Author | SHA1 | Date | |
---|---|---|---|
7948bfc65d | |||
e6a7ef3e5a | |||
729d3aca13 | |||
02b9c7ffe7 | |||
4f47c2ac5d | |||
e1509188ff | |||
3e356004d4 | |||
289f57ab76 | |||
edd5334df8 | |||
0ce516c297 | |||
7c211250d8 |
@ -20,7 +20,6 @@ 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)
|
||||||
|
4
NEWS.md
4
NEWS.md
@ -4,7 +4,9 @@
|
|||||||
|
|
||||||
* 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.
|
* Fix: `easy_redcap()`: fixed to actually allow project naming. also specifically asks for uri. widening updated to work.
|
||||||
|
|
||||||
|
* 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.
|
||||||
|
|
||||||
|
@ -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,6 +116,7 @@ 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
|
||||||
@ -138,6 +139,8 @@ 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.*",
|
||||||
@ -196,5 +199,5 @@ REDCap_split <- function(records,
|
|||||||
}
|
}
|
||||||
|
|
||||||
out
|
out
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -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 = "Write REDCap API key:")
|
keyring::key_set(service = key.name, prompt = "Provide REDCap API key:")
|
||||||
keyring::key_get(service = key.name)
|
keyring::key_get(service = key.name)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@ -19,41 +19,25 @@ 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()`)
|
#' `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
|
||||||
#' @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(
|
||||||
token = key,
|
|
||||||
uri = uri,
|
uri = uri,
|
||||||
|
token = key,
|
||||||
...
|
...
|
||||||
)
|
)
|
||||||
|
|
||||||
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
|
||||||
}
|
}
|
||||||
|
@ -31,20 +31,12 @@ 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)) {
|
||||||
@ -55,7 +47,6 @@ 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)) {
|
||||||
@ -65,8 +56,10 @@ read_redcap_tables <- function(uri,
|
|||||||
}
|
}
|
||||||
|
|
||||||
if (!is.null(events)) {
|
if (!is.null(events)) {
|
||||||
arm_event_inst <- REDCapR::redcap_event_instruments(redcap_uri = uri,
|
arm_event_inst <- REDCapR::redcap_event_instruments(
|
||||||
token = token)
|
redcap_uri = uri,
|
||||||
|
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)
|
||||||
|
|
||||||
@ -95,28 +88,17 @@ 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
|
||||||
l <- REDCap_split(d,
|
out <- REDCap_split(d,
|
||||||
m,
|
m,
|
||||||
forms = split_forms,
|
forms = split_forms,
|
||||||
primary_table_name = "")
|
primary_table_name = ""
|
||||||
|
)
|
||||||
|
|
||||||
# Sanitizing split list by removing completely empty rows apart from colnames
|
sanitize_split(out)
|
||||||
# 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
|
|
||||||
}
|
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -5,40 +5,70 @@ 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 list A list of data frames.
|
#' @param data 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
|
||||||
#' list <- list(data.frame(record_id = c(1,2,1,2),
|
#' # Longitudinal
|
||||||
|
#' 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(list)
|
#' redcap_wider(list1)
|
||||||
|
#' # 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(list,
|
function(data,
|
||||||
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 (!any(c("redcap_event_name", "redcap_repeat_instrument") %in%
|
if (!is.repeated_longitudinal(data)) {
|
||||||
all_names)) {
|
if (is.list(data)) {
|
||||||
stop(
|
if (length(data) == 1) {
|
||||||
"The dataset does not include a 'redcap_event_name' variable.
|
out <- data[[1]]
|
||||||
redcap_wider only handles projects with repeating instruments or
|
} else {
|
||||||
longitudinal projects"
|
out <- data |> purrr::reduce(dplyr::left_join)
|
||||||
)
|
}
|
||||||
|
} else if (is.data.frame(data)){
|
||||||
|
out <- data
|
||||||
}
|
}
|
||||||
|
|
||||||
id.name <- all_names[1]
|
|
||||||
|
|
||||||
l <- lapply(list, function(i) {
|
} else {
|
||||||
|
|
||||||
|
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) {
|
||||||
@ -81,13 +111,17 @@ 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
|
}
|
||||||
(i)
|
} else {
|
||||||
|
i
|
||||||
|
}
|
||||||
})
|
})
|
||||||
|
|
||||||
## Additional conditioning is needed to handle repeated instruments.
|
out <- data.frame(Reduce(f = dplyr::full_join, x = l))
|
||||||
|
|
||||||
data.frame(Reduce(f = dplyr::full_join, x = l))
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
out
|
||||||
|
}
|
||||||
|
|
||||||
|
211
R/utils.r
211
R/utils.r
@ -1,5 +1,3 @@
|
|||||||
|
|
||||||
|
|
||||||
#' 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
|
||||||
@ -8,7 +6,6 @@
|
|||||||
#' @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)
|
||||||
}
|
}
|
||||||
@ -17,9 +14,11 @@ 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[, field_type] %in% c("descriptive", "checkbox") &
|
metadata[
|
||||||
|
!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")) {
|
||||||
@ -29,18 +28,21 @@ focused_metadata <- function(metadata, vars_in_data) {
|
|||||||
|
|
||||||
# Processing
|
# Processing
|
||||||
checkbox_basenames <-
|
checkbox_basenames <-
|
||||||
metadata[metadata[, field_type] == "checkbox" &
|
metadata[
|
||||||
|
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(".*[Ff]orm[._][Nn]ame$",
|
unique(metadata[, grepl(
|
||||||
names(metadata))][metadata[, field_name]
|
".*[Ff]orm[._][Nn]ame$",
|
||||||
|
names(metadata)
|
||||||
|
)][metadata[, field_name]
|
||||||
%in% fields])
|
%in% fields])
|
||||||
|
|
||||||
form_complete_fields <- paste0(form_names, "_complete")
|
form_complete_fields <- paste0(form_names, "_complete")
|
||||||
@ -54,33 +56,34 @@ 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("rbind",
|
do.call(
|
||||||
|
"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
|
||||||
@ -95,12 +98,17 @@ 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
|
||||||
@ -116,11 +124,14 @@ 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])
|
||||||
@ -132,6 +143,19 @@ 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
|
||||||
@ -143,20 +167,23 @@ sanitize_split <- function(l,
|
|||||||
#'
|
#'
|
||||||
#'
|
#'
|
||||||
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[!metadata[,field_type] %in% c("descriptive", "checkbox"),
|
fields <- metadata[
|
||||||
field_form_name]
|
!metadata[, field_type] %in% c("descriptive", "checkbox"),
|
||||||
|
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(".*[Ff]orm[._][Nn]ame$",
|
form_names <- unique(metadata[, grepl(
|
||||||
names(metadata))])
|
".*[Ff]orm[._][Nn]ame$",
|
||||||
|
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,
|
||||||
@ -176,57 +203,65 @@ 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[metadata[,field_type] == "checkbox",
|
checkbox_basenames <- metadata[
|
||||||
field_form_name]
|
metadata[, field_type] == "checkbox",
|
||||||
|
field_form_name
|
||||||
|
]
|
||||||
|
|
||||||
checkbox_fields <-
|
checkbox_fields <-
|
||||||
do.call("rbind",
|
do.call(
|
||||||
|
"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, perl = TRUE)],
|
y,
|
||||||
|
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("rbind",
|
do.call(
|
||||||
|
"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
|
||||||
@ -256,10 +291,12 @@ match_fields_to_form <- function(metadata, vars_in_data) {
|
|||||||
#'
|
#'
|
||||||
#' # Create the fields
|
#' # Create the fields
|
||||||
#' fields <- matrix(
|
#' fields <- matrix(
|
||||||
#' c("form_a_name", "form_a",
|
#' c(
|
||||||
|
#' "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
|
||||||
#' )
|
#' )
|
||||||
#'
|
#'
|
||||||
@ -269,14 +306,17 @@ split_non_repeating_forms <-
|
|||||||
function(table, universal_fields, fields) {
|
function(table, universal_fields, fields) {
|
||||||
forms <- unique(fields[[2]])
|
forms <- unique(fields[[2]])
|
||||||
|
|
||||||
x <- lapply(forms,
|
x <- lapply(
|
||||||
|
forms,
|
||||||
function(x) {
|
function(x) {
|
||||||
table[names(table) %in% union(universal_fields,
|
table[names(table) %in% union(
|
||||||
fields[fields[, 2] == x, 1])]
|
universal_fields,
|
||||||
})
|
fields[fields[, 2] == x, 1]
|
||||||
|
)]
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
structure(x, names = forms)
|
structure(x, names = forms)
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
@ -306,26 +346,33 @@ 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(x = x,
|
out <- base::strsplit(
|
||||||
|
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(x = x,
|
out <- base::strsplit(
|
||||||
|
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("~~", "~", # Removes double ~
|
out <- base::strsplit(gsub(
|
||||||
gsub("^~", "", # Removes leading ~
|
"~~", "~", # Removes double ~
|
||||||
|
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'!")
|
||||||
@ -353,25 +400,24 @@ 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",
|
||||||
@ -406,7 +452,6 @@ 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)
|
||||||
@ -416,3 +461,31 @@ 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)
|
||||||
|
}
|
||||||
|
@ -3,6 +3,10 @@
|
|||||||
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
|
)$data |> dplyr::tibble()
|
||||||
|
|
||||||
|
# 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.
@ -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()`)}
|
`keyring::key_set()`, using the default keyring)}
|
||||||
|
|
||||||
\item{widen.data}{argument to widen the exported data}
|
\item{widen.data}{argument to widen the exported data}
|
||||||
|
|
||||||
|
17
man/get_id_name.Rd
Normal file
17
man/get_id_name.Rd
Normal file
@ -0,0 +1,17 @@
|
|||||||
|
% 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
|
||||||
|
}
|
28
man/is.repeated_longitudinal.Rd
Normal file
28
man/is.repeated_longitudinal.Rd
Normal file
@ -0,0 +1,28 @@
|
|||||||
|
% 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))
|
||||||
|
}
|
@ -12,8 +12,7 @@ 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{
|
||||||
|
@ -5,13 +5,13 @@
|
|||||||
\title{Redcap Wider}
|
\title{Redcap Wider}
|
||||||
\usage{
|
\usage{
|
||||||
redcap_wider(
|
redcap_wider(
|
||||||
list,
|
data,
|
||||||
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{list}{A list of data frames.}
|
\item{data}{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,11 +25,36 @@ 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{
|
||||||
list <- list(data.frame(record_id = c(1,2,1,2),
|
# Longitudinal
|
||||||
|
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(list)
|
redcap_wider(list1)
|
||||||
|
# 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)
|
||||||
}
|
}
|
||||||
|
@ -6,7 +6,7 @@
|
|||||||
\usage{
|
\usage{
|
||||||
sanitize_split(
|
sanitize_split(
|
||||||
l,
|
l,
|
||||||
generic.names = c("record_id", "redcap_event_name", "redcap_repeat_instrument",
|
generic.names = c("redcap_event_name", "redcap_repeat_instrument",
|
||||||
"redcap_repeat_instance")
|
"redcap_repeat_instance")
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
@ -36,10 +36,12 @@ universal_fields <- c("id")
|
|||||||
|
|
||||||
# Create the fields
|
# Create the fields
|
||||||
fields <- matrix(
|
fields <- matrix(
|
||||||
c("form_a_name", "form_a",
|
c(
|
||||||
|
"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
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -3,10 +3,11 @@
|
|||||||
#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"
|
||||||
|
@ -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")
|
forms = "repeating")|> sanitize_split()
|
||||||
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")
|
forms = "all") |> sanitize_split()
|
||||||
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(ds)
|
redcap_wider(list) |> str()
|
||||||
```
|
```
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user