on shinyapps.io and running. woop woop!

.Rbuildignore

@@ -16,7 +16,6 @@
 ^cran-comments\.md$
 ^CRAN-SUBMISSION$
 drafting
-app
 ^\.lintr$
 ^CODE_OF_CONDUCT\.md$
 ^~/REDCapCAST/inst/shiny-examples/casting/rsconnect$

DESCRIPTION

@@ -33,7 +33,8 @@ Suggests:
     devtools,
     roxygen2,
     spelling,
-    rhub
+    rhub,
+    rsconnect
 License: GPL (>= 3)
 Encoding: UTF-8
 LazyData: true
@@ -71,6 +72,7 @@ Collate:
     'ds2dd_detailed.R'
     'easy_redcap.R'
     'export_redcap_instrument.R'
+    'fct_drop.R'
     'html_styling.R'
     'mtcars_redcap.R'
     'read_redcap_instrument.R'

NAMESPACE

@@ -1,17 +1,21 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(as_factor,character)
+S3method(as_factor,data.frame)
 S3method(as_factor,factor)
 S3method(as_factor,haven_labelled)
 S3method(as_factor,labelled)
 S3method(as_factor,logical)
 S3method(as_factor,numeric)
+S3method(as_factor,redcapcast_labelled)
 S3method(process_user_input,character)
 S3method(process_user_input,data.frame)
 S3method(process_user_input,default)
 S3method(process_user_input,response)
 export(REDCap_split)
 export(all_na)
+export(apply_factor_labels)
+export(apply_field_label)
 export(as_factor)
 export(case_match_regex_list)
 export(cast_data_overview)
@@ -30,6 +34,8 @@ export(ds2dd_detailed)
 export(easy_redcap)
 export(export_redcap_instrument)
 export(fct2num)
+export(fct_drop)
+export(fct_drop.data.frame)
 export(file_extension)
 export(focused_metadata)
 export(format_subheader)
@@ -39,6 +45,7 @@ export(guess_time_only)
 export(guess_time_only_filter)
 export(haven_all_levels)
 export(html_tag_wrap)
+export(is.labelled)
 export(is_repeated_longitudinal)
 export(match_fields_to_form)
 export(named_levels)
@@ -49,9 +56,7 @@ export(possibly_roman)
 export(process_user_input)
 export(read_input)
 export(read_redcap_instrument)
-export(read_redcap_labelled)
 export(read_redcap_tables)
-export(redcap_meta_default)
 export(redcap_wider)
 export(sanitize_split)
 export(set_attr)
@@ -64,6 +69,7 @@ importFrom(REDCapR,redcap_event_instruments)
 importFrom(REDCapR,redcap_metadata_read)
 importFrom(REDCapR,redcap_read)
 importFrom(forcats,as_factor)
+importFrom(forcats,fct_drop)
 importFrom(keyring,key_get)
 importFrom(keyring,key_list)
 importFrom(keyring,key_set)

NEWS.md

@@ -1,8 +1,14 @@
 # REDCapCAST 24.11.4
 
-The hosting on shinyapps.io has given a lot of trouble recently. Modyfied package structure a little around the `shiny_cast()`, to accommodate an alternative hosting approach with all package functions included in a script instead of requiring the package.
+This release attempts to solve problems hosting the shiny_cast app, while also implementing functions to preserve as much meta data as possible from the REDCap database when exporting data.
 
-* read_readcap_labelled(): 
+The hosting on shinyapps.io has given a lot of trouble recently. Modified package structure a little around the `shiny_cast()`, to accommodate an alternative hosting approach with all package functions included in a script instead of requiring the package.
+
+* NEW: A new option to `raw_or_label` in `read_readcap_tables()` has been added: "both". Get raw values with REDCap labels applied as labels. Use `as_factor()` to format factors with original labels and use the `gtsummary` package to easily get beautiful tables with original labels from REDCap. Use `fct_drop()` to drop empty levels.
+
+* NEW: fct_drop() has been added with an extension to `forcats::fct_drop()`, that works across data.frames. Use as `fct_drop()`.
+
+* CHANGE: the default data export method of `easy_redcap()` has been changed to use the new labelled data export with `read_readcap_tables()`.
 
 # REDCapCAST 24.11.3
 

