use correct factor order

R/read_redcap_tables.R

@@ -219,12 +219,20 @@ apply_field_label <- function(data,meta){
 #' @return data.frame
 #' @export
 #'
-apply_factor_labels <- function(data,meta){
+apply_factor_labels <- function(data,meta=NULL){
+  if (is.list(data) && !is.data.frame(data)){
+    meta <- data$meta
+    data <- data$data
+  } else if (is.null(meta)) {
+    stop("Please provide a data frame for meta")
+  }
   purrr::imap(data, \(.x, .i){
-    if (any(c("radio", "dropdown") %in% meta$field_type[meta$field_name == .i])) {
+    if (any(c("radio", "dropdown") %in% meta$field_type[meta$field_name == .i]) || is.factor(.x)) {
       format_redcap_factor(.x, meta$select_choices_or_calculations[meta$field_name == .i])
     } else {
       .x
     }
   }) |> dplyr::bind_cols()
 }
+
+

inst/shiny-examples/casting/app.R

@@ -50,6 +50,14 @@ server <- function(input, output, session) {
         )
     }
 
+    if (input$factorize == "yes") {
+      out <- out |>
+        (\(.x){
+          suppressWarnings(
+            numchar2fct(.x)
+          )
+        })()
+    }
     out
   })
 
@@ -77,16 +85,6 @@ server <- function(input, output, session) {
     )
   })
 
-  output$uploaded <- shiny::reactive({
-    if (is.null(v$file)) {
-      "no"
-    } else {
-      "yes"
-    }
-  })
-
-  shiny::outputOptions(output, "uploaded", suspendWhenHidden = FALSE)
-
   output$factor_vars <- shiny::renderUI({
     shiny::req(input$ds)
     selectizeInput(
@@ -176,17 +174,31 @@ server <- function(input, output, session) {
 
     shiny::req(input$api)
 
-    output_staging$data <- REDCapR::redcap_write(
-      ds = purrr::pluck(dd(), "data"),
-      redcap_uri = input$uri,
-      token = input$api
-    ) |> purrr::pluck("success")
+    output_staging$data <- dd() |>
+      apply_factor_labels() |>
+      REDCapR::redcap_write(
+        redcap_uri = input$uri,
+        token = input$api
+      ) |>
+      purrr::pluck("success")
   }
 
   output$upload.meta.print <- renderText(output_staging$meta)
 
   output$upload.data.print <- renderText(output_staging$data)
 
+  output$uploaded <- shiny::reactive({
+    if (is.null(v$file)) {
+      "no"
+    } else {
+      "yes"
+    }
+  })
+
+  shiny::outputOptions(output, "uploaded", suspendWhenHidden = FALSE)
+
+  output$data.load <- shiny::renderText(expr = nrow(dat()))
+
   # session$onSessionEnded(function() {
   #   # cat("Session Ended\n")
   #   unlink("www",recursive = TRUE)
@@ -237,14 +249,24 @@ ui <-
               "No ID" = "none"
             )
           ),
+          shiny::radioButtons(
+            inputId = "factorize",
+            label = "Factorize variables with few levels?",
+            selected = "yes",
+            inline = TRUE,
+            choices = list(
+              "Yes" = "yes",
+              "No" = "no"
+            )
+          ),
           shiny::radioButtons(
             inputId = "specify_factors",
             label = "Specify categorical variables?",
             selected = "no",
             inline = TRUE,
             choices = list(
-              "No" = "no",
-              "Yes" = "yes"
+              "Yes" = "yes",
+              "No" = "no"
             )
           ),
           shiny::conditionalPanel(
@@ -254,25 +276,27 @@ ui <-
           # 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."),
+          shiny::tags$hr(),
+          shiny::h4("Download data for manual upload"),
+          shiny::helpText("Look further down for direct upload option"),
           # Button
           shiny::downloadButton(outputId = "downloadData", label = "Download renamed data"),
-
+          shiny::em("and then"),
           # Button
           shiny::downloadButton(outputId = "downloadMeta", label = "Download data dictionary"),
-
-          # Button
+          shiny::em("or"),
           shiny::downloadButton(outputId = "downloadInstrument", label = "Download as instrument"),
 
           # Horizontal line ----
           shiny::tags$hr(),
           shiny::radioButtons(
             inputId = "upload_redcap",
-            label = "Upload directly to REDCap server?",
+            label = "Upload directly to a REDCap server?",
             selected = "no",
             inline = TRUE,
             choices = list(
-              "No" = "no",
-              "Yes" = "yes"
+              "Yes" = "yes",
+              "No" = "no"
             )
           ),
           shiny::conditionalPanel(
@@ -315,7 +339,8 @@ ui <-
       bslib::nav_panel(
         title = "Intro",
         shiny::markdown(readLines("www/SHINYCAST.md")),
-        shiny::br()
+        shiny::br(),
+        shiny::textOutput(outputId = "data.load")
       ),
       # bslib::nav_spacer(),
       bslib::nav_panel(

man/apply_factor_labels.Rd

@@ -4,7 +4,7 @@
 \alias{apply_factor_labels}
 \title{Preserve all factor levels from REDCap data dictionary in data export}
 \usage{
-apply_factor_labels(data, meta)
+apply_factor_labels(data, meta = NULL)
 }
 \arguments{
 \item{data}{REDCap exported data set}

vignettes/REDCapCAST.Rmd

@@ -111,6 +111,7 @@ wide_data_suffixes <- wide_data |> suffix2label()
 
 ```{r}
 wide_data_suffixes |> 
+  as_factor()|>
   dplyr::select(sex, hypertension, diabetes,mrs_score____follow2) |>
-  gtsummary::tbl_summary()
+  gtsummary::tbl_summary(type = gtsummary::all_dichotomous() ~ "categorical")
 ```