andreas/REDCapCAST
1
0
Fork 0
mirror of https://github.com/agdamsbo/REDCapCAST.git synced 2024-11-22 13:30:23 +01:00
Code Issues Packages Projects Releases Wiki Activity

generics field has been removed and is now handled with simpel internal helper function is.repeated_longitudinal()

Browse Source
This commit is contained in:
Andreas Gammelgaard Damsbo 2024-02-06 08:43:24 +01:00
parent 7c211250d8
commit 0ce516c297
2 changed files with 52 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
R/read_redcap_tables.R
View File

@ -31,47 +31,40 @@ 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)) {
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") stop("Not all supplied field names are valid")
} }
} }
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)) {
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") stop("Not all supplied form names are valid")
} }
} }
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)
if (any(!event_test)){ 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") stop("Not all supplied event names are valid")
} }
} }
@ -95,28 +88,19 @@ 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, l <- 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 # Sanitizing split list by removing completely empty rows apart from colnames
# in "generics" # in "generics"
sanitize_split(l,c(names(d)[1],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
}
} }

27
R/utils.r
View File

@ -416,3 +416,30 @@ 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 <- function(data, generics = c(
"redcap_event_name",
"redcap_repeat_instrument",
"redcap_repeat_instance"
)) {
if (is.list(data)) {
names <- data |>
lapply(names) |>
purrr::list_c()
} else if (is.data.frame(data)) {
names <- names(data)
} else if (is.vector(data)) {
names <- data
}
any(generics %in% names)
}