diff --git a/R/read_redcap_tables.R b/R/read_redcap_tables.R index 79066cc..acf541c 100644 --- a/R/read_redcap_tables.R +++ b/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)){ + 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() } + + diff --git a/inst/shiny-examples/casting/app.R b/inst/shiny-examples/casting/app.R index d6947ad..4b30388 100644 --- a/inst/shiny-examples/casting/app.R +++ b/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(