diff --git a/NAMESPACE b/NAMESPACE index 31182af..b709d3f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -64,6 +64,7 @@ export(set_attr) export(shiny_cast) export(split_non_repeating_forms) export(strsplitx) +export(suffix2label) export(var2fct) export(vec2choice) importFrom(REDCapR,redcap_event_instruments) diff --git a/R/easy_redcap.R b/R/easy_redcap.R index 11b5cff..2f9ef2a 100644 --- a/R/easy_redcap.R +++ b/R/easy_redcap.R @@ -49,7 +49,9 @@ easy_redcap <- function(project.name, widen.data = TRUE, uri, ...) { ) if (widen.data) { - out <- out |> redcap_wider() + out <- out |> + redcap_wider() |> + suffix2label() } out diff --git a/R/redcap_wider.R b/R/redcap_wider.R index 6d67f5e..c974578 100644 --- a/R/redcap_wider.R +++ b/R/redcap_wider.R @@ -81,8 +81,8 @@ utils::globalVariables(c( #' redcap_wider(list4) redcap_wider <- function(data, - event.glue = "{.value}_{redcap_event_name}", - inst.glue = "{.value}_{redcap_repeat_instance}") { + event.glue = "{.value}____{redcap_event_name}", + inst.glue = "{.value}____{redcap_repeat_instance}") { # browser() if (!is_repeated_longitudinal(data)) { if (is.list(data)) { @@ -192,7 +192,7 @@ save_labels <- function(data) { } # Removes class attributes of class "labelled" or "haven_labelled" -remove_labelled <- function(data){ +remove_labelled <- function(data) { stopifnot(is.list(data)) lapply(data, \(.x) { lapply(.x, \(.y) { @@ -205,3 +205,34 @@ remove_labelled <- function(data){ dplyr::bind_cols() }) } + +#' Transfer variable name suffix to label in widened data +#' +#' @param data data.frame +#' @param suffix.sep string to split suffix(es). Passed to \link[base]{strsplit} +#' @param attr label attribute. Default is "label" +#' @param glue.str glue string for new label. Available variables are "label" +#' and "suffixes" +#' +#' @return data.frame +#' @export +#' +suffix2label <- function(data, + suffix.sep = "____", + attr = "label", + glue.str="{label} ({paste(suffixes,collapse=', ')})") { + data |> + purrr::imap(\(.d, .i){ + suffixes <- unlist(strsplit(.i, suffix.sep))[-1] + if (length(suffixes) > 0) { + label <- get_attr(.d, attr = attr) + set_attr(.d, + glue::glue(glue.str), + attr = attr + ) + } else { + .d + } + }) |> + dplyr::bind_cols() +} diff --git a/man/redcap_wider.Rd b/man/redcap_wider.Rd index 0a5c370..d2d281f 100644 --- a/man/redcap_wider.Rd +++ b/man/redcap_wider.Rd @@ -6,8 +6,8 @@ \usage{ redcap_wider( data, - event.glue = "{.value}_{redcap_event_name}", - inst.glue = "{.value}_{redcap_repeat_instance}" + event.glue = "{.value}____{redcap_event_name}", + inst.glue = "{.value}____{redcap_repeat_instance}" ) } \arguments{ diff --git a/man/suffix2label.Rd b/man/suffix2label.Rd new file mode 100644 index 0000000..a54abff --- /dev/null +++ b/man/suffix2label.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/redcap_wider.R +\name{suffix2label} +\alias{suffix2label} +\title{Transfer variable name suffix to label in widened data} +\usage{ +suffix2label( + data, + suffix.sep = "____", + attr = "label", + glue.str = "{label} ({paste(suffixes,collapse=', ')})" +) +} +\arguments{ +\item{data}{data.frame} + +\item{suffix.sep}{string to split suffix(es). Passed to \link[base]{strsplit}} + +\item{attr}{label attribute. Default is "label"} + +\item{glue.str}{glue string for new label. Available variables are "label" +and "suffixes"} +} +\value{ +data.frame +} +\description{ +Transfer variable name suffix to label in widened data +} diff --git a/tests/testthat/test-redcap_wider.R b/tests/testthat/test-redcap_wider.R index 07108a7..19a4e71 100644 --- a/tests/testthat/test-redcap_wider.R +++ b/tests/testthat/test-redcap_wider.R @@ -1,16 +1,16 @@ -library(testthat) +# library(testthat) test_that("redcap_wider() returns expected output", { list <- list( - data.frame( + dplyr::tibble( record_id = c(1, 2, 1, 2), redcap_event_name = c("baseline", "baseline", "followup", "followup"), age = c(25, 26, 27, 28) ), - data.frame( + dplyr::tibble( record_id = c(1, 2), redcap_event_name = c("baseline", "baseline"), - gender = c("male", "female") + sex = c("male", "female") ) ) @@ -18,9 +18,9 @@ test_that("redcap_wider() returns expected output", { redcap_wider(list), dplyr::tibble( record_id = c(1, 2), - age_baseline = c(25, 26), - age_followup = c(27, 28), - gender = c("male", "female") + age____baseline = c(25, 26), + age____followup = c(27, 28), + sex = c("male", "female") ) ) }) @@ -29,6 +29,7 @@ test_that("redcap_wider() returns expected output", { # Using test data # Set up the path and data ------------------------------------------------- + file_paths <- lapply( c(records = "WARRIORtestForSoftwa_DATA_2018-06-21_1431.csv", metadata = "WARRIORtestForSoftwareUpgrades_DataDictionary_2018-06-21.csv"), diff --git a/vignettes/REDCapCAST.Rmd b/vignettes/REDCapCAST.Rmd index 158e489..6d65995 100644 --- a/vignettes/REDCapCAST.Rmd +++ b/vignettes/REDCapCAST.Rmd @@ -44,10 +44,12 @@ This function includes a few convenience features to ease your further work. If your project uses repeating instruments possible as a longitudinal project, you can choose to widen the data. If not, the result will be a list of each instrument you have chosen to extract data from. Make sure to specify only the fields or instruments you need, and avoid to save any of the data locally, but always source from REDCap to avoid possibly insecure local storage of sensitive data. ```{r eval=FALSE} -easy_redcap(uri = "YOUR URI", - project.name = "MY_PROJECT", - widen.data = TRUE, - fields = c("record_id", "OTHER FIELDS")) +easy_redcap( + uri = "YOUR URI", + project.name = "MY_PROJECT", + widen.data = TRUE, + fields = c("record_id", "OTHER FIELDS") +) ``` ## Splitting the dataset @@ -67,10 +69,12 @@ redcapcast_meta |> gt::gt() To save the metadata as labels in the dataset, we can save field labels and the choices from radio buttons and dropdown features: ```{r} -labelled_data <- - apply_field_label(data=redcapcast_data, - meta=redcapcast_meta) |> - apply_factor_labels(meta=redcapcast_meta) +labelled_data <- + apply_field_label( + data = redcapcast_data, + meta = redcapcast_meta + ) |> + apply_factor_labels(meta = redcapcast_meta) ``` The `REDCap_split` function splits the data set into a list of data.frames. @@ -81,7 +85,7 @@ list <- records = labelled_data, metadata = redcapcast_meta, forms = "all" - ) |> + ) |> # Next steps cleans up and removes generic columns sanitize_split() str(list) @@ -90,15 +94,23 @@ str(list) The `easy_redcap()` will then (optionally) continue to widen the data, by transforming the list of data.frames to a single data.frame with one row for each subject/record_id (wide data format): ```{r} -wide_data <- redcap_wider(list) +wide_data <- redcap_wider(list, + event.glue = "{.value}____{redcap_event_name}", + inst.glue = "{.value}____{redcap_repeat_instance}" +) wide_data |> str() ``` +Transfer suffixes to labels: + +```{r} +wide_data_suffixes <- wide_data |> suffix2label() +``` + ## Creating a nice table ```{r} -wide_data |> - dplyr::select(sex,hypertension, diabetes) |> +wide_data_suffixes |> + dplyr::select(sex, hypertension, diabetes,mrs_score____follow2) |> gtsummary::tbl_summary() ``` -