diff --git a/R/redcap_read_shiny_module.R b/R/redcap_read_shiny_module.R new file mode 100644 index 0000000..061a6e7 --- /dev/null +++ b/R/redcap_read_shiny_module.R @@ -0,0 +1,364 @@ +#' 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 + ) +} + +#' REDCap import teal data module +#' +#' @rdname redcap_read_shiny_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") + } +) + + +#' Test app for the redcap_read_shiny_module +#' +#' @rdname redcap_read_shiny_module +#' +#' @examples +#' \dontrun{ +#' redcap_app() +#' } +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) +} diff --git a/man/redcap_read_shiny_module.Rd b/man/redcap_read_shiny_module.Rd index 226abfb..f72697b 100644 --- a/man/redcap_read_shiny_module.Rd +++ b/man/redcap_read_shiny_module.Rd @@ -1,13 +1,23 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/modules.R +% Please edit documentation in R/redcap_read_shiny_module.R +\docType{data} \name{m_redcap_readUI} \alias{m_redcap_readUI} \alias{m_redcap_readServer} +\alias{tdm_redcap_read} +\alias{redcap_app} \title{Shiny module to browser and export REDCap data} +\format{ +An object of class \code{teal_data_module} of length 2. +} \usage{ m_redcap_readUI(id, include_title = TRUE) m_redcap_readServer(id, output.format = c("df", "teal", "list")) + +tdm_redcap_read + +redcap_app() } \arguments{ \item{id}{Namespace id} @@ -23,4 +33,14 @@ shiny server module } \description{ Shiny module to browser and export REDCap data + +REDCap import teal data module + +Test app for the redcap_read_shiny_module } +\examples{ +\dontrun{ +redcap_app() +} +} +\keyword{datasets}