New function to export redcap data with labels

R/easy_redcap.R

@@ -40,3 +40,167 @@ easy_redcap <- function(project.name, widen.data = TRUE, uri, ...) {
 
   out
 }
+
+
+#' REDCap read function to preserve field labels and all factor levels
+#'
+#' @description
+#' This works very much as `read_redcap_tables()` and might end up there
+#'
+#'
+#' @param uri REDCap database API uri
+#' @param token API token
+#' @param records records to download
+#' @param fields fields to download
+#' @param events events to download
+#' @param forms forms to download
+#' @param split_forms Whether to split "repeating" or "all" forms, default is
+#' "all".
+#'
+#' @return data.frame or list
+#' @export
+#'
+read_redcap_labelled <- function(uri,
+                                 token,
+                                 records = NULL,
+                                 fields = NULL,
+                                 events = NULL,
+                                 forms = NULL,
+                                 split_forms = "all") {
+  m <-
+    REDCapR::redcap_metadata_read(redcap_uri = uri, token = token)[["data"]]
+
+  # Tests
+  if (!is.null(fields)) {
+    fields_test <- fields %in% c(m$field_name, paste0(unique(m$form_name), "_complete"))
+
+    if (any(!fields_test)) {
+      print(paste0(
+        "The following field names are invalid: ",
+        paste(fields[!fields_test], collapse = ", "), "."
+      ))
+      stop("Not all supplied field names are valid")
+    }
+  }
+
+
+  if (!is.null(forms)) {
+    forms_test <- forms %in% unique(m$form_name)
+
+    if (any(!forms_test)) {
+      print(paste0(
+        "The following form names are invalid: ",
+        paste(forms[!forms_test], collapse = ", "), "."
+      ))
+      stop("Not all supplied form names are valid")
+    }
+  }
+
+  if (!is.null(events)) {
+    arm_event_inst <- REDCapR::redcap_event_instruments(
+      redcap_uri = uri,
+      token = token
+    )
+
+    event_test <- events %in% unique(arm_event_inst$data$unique_event_name)
+
+    if (any(!event_test)) {
+      print(paste0(
+        "The following event names are invalid: ",
+        paste(events[!event_test], collapse = ", "), "."
+      ))
+      stop("Not all supplied event names are valid")
+    }
+  }
+
+  # Getting dataset
+  d <- REDCapR::redcap_read(
+    redcap_uri = uri,
+    token = token,
+    fields = fields,
+    events = events,
+    forms = forms,
+    records = records,
+    raw_or_label = "raw"
+  )[["data"]]
+
+  # Applying labels
+  d <- purrr::imap(d, \(.x, .i){
+    if (.i %in% m$field_name) {
+      # Does not handle checkboxes
+      out <- set_attr(.x,
+        label = clean_field_label(m$field_label[m$field_name == .i]),
+        attr = "label"
+      )
+      out
+    } else {
+      .x
+    }
+  }) |> dplyr::bind_cols()
+
+  d <- purrr::imap(d, \(.x, .i){
+    if (any(c("radio", "dropdown") %in% m$field_type[m$field_name == .i])) {
+      format_redcap_factor(.x, m$select_choices_or_calculations[m$field_name == .i])
+    } else {
+      .x
+    }
+  }) |> dplyr::bind_cols()
+
+  # Process repeat instrument naming
+  # Removes any extra characters other than a-z, 0-9 and "_", to mimic raw
+  # instrument names.
+  if ("redcap_repeat_instrument" %in% names(d)) {
+    d$redcap_repeat_instrument <- clean_redcap_name(d$redcap_repeat_instrument)
+  }
+
+  # Processing metadata to reflect focused dataset
+  m <- focused_metadata(m, names(d))
+
+  # Splitting
+  out <- REDCap_split(d,
+    m,
+    forms = split_forms,
+    primary_table_name = ""
+  )
+
+  sanitize_split(out)
+}
+
+
+#' Very simple function to remove rich text formatting from field label
+#' and save the first paragraph ('<p>...</p>').
+#'
+#' @param data field label
+#'
+#' @return character vector
+#' @export
+#'
+#' @examples
+#' clean_field_label("<div class=\"rich-text-field-label\"><p>Fazekas score</p></div>")
+clean_field_label <- function(data) {
+  out <- data |>
+    lapply(\(.x){
+      unlist(strsplit(.x, "</"))[1]
+    }) |>
+    lapply(\(.x){
+      splt <- unlist(strsplit(.x, ">"))
+      splt[length(splt)]
+    })
+  Reduce(c, out)
+}
+
+
+format_redcap_factor <- function(data, meta) {
+  lvls <- strsplit(meta, " | ", fixed = TRUE) |>
+    unlist() |>
+    lapply(\(.x){
+      splt <- unlist(strsplit(.x, ", "))
+      stats::setNames(splt[1], nm = paste(splt[-1], collapse = ", "))
+    }) |>
+    (\(.x){
+      Reduce(c, .x)
+    })()
+  set_attr(data, label = lvls, attr = "labels") |>
+    set_attr(data, label = "labelled", attr = "class") |>
+    as_factor()
+}

