mirror of
https://github.com/agdamsbo/REDCapCAST.git
synced 2025-09-12 18:49:39 +02:00
Compare commits
3 commits
Author | SHA1 | Date | |
---|---|---|---|
965aa310ca | |||
b512e6a570 | |||
ff466c044c |
5 changed files with 79 additions and 13 deletions
|
@ -1,6 +1,6 @@
|
|||
Package: REDCapCAST
|
||||
Title: REDCap Metadata Casting and Castellated Data Handling
|
||||
Version: 25.3.1
|
||||
Version: 25.3.2
|
||||
Authors@R: c(
|
||||
person("Andreas Gammelgaard", "Damsbo", email = "agdamsbo@clin.au.dk",
|
||||
role = c("aut", "cre"),comment = c(ORCID = "0000-0002-7559-1154")),
|
||||
|
|
4
NEWS.md
4
NEWS.md
|
@ -1,3 +1,7 @@
|
|||
# REDCapCAST 25.3.2
|
||||
|
||||
* BUG: The `redcap_wider()` function would attempt to pivot empty selection of columns from list, and failing, causing all functions relying on this to fail. Fixed by filtering out data.frames in list with no additional columns than the "generics".
|
||||
|
||||
# REDCapCAST 25.3.1
|
||||
|
||||
* FIX: `as_factor()` now interprets empty variables with empty levels attribute as logicals to avoid returning factors with empty levels.
|
||||
|
|
|
@ -79,11 +79,35 @@ utils::globalVariables(c(
|
|||
#' )
|
||||
#' )
|
||||
#' redcap_wider(list4)
|
||||
#'
|
||||
#' list5 <- list(
|
||||
#' data.frame(
|
||||
#' record_id = c(1, 2, 1, 2),
|
||||
#' redcap_event_name = c("baseline", "baseline", "followup", "followup")
|
||||
#' ),
|
||||
#' 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(list5)
|
||||
redcap_wider <-
|
||||
function(data,
|
||||
event.glue = "{.value}____{redcap_event_name}",
|
||||
inst.glue = "{.value}____{redcap_repeat_instance}") {
|
||||
# browser()
|
||||
|
||||
|
||||
if (!is_repeated_longitudinal(data)) {
|
||||
if (is.list(data)) {
|
||||
if (length(data) == 1) {
|
||||
|
@ -95,22 +119,37 @@ redcap_wider <-
|
|||
out <- data
|
||||
}
|
||||
} else {
|
||||
id.name <- do.call(c, lapply(data, names))[[1]]
|
||||
|
||||
## Cleaning instrument list to only include instruments holding other data
|
||||
## than ID and generic columns
|
||||
## This is to mitigate an issue when not exporting fields from the first
|
||||
## instrument.
|
||||
## Not taking this step would throw an error when pivoting.
|
||||
instrument_names <- lapply(data, names)
|
||||
|
||||
id.name <- do.call(c, instrument_names)[[1]]
|
||||
|
||||
generic_names <- c(
|
||||
id.name,
|
||||
"redcap_event_name",
|
||||
"redcap_repeat_instrument",
|
||||
"redcap_repeat_instance"
|
||||
)
|
||||
|
||||
semi_empty <- lapply(instrument_names,\(.x){
|
||||
all(.x %in% generic_names)
|
||||
}) |> unlist()
|
||||
|
||||
data <- data[!semi_empty]
|
||||
|
||||
l <- lapply(data, function(i) {
|
||||
# browser()
|
||||
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"
|
||||
)]
|
||||
cname[!cname %in% generic_names]
|
||||
s <- tidyr::pivot_wider(
|
||||
j,
|
||||
names_from = "redcap_repeat_instance",
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
|
||||
── R CMD check results ─────────────────────────────────────────────────────────────────────────────────────────────────────────────── REDCapCAST 25.3.1 ────
|
||||
Duration: 28.5s
|
||||
|
||||
── R CMD check results ───────────────────────────────────────────────────────────────────────────────── REDCapCAST 25.3.2 ────
|
||||
Duration: 37.1s
|
||||
|
||||
0 errors ✔ | 0 warnings ✔ | 0 notes ✔
|
||||
|
||||
|
|
|
@ -83,4 +83,27 @@ list4 <- list(
|
|||
)
|
||||
)
|
||||
redcap_wider(list4)
|
||||
|
||||
list5 <- list(
|
||||
data.frame(
|
||||
record_id = c(1, 2, 1, 2),
|
||||
redcap_event_name = c("baseline", "baseline", "followup", "followup")
|
||||
),
|
||||
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(list5)
|
||||
}
|
||||
|
|
Loading…
Add table
Reference in a new issue