mirror of
https://github.com/agdamsbo/REDCapCAST.git
synced 2024-11-22 13:30:23 +01:00
generics field has been removed and is now handled with simpel internal helper function is.repeated_longitudinal()
This commit is contained in:
parent
7c211250d8
commit
0ce516c297
@ -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,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
27
R/utils.r
@ -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)
|
||||||
|
}
|
||||||
|
Loading…
Reference in New Issue
Block a user