diff --git a/R/shiny_cast.R b/R/shiny_cast.R index 17e2faa..e3ff3a6 100644 --- a/R/shiny_cast.R +++ b/R/shiny_cast.R @@ -62,10 +62,12 @@ read_input <- function(file, consider.na = c("NA", '""', "")) { } else if (ext == "dta") { df <- haven::read_dta(file = file) } else if (ext == "ods") { - df <- readODS::read_ods(file = file) - } else { + df <- readODS::read_ods(path = file) + } else if (ext == "rds") { + df <- readr::read_rds(file = file) + }else { stop("Input file format has to be on of: - '.csv', '.xls', '.xlsx', '.dta' or '.ods'") + '.csv', '.xls', '.xlsx', '.dta', '.rds' or '.ods'") } }, error = function(e) { diff --git a/inst/shiny-examples/casting/rsconnect/shinyapps.io/agdamsbo/redcapcast.dcf b/inst/shiny-examples/casting/rsconnect/shinyapps.io/agdamsbo/redcapcast.dcf new file mode 100644 index 0000000..ccf5c42 --- /dev/null +++ b/inst/shiny-examples/casting/rsconnect/shinyapps.io/agdamsbo/redcapcast.dcf @@ -0,0 +1,10 @@ +name: redcapcast +title: +username: agdamsbo +account: agdamsbo +server: shinyapps.io +hostUrl: https://api.shinyapps.io/v1 +appId: 11351429 +bundleId: +url: https://agdamsbo.shinyapps.io/redcapcast/ +version: 1 diff --git a/inst/shiny-examples/casting/server.R b/inst/shiny-examples/casting/server.R index 9e756f4..494adfe 100644 --- a/inst/shiny-examples/casting/server.R +++ b/inst/shiny-examples/casting/server.R @@ -7,7 +7,7 @@ library(readr) library(dplyr) library(here) library(devtools) -if (!requireNamespace("REDCapCAST")){ +if (!requireNamespace("REDCapCAST")) { devtools::install_github("agdamsbo/REDCapCAST", quiet = TRUE, upgrade = "never") } library(REDCapCAST) @@ -21,8 +21,35 @@ server <- function(input, output, session) { dat <- shiny::reactive({ shiny::req(input$ds) - read_input(input$ds$datapath) |> - parse_data() + out <- read_input(input$ds$datapath) + + # Saves labels to reapply later + labels <- lapply(out, get_attr) + + out <- out |> + ## Parses data with readr functions + parse_data() |> + ## Converts logical to factor, which overwrites attributes + ## + dplyr::mutate(dplyr::across(dplyr::where(is.logical), forcats::as_factor)) + + if (!is.null(input$factor_vars)) { + out <- out |> + dplyr::mutate( + dplyr::across( + dplyr::all_of(input$factor_vars), + forcats::as_factor + ) + ) + } + + # Old attributes are appended + out <- purrr::imap(out,\(.x,.i){ + set_attr(.x,labels[[.i]]) + }) |> + dplyr::bind_cols() + + out }) # getData <- reactive({ @@ -48,19 +75,66 @@ server <- function(input, output, session) { shiny::outputOptions(output, "uploaded", suspendWhenHidden = FALSE) + output$factor_vars <- shiny::renderUI({ + shiny::req(input$ds) + selectizeInput( + inputId = "factor_vars", + selected = colnames(dat())[sapply(dat(), is.factor)], + label = "Covariables to format as categorical", + choices = colnames(dat()), + multiple = TRUE + ) + }) + output$data.tbl <- gt::render_gt( dd() |> purrr::pluck("data") |> head(20) |> - dplyr::tibble() |> - gt::gt() + # dplyr::tibble() |> + gt::gt() |> + gt::tab_style( + style = gt::cell_text(weight = "bold"), + locations = gt::cells_column_labels(dplyr::everything()) + ) |> + gt::tab_header( + title = "Imported data preview", + subtitle = "The first 20 subjects of the supplied dataset for reference." + ) ) output$meta.tbl <- gt::render_gt( dd() |> purrr::pluck("meta") |> - dplyr::tibble() |> - gt::gt() + # dplyr::tibble() |> + dplyr::mutate( + dplyr::across( + dplyr::everything(), + \(.x) { + .x[is.na(.x)] <- "" + return(.x) + } + ) + ) |> + dplyr::select(1:8) |> + gt::gt() |> + gt::tab_style( + style = gt::cell_text(weight = "bold"), + locations = gt::cells_column_labels(dplyr::everything()) + ) |> + gt::tab_header( + title = "Generated metadata", + subtitle = "Only the first 8 columns are modified using REDCapCAST. Download the metadata to see everything." + ) |> + gt::tab_style( + style = gt::cell_borders( + sides = c("left", "right"), + color = "grey80", + weight = gt::px(1) + ), + locations = gt::cells_body( + columns = dplyr::everything() + ) + ) ) # Downloadable csv of dataset ---- @@ -73,7 +147,7 @@ server <- function(input, output, session) { # Downloadable csv of data dictionary ---- output$downloadMeta <- shiny::downloadHandler( - filename = "datadictionary_ready.csv", + filename = paste0("REDCapCAST_DataDictionary_", Sys.Date(), ".csv"), content = function(file) { write.csv(purrr::pluck(dd(), "meta"), file, row.names = FALSE, na = "") } diff --git a/inst/shiny-examples/casting/ui.R b/inst/shiny-examples/casting/ui.R index 7c5e9b6..72792c8 100644 --- a/inst/shiny-examples/casting/ui.R +++ b/inst/shiny-examples/casting/ui.R @@ -6,7 +6,7 @@ ui <- title = "Easy REDCap database creation", sidebar = bslib::sidebar( width = 300, - shiny::h5("1) Database meta data"), + shiny::h5("Metadata casting"), shiny::fileInput( inputId = "ds", label = "Upload spreadsheet", @@ -16,6 +16,7 @@ ui <- ".xls", ".xlsx", ".dta", + ".rds", ".ods" ) ), @@ -29,6 +30,20 @@ ui <- # 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 = "specify_factors", + label = "Specify categorical variables?", + selected = "no", + inline = TRUE, + choices = list( + "No" = "no", + "Yes" = "yes" + ) + ), + shiny::conditionalPanel( + condition = "input.specify_factors=='yes'", + 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."),