man/REDCapCAST-package.Rd

@@ -4,7 +4,7 @@
 \name{REDCapCAST-package}
 \alias{REDCapCAST}
 \alias{REDCapCAST-package}
-\title{REDCapCAST: REDCap Castellated Data Handling and Metadata Casting}
+\title{REDCapCAST: REDCap Metadata Casting and Castellated Data Handling}
 \description{
 \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}}
 

man/all_na.Rd

@@ -16,5 +16,5 @@ logical
 Check if vector is all NA
 }
 \examples{
-rep(NA,4) |> all_na()
+rep(NA, 4) |> all_na()
 }

man/as_factor.Rd

@@ -65,7 +65,8 @@ c(1, 4, 3, "A", 7, 8, 1) |> as_factor()
 structure(c(1, 2, 3, 2, 10, 9),
   labels = c(Unknown = 9, Refused = 10)
 ) |>
-  as_factor() |> dput()
+  as_factor() |>
+  dput()
 
 structure(c(1, 2, 3, 2, 10, 9),
   labels = c(Unknown = 9, Refused = 10),

man/clean_field_label.Rd

@@ -0,0 +1,22 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/easy_redcap.R
+\name{clean_field_label}
+\alias{clean_field_label}
+\title{Very simple function to remove rich text formatting from field label
+and save the first paragraph ('<p>...</p>').}
+\usage{
+clean_field_label(data)
+}
+\arguments{
+\item{data}{field label}
+}
+\value{
+character vector
+}
+\description{
+Very simple function to remove rich text formatting from field label
+and save the first paragraph ('<p>...</p>').
+}
+\examples{
+clean_field_label("<div class=\"rich-text-field-label\"><p>Fazekas score</p></div>")
+}

man/read_redcap_labelled.Rd

@@ -0,0 +1,38 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/easy_redcap.R
+\name{read_redcap_labelled}
+\alias{read_redcap_labelled}
+\title{REDCap read function to preserve field labels and all factor levels}
+\usage{
+read_redcap_labelled(
+  uri,
+  token,
+  records = NULL,
+  fields = NULL,
+  events = NULL,
+  forms = NULL,
+  split_forms = "all"
+)
+}
+\arguments{
+\item{uri}{REDCap database API uri}
+
+\item{token}{API token}
+
+\item{records}{records to download}
+
+\item{fields}{fields to download}
+
+\item{events}{events to download}
+
+\item{forms}{forms to download}
+
+\item{split_forms}{Whether to split "repeating" or "all" forms, default is
+"all".}
+}
+\value{
+data.frame or list
+}
+\description{
+This works very much as `read_redcap_tables()` and might end up there
+}