R/as_factor.R

@@ -9,6 +9,7 @@
 #'
 #' @param x Object to coerce to a factor.
 #' @param ... Other arguments passed down to method.
+#' @param only_labelled Only apply to labelled columns?
 #' @export
 #' @examples
 #' # will preserve all attributes
@@ -125,6 +126,45 @@ as_factor.haven_labelled <- function(x, levels = c("default", "labels", "values"
 #' @rdname as_factor
 as_factor.labelled <- as_factor.haven_labelled
 
+#' @export
+#' @rdname as_factor
+as_factor.redcapcast_labelled <- as_factor.haven_labelled
+
+#' @rdname as_factor
+#' @export
+as_factor.data.frame <- function(x, ..., only_labelled = TRUE) {
+  if (only_labelled) {
+    labelled <- vapply(x, is.labelled, logical(1))
+    x[labelled] <- lapply(x[labelled], as_factor, ...)
+  } else {
+    x[] <- lapply(x, as_factor, ...)
+  }
+
+  x
+}
+
+#' Tests for multiple label classes
+#'
+#' @param x data
+#' @param classes classes to test
+#'
+#' @return logical
+#' @export
+#'
+#' @examples
+#' structure(c(1, 2, 3, 2, 10, 9),
+#'   labels = c(Unknown = 9, Refused = 10),
+#'   class = "haven_labelled"
+#' ) |> is.labelled()
+is.labelled <- function(x, classes = c("redcapcast_labelled", "haven_labelled", "labelled")) {
+  classes |>
+    sapply(\(.class){
+      inherits(x, .class)
+    }) |>
+    any()
+}
+
+
 replace_with <- function(x, from, to) {
   stopifnot(length(from) == length(to))
 
@@ -224,9 +264,11 @@ named_levels <- function(data, label = "labels", na.label = NULL, na.value = 99)
   if (length(attr_l) != 0) {
     if (all(names(attr_l) %in% d$name)) {
       d$value[match(names(attr_l), d$name)] <- unname(attr_l)
-    } else if (all(d$name %in% names(attr_l)) && nrow(d) < length(attr_l)){
-      d <- data.frame(name = names(attr_l),
-                      value=unname(attr_l))
+    } else if (all(d$name %in% names(attr_l)) && nrow(d) < length(attr_l)) {
+      d <- data.frame(
+        name = names(attr_l),
+        value = unname(attr_l)
+      )
     } else {
       d$name[match(attr_l, d$name)] <- names(attr_l)
       d$value[match(names(attr_l), d$name)] <- unname(attr_l)

R/ds2dd_detailed.R

@@ -99,26 +99,6 @@ hms2character <- function(data) {
 }
 
 
-#' Default column names of a REDCap data dictionary
-#'
-#' @param ... ignored for now
-#'
-#' @return character vector
-#' @export
-#'
-#' @examples
-#' dput(redcap_meta_default())
-redcap_meta_default <- function(...) {
-  c(
-    "field_name", "form_name", "section_header", "field_type",
-    "field_label", "select_choices_or_calculations", "field_note",
-    "text_validation_type_or_show_slider_number", "text_validation_min",
-    "text_validation_max", "identifier", "branching_logic", "required_field",
-    "custom_alignment", "question_number", "matrix_group_name", "matrix_ranking",
-    "field_annotation"
-  )
-}
-
 #' (DEPRECATED) Data set to data dictionary function
 #'
 #' @description
@@ -141,7 +121,7 @@ redcap_meta_default <- function(...) {
 #' @param include.column.names Flag to give detailed output including new
 #' column names for original data set for upload.
 #' @param metadata Metadata column names. Default is the included
-#' REDCapCAST::redcap_meta_default.
+#' names(REDCapCAST::redcapcast_meta).
 #'
 #' @return data.frame or list of data.frame and vector
 #' @export
@@ -157,7 +137,7 @@ ds2dd <-
            field.type = "text",
            field.label = NULL,
            include.column.names = FALSE,
-           metadata = REDCapCAST::redcap_meta_default()
+           metadata = names(REDCapCAST::redcapcast_meta)
            ) {
     dd <- data.frame(matrix(ncol = length(metadata), nrow = ncol(ds)))
     colnames(dd) <- metadata
@@ -244,7 +224,7 @@ ds2dd <-
 #' or attribute `factor.labels.attr` for haven_labelled data set (imported .dta
 #' file with `haven::read_dta()`).
 #' @param metadata redcap metadata headings. Default is
-#' REDCapCAST::redcap_meta_default().
+#' names(REDCapCAST::redcapcast_meta).
 #' @param convert.logicals convert logicals to factor. Default is TRUE.
 #'
 #' @return list of length 2
@@ -286,7 +266,7 @@ ds2dd_detailed <- function(data,
                            field.label = NULL,
                            field.label.attr = "label",
                            field.validation = NULL,
-                           metadata = REDCapCAST::redcap_meta_default(),
+                           metadata = names(REDCapCAST::redcapcast_meta),
                            convert.logicals = TRUE) {
 
   if (convert.logicals) {

R/easy_redcap.R

@@ -31,6 +31,7 @@ easy_redcap <- function(project.name, widen.data = TRUE, uri, ...) {
   out <- read_redcap_tables(
     uri = uri,
     token = key,
+    raw_or_label = "both",
     ...
   )
 
@@ -40,167 +41,3 @@ 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()
-}

R/fct_drop.R

@@ -0,0 +1,29 @@
+#' Drop unused levels preserving label data
+#'
+#' This extends [forcats::fct_drop()] to natively work across a data.frame and
+#' replace [base::droplevels()].
+#'
+#' @param x Factor to drop unused levels
+#' @param ... Other arguments passed down to method.
+#' @export
+#'
+#' @importFrom forcats fct_drop
+#' @export
+#' @name fct_drop
+NULL
+
+#' @rdname fct_drop
+#' @export
+fct_drop.data.frame <- function(x, ...) {
+  purrr::map(\(.x){
+    if (is.factor(.x)){
+      forcats::fct_drop(.x)
+    } else {
+      .x
+    }
+  }) |>
+    dplyr::bind_cols()
+}
+
+
+

R/read_redcap_tables.R

@@ -11,7 +11,15 @@
 #' @param fields fields to download
 #' @param events events to download
 #' @param forms forms to download
-#' @param raw_or_label raw or label tags
+#' @param raw_or_label raw or label tags. Can be
+#'
+#'   * "raw": Standard [REDCapR] method to get raw values.
+#'   * "label": Standard [REDCapR] method to get label values.
+#'   * "both": Get raw values with REDCap labels applied as labels. Use
+#'   [as_factor()] to format factors with original labels and use the
+#'   [gtsummary] package to easily get beautiful tables with original labels
+#'   from REDCap. Use [fct_drop()] to drop empty levels.
+#'
 #' @param split_forms Whether to split "repeating" or "all" forms, default is
 #' all.
 #'
@@ -70,6 +78,12 @@ read_redcap_tables <- function(uri,
     }
   }
 
+  if (raw_or_label=="both"){
+    rorl <- "raw"
+  } else {
+    rorl <- raw_or_label
+  }
+
   # Getting dataset
   d <- REDCapR::redcap_read(
     redcap_uri = uri,
@@ -78,9 +92,16 @@ read_redcap_tables <- function(uri,
     events = events,
     forms = forms,
     records = records,
-    raw_or_label = raw_or_label
+    raw_or_label = rorl
   )[["data"]]
 
+  if (raw_or_label=="both"){
+    d <- apply_field_label(data=d,meta=m)
+
+    d <- apply_factor_labels(data=d,meta=m)
+  }
+
+
   # Process repeat instrument naming
   # Removes any extra characters other than a-z, 0-9 and "_", to mimic raw
   # instrument names.
@@ -101,3 +122,84 @@ read_redcap_tables <- function(uri,
 
   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 = "redcapcast_labelled", attr = "class")
+}
+
+
+
+#' Apply REDCap filed labels to data frame
+#'
+#' @param data REDCap exported data set
+#' @param meta REDCap data dictionary
+#'
+#' @return data.frame
+#' @export
+#'
+apply_field_label <- function(data,meta){
+  purrr::imap(data, \(.x, .i){
+    if (.i %in% meta$field_name) {
+      # Does not handle checkboxes
+      out <- set_attr(.x,
+                      label = clean_field_label(meta$field_label[meta$field_name == .i]),
+                      attr = "label"
+      )
+      out
+    } else {
+      .x
+    }
+  }) |> dplyr::bind_cols()
+}
+
+#' Preserve all factor levels from REDCap data dictionary in data export
+#'
+#' @param data REDCap exported data set
+#' @param meta REDCap data dictionary
+#'
+#' @return data.frame
+#' @export
+#'
+apply_factor_labels <- function(data,meta){
+  purrr::imap(data, \(.x, .i){
+    if (any(c("radio", "dropdown") %in% meta$field_type[meta$field_name == .i])) {
+      format_redcap_factor(.x, meta$select_choices_or_calculations[meta$field_name == .i])
+    } else {
+      .x
+    }
+  }) |> dplyr::bind_cols()
+}

data-raw/metadata_names.R

@@ -7,9 +7,9 @@
 #   "matrix_ranking", "field_annotation"
 # )
 
-# metadata_names <- REDCapR::redcap_metadata_read(
-#   redcap_uri = keyring::key_get("DB_URI"),
-#   token = keyring::key_get("cast_api")
-# )$data |> names()
-#
-# usethis::use_data(metadata_names, overwrite = TRUE, internal = TRUE)
+metadata_names <- REDCapR::redcap_metadata_read(
+  redcap_uri = keyring::key_get("DB_URI"),
+  token = keyring::key_get("cast_api")
+)$data |> names()
+
+usethis::use_data(metadata_names, overwrite = TRUE, internal = TRUE)

inst/WORDLIST

@@ -41,6 +41,7 @@ dmy
 docx
 doi
 dplyr
+droplevels
 ds
 dta
 et
@@ -49,6 +50,7 @@ factorising
 fct
 forcats
 github
+gtsummary
 gues
 hms
 https
@@ -77,6 +79,7 @@ rds
 readr
 realising
 redcapAPI
+redcapcast
 renv
 runApp
 sel

inst/shiny-examples/casting/app.R

@@ -8,23 +8,16 @@ library(dplyr)
 library(gt)
 library(devtools)
 
-if (!requireNamespace("REDCapCAST")) {
-  install.packages("REDCapCAST")
-}
-library(REDCapCAST)
+# if (!requireNamespace("REDCapCAST")) {
+#   install.packages("REDCapCAST")
+# }
+# library(REDCapCAST)
 
 ## Load merged files for shinyapps.io hosting
 if (file.exists(here::here("functions.R"))) {
   source(here::here("functions.R"))
 }
 
-ui <-
-  bslib::page(
-    theme = bslib::bs_theme(preset = "united"),
-    title = "REDCap database creator",
-    nav_bar_page()
-  )
-
 server <- function(input, output, session) {
   v <- shiny::reactiveValues(
     file = NULL
@@ -72,7 +65,15 @@ server <- function(input, output, session) {
     v$file <- "loaded"
     ds2dd_detailed(
       data = dat(),
-      add.auto.id = input$add_id == "yes"
+      add.auto.id = input$add_id == "yes",
+      metadata = c(
+        "field_name", "form_name", "section_header", "field_type",
+        "field_label", "select_choices_or_calculations", "field_note",
+        "text_validation_type_or_show_slider_number", "text_validation_min",
+        "text_validation_max", "identifier", "branching_logic", "required_field",
+        "custom_alignment", "question_number", "matrix_group_name", "matrix_ranking",
+        "field_annotation"
+      )
     )
   })
 
@@ -192,4 +193,150 @@ server <- function(input, output, session) {
   # })
 }
 
+
+ui <-
+  bslib::page(
+    theme = bslib::bs_theme(preset = "united"),
+    title = "REDCap database creator",
+    bslib::page_navbar(
+      title = "Easy REDCap database creation",
+      sidebar = bslib::sidebar(
+        width = 300,
+        shiny::h5("Metadata casting"),
+        shiny::fileInput(
+          inputId = "ds",
+          label = "Upload spreadsheet",
+          multiple = FALSE,
+          accept = c(
+            ".csv",
+            ".xls",
+            ".xlsx",
+            ".dta",
+            ".rds",
+            ".ods"
+          )
+        ),
+        # shiny::actionButton(
+        #   inputId = "load_data",
+        #   label = "Load data",
+        #   icon = shiny::icon("circle-down")
+        # ),
+        shiny::helpText("Have a look at the preview panels to validate the data dictionary and imported data."),
+        # For some odd reason this only unfolds when the preview panel is shown..
+        # This has been solved by adding an arbitrary button to load data - which was abandoned again
+        shiny::conditionalPanel(
+          condition = "output.uploaded=='yes'",
+          shiny::radioButtons(
+            inputId = "add_id",
+            label = "Add ID, or use first column?",
+            selected = "no",
+            inline = TRUE,
+            choices = list(
+              "First column" = "no",
+              "Add ID" = "yes",
+              "No ID" = "none"
+            )
+          ),
+          shiny::radioButtons(
+            inputId = "specify_factors",
+            label = "Specify categorical variables?",
+            selected = "no",
+            inline = TRUE,
+            choices = list(
+              "No" = "no",
+              "Yes" = "yes"
+            )
+          ),
+          shiny::conditionalPanel(
+            condition = "input.specify_factors=='yes'",
+            shiny::uiOutput("factor_vars")
+          ),
+          # condition = "input.load_data",
+          #  shiny::helpText("Below you can download the dataset formatted for upload and the
+          # corresponding data dictionary for a new data base, if you want to upload manually."),
+          # Button
+          shiny::downloadButton(outputId = "downloadData", label = "Download renamed data"),
+
+          # Button
+          shiny::downloadButton(outputId = "downloadMeta", label = "Download data dictionary"),
+
+          # Button
+          shiny::downloadButton(outputId = "downloadInstrument", label = "Download as instrument"),
+
+          # Horizontal line ----
+          shiny::tags$hr(),
+          shiny::radioButtons(
+            inputId = "upload_redcap",
+            label = "Upload directly to REDCap server?",
+            selected = "no",
+            inline = TRUE,
+            choices = list(
+              "No" = "no",
+              "Yes" = "yes"
+            )
+          ),
+          shiny::conditionalPanel(
+            condition = "input.upload_redcap=='yes'",
+            shiny::h4("2) Data base upload"),
+            shiny::helpText("This tool is usable for now. Detailed instructions are coming."),
+            shiny::textInput(
+              inputId = "uri",
+              label = "URI",
+              value = "https://redcap.your.institution/api/"
+            ),
+            shiny::textInput(
+              inputId = "api",
+              label = "API key",
+              value = ""
+            ),
+            shiny::helpText("An API key is an access key to the REDCap database. Please", shiny::a("see here for directions", href = "https://www.iths.org/news/redcap-tip/redcap-api-101/"), " to obtain an API key for your project."),
+            shiny::actionButton(
+              inputId = "upload.meta",
+              label = "Upload datadictionary", icon = shiny::icon("book-bookmark")
+            ),
+            shiny::helpText("Please note, that before uploading any real data, put your project
+         into production mode."),
+            shiny::actionButton(
+              inputId = "upload.data",
+              label = "Upload data", icon = shiny::icon("upload")
+            )
+          )
+        ),
+        shiny::br(),
+        shiny::br(),
+        shiny::br(),
+        shiny::p(
+          "License: ", shiny::a("GPL-3+", href = "https://agdamsbo.github.io/REDCapCAST/LICENSE.html")
+        ),
+        shiny::p(
+          shiny::a("Package documentation", href = "https://agdamsbo.github.io/REDCapCAST")
+        )
+      ),
+      bslib::nav_panel(
+        title = "Intro",
+        shiny::markdown(readLines("www/SHINYCAST.md")),
+        shiny::br()
+      ),
+      # bslib::nav_spacer(),
+      bslib::nav_panel(
+        title = "Data preview",
+        gt::gt_output(outputId = "data.tbl")
+        # shiny::htmlOutput(outputId = "data.tbl", container = shiny::span)
+      ),
+      bslib::nav_panel(
+        title = "Dictionary overview",
+        gt::gt_output(outputId = "meta.tbl")
+        # shiny::htmlOutput(outputId = "meta.tbl", container = shiny::span)
+      ),
+      bslib::nav_panel(
+        title = "Upload",
+        shiny::h3("Meta upload overview"),
+        shiny::textOutput(outputId = "upload.meta.print"),
+        shiny::h3("Data upload overview"),
+        shiny::textOutput(outputId = "upload.data.print")
+      )
+    )
+  )
+
+
 shiny::shinyApp(ui = ui, server = server)

inst/shiny-examples/casting/rsconnect/shinyapps.io/agdamsbo/redcapcast-dev.dcf

@@ -0,0 +1,10 @@
+name: redcapcast-dev
+title:
+username: agdamsbo
+account: agdamsbo
+server: shinyapps.io
+hostUrl: https://api.shinyapps.io/v1
+appId: 13463848
+bundleId: 9425126
+url: https://agdamsbo.shinyapps.io/redcapcast-dev/
+version: 1

inst/shiny-examples/casting/rsconnect/shinyapps.io/agdamsbo/redcapcast.dcf

@@ -5,6 +5,6 @@ account: agdamsbo
 server: shinyapps.io
 hostUrl: https://api.shinyapps.io/v1
 appId: 11351429
-bundleId: 9418747
+bundleId: 9425139
 url: https://agdamsbo.shinyapps.io/redcapcast/
 version: 1

man/apply_factor_labels.Rd

@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/read_redcap_tables.R
+\name{apply_factor_labels}
+\alias{apply_factor_labels}
+\title{Preserve all factor levels from REDCap data dictionary in data export}
+\usage{
+apply_factor_labels(data, meta)
+}
+\arguments{
+\item{data}{REDCap exported data set}
+
+\item{meta}{REDCap data dictionary}
+}
+\value{
+data.frame
+}
+\description{
+Preserve all factor levels from REDCap data dictionary in data export
+}

man/apply_field_label.Rd

@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/read_redcap_tables.R
+\name{apply_field_label}
+\alias{apply_field_label}
+\title{Apply REDCap filed labels to data frame}
+\usage{
+apply_field_label(data, meta)
+}
+\arguments{
+\item{data}{REDCap exported data set}
+
+\item{meta}{REDCap data dictionary}
+}
+\value{
+data.frame
+}
+\description{
+Apply REDCap filed labels to data frame
+}

man/as_factor.Rd

@@ -8,6 +8,8 @@
 \alias{as_factor.character}
 \alias{as_factor.haven_labelled}
 \alias{as_factor.labelled}
+\alias{as_factor.redcapcast_labelled}
+\alias{as_factor.data.frame}
 \title{Convert labelled vectors to factors while preserving attributes}
 \usage{
 as_factor(x, ...)
@@ -33,6 +35,15 @@ as_factor(x, ...)
   ordered = FALSE,
   ...
 )
+
+\method{as_factor}{redcapcast_labelled}(
+  x,
+  levels = c("default", "labels", "values", "both"),
+  ordered = FALSE,
+  ...
+)
+
+\method{as_factor}{data.frame}(x, ..., only_labelled = TRUE)
 }
 \arguments{
 \item{x}{Object to coerce to a factor.}
@@ -49,6 +60,8 @@ as_factor(x, ...)
 
 \item{ordered}{If `TRUE` create an ordered (ordinal) factor, if
 `FALSE` (the default) create a regular (nominal) factor.}
+
+\item{only_labelled}{Only apply to labelled columns?}
 }
 \description{
 This extends [forcats::as_factor()] as well as [haven::as_factor()], by appending

man/clean_field_label.Rd

@@ -1,5 +1,5 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/easy_redcap.R
+% Please edit documentation in R/read_redcap_tables.R
 \name{clean_field_label}
 \alias{clean_field_label}
 \title{Very simple function to remove rich text formatting from field label

man/ds2dd.Rd

@@ -11,7 +11,7 @@ ds2dd(
   field.type = "text",
   field.label = NULL,
   include.column.names = FALSE,
-  metadata = REDCapCAST::redcap_meta_default()
+  metadata = names(REDCapCAST::redcapcast_meta)
 )
 }
 \arguments{
@@ -34,7 +34,7 @@ names.}
 column names for original data set for upload.}
 
 \item{metadata}{Metadata column names. Default is the included
-REDCapCAST::redcap_meta_default.}
+names(REDCapCAST::redcapcast_meta).}
 }
 \value{
 data.frame or list of data.frame and vector

man/ds2dd_detailed.Rd

@@ -15,7 +15,7 @@ ds2dd_detailed(
   field.label = NULL,
   field.label.attr = "label",
   field.validation = NULL,
-  metadata = REDCapCAST::redcap_meta_default(),
+  metadata = names(REDCapCAST::redcapcast_meta),
   convert.logicals = TRUE
 )
 }
@@ -55,7 +55,7 @@ or attribute `factor.labels.attr` for haven_labelled data set (imported .dta
 file with `haven::read_dta()`).}
 
 \item{metadata}{redcap metadata headings. Default is
-REDCapCAST::redcap_meta_default().}
+names(REDCapCAST::redcapcast_meta).}
 
 \item{convert.logicals}{convert logicals to factor. Default is TRUE.}
 }

man/fct_drop.Rd

@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/fct_drop.R
+\name{fct_drop}
+\alias{fct_drop}
+\alias{fct_drop.data.frame}
+\title{Drop unused levels preserving label data}
+\usage{
+fct_drop.data.frame(x, ...)
+}
+\arguments{
+\item{x}{Factor to drop unused levels}
+
+\item{...}{Other arguments passed down to method.}
+}
+\description{
+This extends [forcats::fct_drop()] to natively work across a data.frame and
+replace [base::droplevels()].
+}

man/is.labelled.Rd

@@ -0,0 +1,28 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/as_factor.R
+\name{is.labelled}
+\alias{is.labelled}
+\title{Tests for multiple label classes}
+\usage{
+is.labelled(
+  x,
+  classes = c("redcapcast_labelled", "haven_labelled", "labelled")
+)
+}
+\arguments{
+\item{x}{data}
+
+\item{classes}{classes to test}
+}
+\value{
+logical
+}
+\description{
+Tests for multiple label classes
+}
+\examples{
+structure(c(1, 2, 3, 2, 10, 9),
+  labels = c(Unknown = 9, Refused = 10),
+  class = "haven_labelled"
+) |> is.labelled()
+}

man/read_redcap_labelled.Rd

@@ -1,38 +0,0 @@
-% 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
-}

man/read_redcap_tables.Rd

@@ -28,7 +28,14 @@ read_redcap_tables(
 
 \item{forms}{forms to download}
 
-\item{raw_or_label}{raw or label tags}
+\item{raw_or_label}{raw or label tags. Can be
+
+  * "raw": Standard [REDCapR] method to get raw values.
+  * "label": Standard [REDCapR] method to get label values.
+  * "both": Get raw values with REDCap labels applied as labels. Use
+  [as_factor()] to format factors with original labels and use the
+  [gtsummary] package to easily get beautiful tables with original labels
+  from REDCap. Use [fct_drop()] to drop empty levels.}
 
 \item{split_forms}{Whether to split "repeating" or "all" forms, default is
 all.}

man/redcap_meta_default.Rd

@@ -1,20 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/ds2dd_detailed.R
-\name{redcap_meta_default}
-\alias{redcap_meta_default}
-\title{Default column names of a REDCap data dictionary}
-\usage{
-redcap_meta_default(...)
-}
-\arguments{
-\item{...}{ignored for now}
-}
-\value{
-character vector
-}
-\description{
-Default column names of a REDCap data dictionary
-}
-\examples{
-dput(redcap_meta_default())
-}

vignettes/Shiny-app.Rmd

@@ -36,14 +36,14 @@ str(ds)
 
 ```{r}
 ds|> 
-  ds2dd_detailed()|>  
+  ds2dd_detailed(metadata = names(REDCapCAST::redcapcast_meta))|>  
   purrr::pluck("data") |> 
   str()
 ```
 
 ```{r}
 ds|> 
-  ds2dd_detailed()|>  
+  ds2dd_detailed(metadata = names(REDCapCAST::redcapcast_meta))|>  
   purrr::pluck("meta") |> 
   head(10)
 ```