From f18a181fafef377fe8799cb4b49516c3a73268ed Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Thu, 19 Dec 2024 11:32:56 +0100 Subject: [PATCH] keeping a custom file import module --- R/file-import-module.R | 125 +++++++++++ R/modules.R | 480 ----------------------------------------- man/m_datafileUI.Rd | 2 +- 3 files changed, 126 insertions(+), 481 deletions(-) create mode 100644 R/file-import-module.R delete mode 100644 R/modules.R diff --git a/R/file-import-module.R b/R/file-import-module.R new file mode 100644 index 0000000..8210fc8 --- /dev/null +++ b/R/file-import-module.R @@ -0,0 +1,125 @@ +#' Shiny UI module to load a data file +#' +#' @param id id +#' +#' @return shiny UI +#' @export +#' +m_datafileUI <- function(id) { + ns <- shiny::NS(id) + shiny::tagList( + shiny::fileInput( + inputId = ns("file"), + label = "Upload a file", + multiple = FALSE, + accept = c( + ".csv", + ".xlsx", + ".xls", + ".dta", + ".ods", + ".rds" + ) + ), + shiny::h4("Parameter specifications"), + shiny::helpText(shiny::em("Select the desired variables and press 'Submit'")), + shiny::uiOutput(ns("include_vars")), + DT::DTOutput(ns("data_input")), + shiny::actionButton(ns("submit"), "Submit") + ) +} + +m_datafileServer <- function(id, output.format = "df") { + shiny::moduleServer(id, function(input, output, session, ...) { + ns <- shiny::NS(id) + ds <- shiny::reactive({ + REDCapCAST::read_input(input$file$datapath) |> REDCapCAST::parse_data() + }) + + output$include_vars <- shiny::renderUI({ + shiny::req(input$file) + shiny::selectizeInput( + inputId = ns("include_vars"), + selected = NULL, + label = "Covariables to include", + choices = colnames(ds()), + multiple = TRUE + ) + }) + + base_vars <- shiny::reactive({ + if (is.null(input$include_vars)) { + out <- colnames(ds()) + } else { + out <- input$include_vars + } + out + }) + + output$data_input <- + DT::renderDT({ + shiny::req(input$file) + ds()[base_vars()] + }) + + shiny::eventReactive(input$submit, { + # shiny::req(input$file) + + data <- shiny::isolate({ + ds()[base_vars()] + }) + + file_export(data, + output.format = output.format, + tools::file_path_sans_ext(input$file$name) + ) + }) + }) +} + + + + + +file_app <- function() { + ui <- shiny::fluidPage( + m_datafileUI("data"), + # DT::DTOutput(outputId = "redcap_prev") + toastui::datagridOutput2(outputId = "redcap_prev") + ) + server <- function(input, output, session) { + m_datafileServer("data", output.format = "list") + } + shiny::shinyApp(ui, server) +} + +file_app() + +tdm_data_upload <- teal::teal_data_module( + ui <- function(id) { + shiny::fluidPage( + m_datafileUI(id) + ) + }, + server = function(id) { + m_datafileServer(id, output.format = "teal") + } +) + +tdm_data_read <- teal::teal_data_module( + ui <- function(id) { + shiny::fluidPage( + m_redcap_readUI(id = "redcap") + ) + }, + server = function(id) { + moduleServer( + id, + function(input, output, session) { + ns <- session$ns + + m_redcap_readServer(id = "redcap", output.format = "teal") + } + ) + } +) diff --git a/R/modules.R b/R/modules.R deleted file mode 100644 index 43b7024..0000000 --- a/R/modules.R +++ /dev/null @@ -1,480 +0,0 @@ -#' Shiny UI module to load a data file -#' -#' @param id id -#' -#' @return shiny UI -#' @export -#' -m_datafileUI <- function(id) { - ns <- shiny::NS(id) - shiny::tagList( - shiny::fileInput( - inputId = ns("file"), - label = "Upload a file", - multiple = FALSE, - accept = c( - ".csv", - ".xlsx", - ".xls", - ".dta", - ".ods", - ".rds" - ) - ), - shiny::h4("Parameter specifications"), - shiny::helpText(shiny::em("Select the desired variables and press 'Submit'")), - shiny::uiOutput(ns("include_vars")), - DT::DTOutput(ns("data_input")), - shiny::actionButton(ns("submit"), "Submit") - ) -} - -m_datafileServer <- function(id, output.format = "df") { - shiny::moduleServer(id, function(input, output, session, ...) { - ns <- shiny::NS(id) - ds <- shiny::reactive({ - REDCapCAST::read_input(input$file$datapath) |> REDCapCAST::parse_data() - }) - - output$include_vars <- shiny::renderUI({ - shiny::req(input$file) - shiny::selectizeInput( - inputId = ns("include_vars"), - selected = NULL, - label = "Covariables to include", - choices = colnames(ds()), - multiple = TRUE - ) - }) - - base_vars <- shiny::reactive({ - if (is.null(input$include_vars)) { - out <- colnames(ds()) - } else { - out <- input$include_vars - } - out - }) - - output$data_input <- - DT::renderDT({ - shiny::req(input$file) - ds()[base_vars()] - }) - - shiny::eventReactive(input$submit, { - # shiny::req(input$file) - - data <- shiny::isolate({ - ds()[base_vars()] - }) - - file_export(data, - output.format = output.format, - tools::file_path_sans_ext(input$file$name) - ) - }) - }) -} - - -#' Shiny module to browser and export REDCap data -#' -#' @param id Namespace id -#' @param include_title logical to include title -#' -#' @rdname redcap_read_shiny_module -#' -#' @return shiny ui element -#' @export -m_redcap_readUI <- function(id, include_title = TRUE) { - ns <- shiny::NS(id) - - server_ui <- shiny::column( - width = 6, - shiny::tags$h4("REDCap server information"), - shiny::textInput( - inputId = ns("uri"), - label = "URI/Address", - value = "https://redcap.your.institution/api/" - ), - shiny::textInput( - inputId = ns("api"), - label = "API token", - value = "" - ) - ) - - - params_ui <- - shiny::column( - width = 6, - shiny::tags$h4("Data import parameters"), - shiny::helpText("Options here will show, when API and uri are typed"), - shiny::uiOutput(outputId = ns("fields")), - shinyWidgets::switchInput( - inputId = "do_filter", - label = "Apply filter?", - value = FALSE, - inline = FALSE, - onLabel = "YES", - offLabel = "NO" - ), - # shiny::radioButtons( - # inputId = "do_filter", - # label = "Filter export?", - # selected = "no", - # inline = TRUE, - # choices = list( - # "No" = "no", - # "Yes" = "yes" - # ) - # ), - shiny::conditionalPanel( - condition = "input.do_filter", - shiny::uiOutput(outputId = ns("arms")), - shiny::textInput( - inputId = ns("filter"), - label = "Optional filter logic (e.g., ⁠[gender] = 'female')" - ) - ) - ) - - - shiny::fluidPage( - if (include_title) shiny::tags$h3("Import data from REDCap"), - fluidRow( - server_ui, - params_ui), - shiny::column( - width = 12, - # shiny::actionButton(inputId = ns("import"), label = "Import"), - bslib::input_task_button( - id = ns("import"), - label = "Import", - icon = shiny::icon("download", lib = "glyphicon"), - label_busy = "Just a minute...", - icon_busy = fontawesome::fa_i("arrows-rotate", - class = "fa-spin", - "aria-hidden" = "true" - ), - type = "primary", - auto_reset = TRUE - ), - shiny::helpText("Press 'Import' after having specified API token and URI to export data from the REDCap server. A preview will show below the DataDictionary."), - shiny::br(), - shiny::br(), - shiny::br(), - DT::DTOutput(outputId = ns("table")) - # toastui::datagridOutput2(outputId = ns("table")) - ) - # toastui::datagridOutput2(outputId = ns("table")), - # toastui::datagridOutput2(outputId = ns("data")), - # shiny::actionButton(inputId = ns("submit"), label = "Submit"), - # DT::DTOutput(outputId = ns("data_prev")) - ) -} - -#' @param output.format data.frame ("df") or teal data object ("teal") -#' @rdname redcap_read_shiny_module -#' -#' @return shiny server module -#' @export -#' -m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) { - output.format <- match.arg(output.format) - - module <- function(input, output, session) { - # ns <- shiny::NS(id) - ns <- session$ns - - # data_list <- shiny::reactiveValues( - # dict = NULL, - # stat = NULL, - # arms = NULL, - # data = NULL, - # name = NULL - # ) - - dd <- shiny::reactive({ - shiny::req(input$api) - shiny::req(input$uri) - - - REDCapR::redcap_metadata_read( - redcap_uri = input$uri, - token = input$api - )$data - }) - - # dd <- shiny::reactive({ - # shiny::req(input$api) - # shiny::req(input$uri) - # - # - # out <- REDCapR::redcap_metadata_read( - # redcap_uri = input$uri, - # token = input$api - # ) - # - # data_list$dict <- out$data - # data_list$stat <- out$success - # - # out$data - # }) - - arms <- shiny::reactive({ - shiny::req(input$api) - shiny::req(input$uri) - - REDCapR::redcap_event_read( - redcap_uri = input$uri, - token = input$api - )$data - - # data_list$arms <- out - # out - }) - - output$fields <- shiny::renderUI({ - shinyWidgets::virtualSelectInput( - inputId = ns("fields"), - label = "Select fields/variables to import:", - choices = dd() |> - dplyr::select(field_name, form_name) |> - (\(.x){ - split(.x$field_name, .x$form_name) - })() # |> - # stats::setNames(instr()[["data"]][[2]]) - , - updateOn = "close", - multiple = TRUE, - search = TRUE, - showValueAsTags = TRUE - ) - }) - - output$arms <- shiny::renderUI({ - shiny::selectizeInput( - # inputId = "arms", - inputId = ns("arms"), - selected = NULL, - label = "Filter by events/arms", - choices = arms()[[3]], - multiple = TRUE - ) - }) - - output$table <- DT::renderDT( - { - shiny::req(input$api) - shiny::req(input$uri) - # shiny::req(data_list$dict) - # dd()[["data"]][c(1,2,4,5,6,8)] - # browser() - data.df <- dd()[, c(1, 2, 4, 5, 6, 8)] - DT::datatable(data.df, - caption = "Subset of data dictionary" - ) - }, - server = TRUE - ) - - # Messes up the overlay of other objects. JS thing? - # output$table <- toastui::renderDatagrid2( - # { - # shiny::req(input$api) - # shiny::req(input$uri) - # # shiny::req(data_list$dict) - # # dd()[["data"]][c(1,2,4,5,6,8)] - # # browser() - # toastui::datagrid(dd()[,c(1, 2, 4, 5, 6, 8)] - # ) - # } - # ) - - name <- shiny::reactive({ - shiny::req(input$api) - REDCapR::redcap_project_info_read( - redcap_uri = input$uri, - token = input$api - )$data$project_title - }) - - shiny::eventReactive(input$import, { - shiny::req(input$api) - shiny::req(input$fields) - record_id <- dd()[[1]][1] - - redcap_data <- REDCapCAST::read_redcap_tables( - uri = input$uri, - token = input$api, - fields = unique(c(record_id, input$fields)), - # forms = input$instruments, - events = input$arms, - raw_or_label = "both", - filter_logic = input$filter - ) |> - REDCapCAST::redcap_wider() |> - dplyr::select(-dplyr::ends_with("_complete")) |> - dplyr::select(-dplyr::any_of(record_id)) |> - REDCapCAST::suffix2label() - - out_object <- file_export(redcap_data, - output.format = output.format, - filename = name() - ) - - if (output.format == "list") { - out <- list( - data = shiny::reactive(redcap_data), - meta = dd(), - name = name(), - filter = input$filter - ) - } else { - out <- out_object - } - - return(out) - }) - } - - shiny::moduleServer( - id = id, - module = module - ) -} - -tdm_redcap_read <- teal::teal_data_module( - ui <- function(id) { - shiny::fluidPage( - m_redcap_readUI(id) - ) - }, - server = function(id) { - m_redcap_readServer(id, output.format = "teal") - } -) - -tdm_data_upload <- teal::teal_data_module( - ui <- function(id) { - shiny::fluidPage( - m_datafileUI(id) - ) - }, - server = function(id) { - m_datafileServer(id, output.format = "teal") - } -) - - -redcap_app <- function() { - ui <- shiny::fluidPage( - m_redcap_readUI("data"), - # DT::DTOutput(outputId = "redcap_prev") - toastui::datagridOutput2(outputId = "redcap_prev"), - shiny::fluidRow( - shiny::column( - 8, - # verbatimTextOutput("data_filter_code"), - DT::DTOutput("data_summary") - ), - shiny::column(4, IDEAFilter::IDEAFilter_ui("data_filter")) - ) - ) - server <- function(input, output, session) { - data_val <- shiny::reactiveValues(data=NULL) - - ds <- m_redcap_readServer("data", output.format = "df") - # output$redcap_prev <- DT::renderDT( - # { - # DT::datatable(purrr::pluck(ds(), "data")(), - # caption = "Observations" - # ) - # }, - # server = TRUE - # ) - - # shiny::reactive({ - # data_val$data <- purrr::pluck(ds(), "data")() - # }) - - output$redcap_prev <- toastui::renderDatagrid2({ - # toastui::datagrid(purrr::pluck(ds(), "data")()) - # toastui::datagrid(data_val$data) - toastui::datagrid(ds()) - }) - - filtered_data <- IDEAFilter::IDEAFilter("data_filter", - data = ds, - verbose = FALSE) - - # filtered_data <- shiny::reactive({ - # IDEAFilter::IDEAFilter("data_filter", - # data = purrr::pluck(ds(), "data")(), - # verbose = FALSE) - # }) - - # output$data_filter_code <- renderPrint({ - # cat(gsub( - # "%>%", "%>% \n ", - # gsub( - # "\\s{2,}", " ", - # paste0( - # capture.output(attr(filtered_data(), "code")), - # collapse = " " - # ) - # ) - # )) - # }) - - output$data_summary <- DT::renderDataTable( - { - filtered_data() - }, - options = list( - scrollX = TRUE, - pageLength = 5 - ) - ) - } - shiny::shinyApp(ui, server) -} - - -redcap_app() - - -file_app <- function() { - ui <- shiny::fluidPage( - m_datafileUI("data"), - # DT::DTOutput(outputId = "redcap_prev") - toastui::datagridOutput2(outputId = "redcap_prev") - ) - server <- function(input, output, session) { - m_datafileServer("data", output.format = "list") - } - shiny::shinyApp(ui, server) -} - -file_app() - - -tdm_data_read <- teal::teal_data_module( - ui <- function(id) { - shiny::fluidPage( - m_redcap_readUI(id = "redcap") - ) - }, - server = function(id) { - moduleServer( - id, - function(input, output, session) { - ns <- session$ns - - m_redcap_readServer(id = "redcap", output.format = "teal") - } - ) - } -) diff --git a/man/m_datafileUI.Rd b/man/m_datafileUI.Rd index 9dd7510..c10a254 100644 --- a/man/m_datafileUI.Rd +++ b/man/m_datafileUI.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/modules.R +% Please edit documentation in R/file-import-module.R \name{m_datafileUI} \alias{m_datafileUI} \title{Shiny UI module to load a data file}