quick and working sollution to get variable suffixes in the tables. included in the easy_redcap() when widening

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)

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

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)) {
@@ -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()
+}

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{

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
+}

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"),

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", 
+easy_redcap(
+  uri = "YOUR URI",
   project.name = "MY_PROJECT",
   widen.data = TRUE,
-            fields = c("record_id", "OTHER FIELDS"))
+  fields = c("record_id", "OTHER FIELDS")
+)
 ```
 
 ## Splitting the dataset
@@ -68,8 +70,10 @@ To save the metadata as labels in the dataset, we can save field labels and the
 
 ```{r}
 labelled_data <-
-  apply_field_label(data=redcapcast_data,
-                       meta=redcapcast_meta) |> 
+  apply_field_label(
+    data = redcapcast_data,
+    meta = redcapcast_meta
+  ) |>
   apply_factor_labels(meta = redcapcast_meta)
 ```
 
@@ -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()
 ```
-