mirror of
https://github.com/agdamsbo/REDCapCAST.git
synced 2024-11-27 15:21:55 +01:00
New function to export redcap data with labels
This commit is contained in:
parent
f1e67b52ab
commit
21c2dc0444
164
R/easy_redcap.R
164
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()
|
||||
}
|
||||
|
@ -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'}}
|
||||
|
||||
|
@ -16,5 +16,5 @@ logical
|
||||
Check if vector is all NA
|
||||
}
|
||||
\examples{
|
||||
rep(NA,4) |> all_na()
|
||||
rep(NA, 4) |> all_na()
|
||||
}
|
||||
|
@ -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),
|
||||
|
22
man/clean_field_label.Rd
Normal file
22
man/clean_field_label.Rd
Normal file
@ -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>")
|
||||
}
|
38
man/read_redcap_labelled.Rd
Normal file
38
man/read_redcap_labelled.Rd
Normal file
@ -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
|
||||
}
|
Loading…
Reference in New Issue
Block a user