andreas/REDCapCAST
1
0
Fork 0
mirror of https://github.com/agdamsbo/REDCapCAST.git synced 2024-11-21 21:10:22 +01:00
Code Issues Packages Projects Releases Wiki Activity

specify ID column

Browse Source
This commit is contained in:
Andreas Gammelgaard Damsbo 2024-11-20 12:10:33 +01:00
parent 0600adcce7
commit 69e1520aff
No known key found for this signature in database
2 changed files with 37 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
inst/shiny-examples/casting/server.R
View File

@ -24,30 +24,30 @@ server <- function(input, output, session) {
out <- read_input(input$ds$datapath) out <- read_input(input$ds$datapath)
# Saves labels to reapply later # Saves labels to reapply later
labels <- lapply(out, get_attr) # labels <- lapply(out, get_attr)
out <- out |> out <- out |>
## Parses data with readr functions ## Parses data with readr functions
parse_data() |> parse_data() |>
## Converts logical to factor, which overwrites attributes ## Converts logical to factor, which overwrites attributes
## ##
dplyr::mutate(dplyr::across(dplyr::where(is.logical), forcats::as_factor)) dplyr::mutate(dplyr::across(dplyr::where(is.logical), as_factor))
if (!is.null(input$factor_vars)) { if (!is.null(input$factor_vars)) {
out <- out |> out <- out |>
dplyr::mutate( dplyr::mutate(
dplyr::across( dplyr::across(
dplyr::all_of(input$factor_vars), dplyr::all_of(input$factor_vars),
forcats::as_factor as_factor
) )
) )
} }
# Old attributes are appended # Old attributes are appended
out <- purrr::imap(out,\(.x,.i){ # out <- purrr::imap(out,\(.x,.i){
set_attr(.x,labels[[.i]]) # set_attr(.x,labels[[.i]])
}) |> # }) |>
dplyr::bind_cols() # dplyr::bind_cols()
out out
}) })
@ -62,7 +62,10 @@ server <- function(input, output, session) {
dd <- shiny::reactive({ dd <- shiny::reactive({
shiny::req(input$ds) shiny::req(input$ds)
v$file <- "loaded" v$file <- "loaded"
ds2dd_detailed(data = dat()) ds2dd_detailed(
data = dat(),
add.auto.id = input$add_id=="yes"
)
}) })
output$uploaded <- shiny::reactive({ output$uploaded <- shiny::reactive({
@ -86,6 +89,18 @@ server <- function(input, output, session) {
) )
}) })
## Specify ID if necessary
# output$id_var <- shiny::renderUI({
# shiny::req(input$ds)
# selectizeInput(
# inputId = "id_var",
# selected = colnames(dat())[1],
# label = "ID variable",
# choices = colnames(dat())[-match(colnames(dat()),input$factor_vars)],
# multiple = FALSE
# )
# })
output$data.tbl <- gt::render_gt( output$data.tbl <- gt::render_gt(
dd() |> dd() |>
purrr::pluck("data") |> purrr::pluck("data") |>
@ -157,7 +172,9 @@ server <- function(input, output, session) {
output$downloadInstrument <- shiny::downloadHandler( output$downloadInstrument <- shiny::downloadHandler(
filename = paste0("REDCapCAST_instrument", Sys.Date(), ".zip"), filename = paste0("REDCapCAST_instrument", Sys.Date(), ".zip"),
content = function(file) { content = function(file) {
export_redcap_instrument(purrr::pluck(dd(), "meta"), file) export_redcap_instrument(purrr::pluck(dd(), "meta"),
file = file,
record.id = ifelse(input$add_id=="none",NA,names(dat())[1]))
} }
) )

11
inst/shiny-examples/casting/ui.R
View File

@ -30,6 +30,17 @@ ui <-
# This has been solved by adding an arbitrary button to load data - which was abandoned again # This has been solved by adding an arbitrary button to load data - which was abandoned again
shiny::conditionalPanel( shiny::conditionalPanel(
condition = "output.uploaded=='yes'", 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( shiny::radioButtons(
inputId = "specify_factors", inputId = "specify_factors",
label = "Specify categorical variables?", label = "Specify categorical variables?",