andreas/REDCapCAST
1
0
Fork 0
mirror of https://github.com/agdamsbo/REDCapCAST.git synced 2026-06-19 13:17:30 +02:00
Code Issues Projects Releases Packages Wiki Activity

linting

Browse source
This commit is contained in:
Andreas Gammelgaard Damsbo 2024-02-27 13:20:21 +01:00
commit 9e33057c06
32 changed files with 456 additions and 340 deletions
Download patch file Download diff file Expand all files Collapse all files

189
R/redcap_wider.R
View file

@ -1,6 +1,8 @@
utils::globalVariables(c("redcap_wider",
"event.glue",
"inst.glue"))
utils::globalVariables(c(
"redcap_wider",
"event.glue",
"inst.glue"
))
#' @title Redcap Wider
#' @description Converts a list of REDCap data frames from long to wide format.
@ -16,42 +18,65 @@ utils::globalVariables(c("redcap_wider",
#'
#' @examples
#' # Longitudinal
#' list1 <- 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,2),
#' redcap_event_name = c("baseline", "baseline"),
#' gender = c("male", "female")))
#' list1 <- 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, 2),
#' redcap_event_name = c("baseline", "baseline"),
#' gender = c("male", "female")
#' )
#' )
#' 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")))
#' 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)))
#' 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)
#' 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 <-
function(data,
event.glue = "{.value}_{redcap_event_name}",
inst.glue = "{.value}_{redcap_repeat_instance}") {
if (!is_repeated_longitudinal(data)) {
if (is.list(data)) {
if (length(data) == 1) {
@ -59,69 +84,65 @@ redcap_wider <-
} else {
out <- data |> purrr::reduce(dplyr::left_join)
}
} else if (is.data.frame(data)){
} else if (is.data.frame(data)) {
out <- data
}
} else {
id.name <- do.call(c, lapply(data, names))[[1]]
id.name <- do.call(c, lapply(data, names))[[1]]
l <- lapply(data, function(i) {
rep_inst <- "redcap_repeat_instrument" %in% names(i)
l <- lapply(data, function(i) {
rep_inst <- "redcap_repeat_instrument" %in% names(i)
if (rep_inst) {
k <- lapply(split(i, f = i[[id.name]]), function(j) {
cname <- colnames(j)
vals <-
cname[!cname %in% c(
id.name,
"redcap_event_name",
"redcap_repeat_instrument",
"redcap_repeat_instance"
)]
s <- tidyr::pivot_wider(
j,
names_from = "redcap_repeat_instance",
values_from = all_of(vals),
names_glue = inst.glue
)
s[!colnames(s) %in% c("redcap_repeat_instrument")]
})
i <- Reduce(dplyr::bind_rows, k)
}
event <- "redcap_event_name" %in% names(i)
if (event) {
event.n <- length(unique(i[["redcap_event_name"]])) > 1
i[["redcap_event_name"]] <-
gsub(" ", "_", tolower(i[["redcap_event_name"]]))
if (event.n) {
cname <- colnames(i)
vals <- cname[!cname %in% c(id.name, "redcap_event_name")]
s <- tidyr::pivot_wider(
i,
names_from = "redcap_event_name",
values_from = all_of(vals),
names_glue = event.glue
)
s[colnames(s) != "redcap_event_name"]
} else {
i[colnames(i) != "redcap_event_name"]
}
} else {
i
if (rep_inst) {
k <- lapply(split(i, f = i[[id.name]]), function(j) {
cname <- colnames(j)
vals <-
cname[!cname %in% c(
id.name,
"redcap_event_name",
"redcap_repeat_instrument",
"redcap_repeat_instance"
)]
s <- tidyr::pivot_wider(
j,
names_from = "redcap_repeat_instance",
values_from = all_of(vals),
names_glue = inst.glue
)
s[!colnames(s) %in% c("redcap_repeat_instrument")]
})
i <- Reduce(dplyr::bind_rows, k)
}
})
out <- data.frame(Reduce(f = dplyr::full_join, x = l))
event <- "redcap_event_name" %in% names(i)
if (event) {
event.n <- length(unique(i[["redcap_event_name"]])) > 1
i[["redcap_event_name"]] <-
gsub(" ", "_", tolower(i[["redcap_event_name"]]))
if (event.n) {
cname <- colnames(i)
vals <- cname[!cname %in% c(id.name, "redcap_event_name")]
s <- tidyr::pivot_wider(
i,
names_from = "redcap_event_name",
values_from = all_of(vals),
names_glue = event.glue
)
s[colnames(s) != "redcap_event_name"]
} else {
i[colnames(i) != "redcap_event_name"]
}
} else {
i
}
})
out <- data.frame(Reduce(f = dplyr::full_join, x = l))
}
out
}