mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2025-09-12 09:59:39 +02:00
redcap import module has been overhauled
This commit is contained in:
parent
3dea828d20
commit
5dd872f254
6 changed files with 339 additions and 363 deletions
|
|
@ -1 +1 @@
|
|||
app_version <- function()'250226_1216'
|
||||
app_version <- function()'250226_2108'
|
||||
|
|
|
|||
|
|
@ -22,6 +22,15 @@ m_redcap_readUI <- function(id, include_title = TRUE) {
|
|||
inputId = ns("api"),
|
||||
label = "API token",
|
||||
value = ""
|
||||
),
|
||||
tags$div(
|
||||
id = ns("connect-placeholder"),
|
||||
shinyWidgets::alert(
|
||||
id = ns("connect-result"),
|
||||
status = "info",
|
||||
tags$p(phosphoricons::ph("info", weight = "bold"),"Please fill in server address (URI) and API token.")
|
||||
),
|
||||
dismissible = TRUE
|
||||
)
|
||||
)
|
||||
|
||||
|
|
@ -40,16 +49,6 @@ m_redcap_readUI <- function(id, include_title = TRUE) {
|
|||
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")),
|
||||
|
|
@ -74,8 +73,9 @@ m_redcap_readUI <- function(id, include_title = TRUE) {
|
|||
shiny::column(
|
||||
width = 12,
|
||||
# shiny::actionButton(inputId = ns("import"), label = "Import"),
|
||||
## TODO: Use busy indicator like on download to have button activate/deactivate
|
||||
bslib::input_task_button(
|
||||
id = ns("import"),
|
||||
id = ns("data_import"),
|
||||
label = "Import",
|
||||
icon = shiny::icon("download", lib = "glyphicon"),
|
||||
label_busy = "Just a minute...",
|
||||
|
|
@ -84,69 +84,102 @@ m_redcap_readUI <- function(id, include_title = TRUE) {
|
|||
"aria-hidden" = "true"
|
||||
),
|
||||
type = "primary",
|
||||
auto_reset = TRUE
|
||||
auto_reset = TRUE#,state="busy"
|
||||
),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
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"))
|
||||
shiny::br()
|
||||
)
|
||||
# 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)
|
||||
|
||||
m_redcap_readServer <- function(id) {
|
||||
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
|
||||
# )
|
||||
data_rv <- shiny::reactiveValues(
|
||||
dd_status = NULL,
|
||||
data_status = NULL,
|
||||
info = NULL,
|
||||
arms = NULL,
|
||||
dd_list = NULL,
|
||||
data = NULL
|
||||
)
|
||||
|
||||
dd <- shiny::reactive({
|
||||
# tryCatch(
|
||||
# {
|
||||
shiny::observeEvent(
|
||||
list(
|
||||
input$api,
|
||||
input$uri
|
||||
),
|
||||
{
|
||||
shiny::req(input$api)
|
||||
shiny::req(input$uri)
|
||||
|
||||
|
||||
REDCapR::redcap_metadata_read(
|
||||
parameters <- list(
|
||||
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
|
||||
# browser()
|
||||
imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters), silent = TRUE)
|
||||
|
||||
## TODO: Simplify error messages
|
||||
if (inherits(imported, "try-error") || NROW(imported) < 1 || ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) {
|
||||
|
||||
if (ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) {
|
||||
mssg <- imported$raw_text
|
||||
} else {
|
||||
mssg <- attr(imported, "condition")$message
|
||||
}
|
||||
|
||||
datamods:::insert_error(mssg = mssg,selector = "connect")
|
||||
data_rv$dd_status <- "error"
|
||||
data_rv$dd_list <- NULL
|
||||
} else if (isTRUE(imported$success)) {
|
||||
|
||||
datamods:::insert_alert(
|
||||
selector = ns("connect"),
|
||||
status = "success",
|
||||
make_success_alert(
|
||||
dataIdName = "see_data",
|
||||
extra = tags$b(phosphoricons::ph("check", weight = "bold"),"Connected to server! Project data loaded."),
|
||||
btn_show_data = TRUE
|
||||
)
|
||||
)
|
||||
|
||||
data_rv$dd_status <- "success"
|
||||
data_rv$dd_list <- imported
|
||||
}
|
||||
},
|
||||
ignoreInit = TRUE
|
||||
)
|
||||
# },
|
||||
# warning = function(warn) {
|
||||
# showNotification(paste0(warn), type = "warning")
|
||||
# },
|
||||
# error = function(err) {
|
||||
# showNotification(paste0(err), type = "err")
|
||||
# }
|
||||
# )
|
||||
#
|
||||
# data_list$dict <- out$data
|
||||
# data_list$stat <- out$success
|
||||
#
|
||||
# out$data
|
||||
# })
|
||||
|
||||
shiny::observeEvent(input$see_data, {
|
||||
datamods::show_data(
|
||||
purrr::pluck(data_rv$dd_list, "data"),
|
||||
title = "Data dictionary",
|
||||
type = "modal",
|
||||
show_classes = FALSE,
|
||||
tags$b("Preview:")
|
||||
)
|
||||
})
|
||||
|
||||
arms <- shiny::reactive({
|
||||
shiny::req(input$api)
|
||||
|
|
@ -156,21 +189,18 @@ m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) {
|
|||
redcap_uri = input$uri,
|
||||
token = input$api
|
||||
)$data
|
||||
|
||||
# data_list$arms <- out
|
||||
# out
|
||||
})
|
||||
|
||||
output$fields <- shiny::renderUI({
|
||||
shiny::req(data_rv$dd_list)
|
||||
shinyWidgets::virtualSelectInput(
|
||||
inputId = ns("fields"),
|
||||
label = "Select fields/variables to import:",
|
||||
choices = dd() |>
|
||||
choices = purrr::pluck(data_rv$dd_list, "data") |>
|
||||
dplyr::select(field_name, form_name) |>
|
||||
(\(.x){
|
||||
split(.x$field_name, .x$form_name)
|
||||
})() # |>
|
||||
# stats::setNames(instr()[["data"]][[2]])
|
||||
})()
|
||||
,
|
||||
updateOn = "close",
|
||||
multiple = TRUE,
|
||||
|
|
@ -179,9 +209,20 @@ m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) {
|
|||
)
|
||||
})
|
||||
|
||||
## TODO: Get activate/inactivate action button to work
|
||||
# shiny::observeEvent(input$fields,
|
||||
# {
|
||||
# if (is.null(input$fields) | length(input$fields)==1){
|
||||
# bslib::update_task_button(id= "data_import", state = "busy")
|
||||
# # datamods:::toggle_widget(inputId = "data_import", enable = FALSE)
|
||||
# } else {
|
||||
# bslib::update_task_button(id= "data_import", state = "ready")
|
||||
# # datamods:::toggle_widget(inputId = "data_import", enable = TRUE)
|
||||
# }
|
||||
# })
|
||||
|
||||
output$arms <- shiny::renderUI({
|
||||
shiny::selectizeInput(
|
||||
# inputId = "arms",
|
||||
inputId = ns("arms"),
|
||||
selected = NULL,
|
||||
label = "Filter by events/arms",
|
||||
|
|
@ -190,79 +231,50 @@ m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) {
|
|||
)
|
||||
})
|
||||
|
||||
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)]
|
||||
# )
|
||||
# }
|
||||
# )
|
||||
|
||||
## Merge project name in success meassage
|
||||
## Generate Codebook link
|
||||
name <- shiny::reactive({
|
||||
shiny::req(input$api)
|
||||
if (data_rv$dd_status=="success"){
|
||||
# browser()
|
||||
REDCapR::redcap_project_info_read(
|
||||
redcap_uri = input$uri,
|
||||
token = input$api
|
||||
)$data$project_title
|
||||
)$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(
|
||||
shiny::observeEvent(input$data_import, {
|
||||
shiny::req(input$fields)
|
||||
record_id <- purrr::pluck(data_rv$dd_list, "data")[[1]][1]
|
||||
|
||||
parameters <- list(
|
||||
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
|
||||
) |>
|
||||
)
|
||||
|
||||
imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE)
|
||||
code <- rlang::call2(REDCapCAST::read_redcap_tables, !!!parameters)
|
||||
|
||||
|
||||
if (inherits(imported, "try-error") || NROW(imported) < 1) {
|
||||
|
||||
data_rv$data_status <- "error"
|
||||
data_rv$data_list <- NULL
|
||||
} else {
|
||||
data_rv$data_status <- "success"
|
||||
data_rv$data <- imported |>
|
||||
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)
|
||||
})
|
||||
|
||||
return(shiny::reactive(data_rv$data))
|
||||
}
|
||||
|
||||
shiny::moduleServer(
|
||||
|
|
@ -271,6 +283,26 @@ m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) {
|
|||
)
|
||||
}
|
||||
|
||||
#' @importFrom htmltools tagList tags
|
||||
#' @importFrom shiny icon getDefaultReactiveDomain
|
||||
make_success_alert <- function(dataIdName = "see_data",
|
||||
btn_show_data,
|
||||
see_data_text="Click to see data",
|
||||
extra = NULL,
|
||||
session = shiny::getDefaultReactiveDomain()) {
|
||||
if (isTRUE(btn_show_data)) {
|
||||
success_message <- tagList(
|
||||
extra,
|
||||
tags$br(),
|
||||
shiny::actionLink(
|
||||
inputId = session$ns(dataIdName),
|
||||
label = tagList(phosphoricons::ph("table"), see_data_text)
|
||||
)
|
||||
)
|
||||
}
|
||||
return(success_message)
|
||||
}
|
||||
|
||||
# #' REDCap import teal data module
|
||||
# #'
|
||||
# #' @rdname redcap_read_shiny_module
|
||||
|
|
@ -292,77 +324,29 @@ m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) {
|
|||
#'
|
||||
#' @examples
|
||||
#' \dontrun{
|
||||
#' redcap_app()
|
||||
#' redcap_demo_app()
|
||||
#' }
|
||||
redcap_app <- function() {
|
||||
redcap_demo_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 = " "
|
||||
# )
|
||||
# )
|
||||
# ))
|
||||
# })
|
||||
data_val$data <- m_redcap_readServer(id = "data")
|
||||
|
||||
output$data_summary <- DT::renderDataTable(
|
||||
{
|
||||
filtered_data()
|
||||
shiny::req(data_val$data)
|
||||
data_val$data()
|
||||
},
|
||||
options = list(
|
||||
scrollX = TRUE,
|
||||
pageLength = 5
|
||||
)
|
||||
),
|
||||
)
|
||||
}
|
||||
shiny::shinyApp(ui, server)
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@
|
|||
#### Current file: R//app_version.R
|
||||
########
|
||||
|
||||
app_version <- function()'250226_1216'
|
||||
app_version <- function()'250226_2108'
|
||||
|
||||
|
||||
########
|
||||
|
|
@ -2366,6 +2366,15 @@ m_redcap_readUI <- function(id, include_title = TRUE) {
|
|||
inputId = ns("api"),
|
||||
label = "API token",
|
||||
value = ""
|
||||
),
|
||||
tags$div(
|
||||
id = ns("connect-placeholder"),
|
||||
shinyWidgets::alert(
|
||||
id = ns("connect-result"),
|
||||
status = "info",
|
||||
tags$p(phosphoricons::ph("info", weight = "bold"),"Please fill in server address (URI) and API token.")
|
||||
),
|
||||
dismissible = TRUE
|
||||
)
|
||||
)
|
||||
|
||||
|
|
@ -2384,16 +2393,6 @@ m_redcap_readUI <- function(id, include_title = TRUE) {
|
|||
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")),
|
||||
|
|
@ -2418,8 +2417,9 @@ m_redcap_readUI <- function(id, include_title = TRUE) {
|
|||
shiny::column(
|
||||
width = 12,
|
||||
# shiny::actionButton(inputId = ns("import"), label = "Import"),
|
||||
## TODO: Use busy indicator like on download to have button activate/deactivate
|
||||
bslib::input_task_button(
|
||||
id = ns("import"),
|
||||
id = ns("data_import"),
|
||||
label = "Import",
|
||||
icon = shiny::icon("download", lib = "glyphicon"),
|
||||
label_busy = "Just a minute...",
|
||||
|
|
@ -2428,69 +2428,102 @@ m_redcap_readUI <- function(id, include_title = TRUE) {
|
|||
"aria-hidden" = "true"
|
||||
),
|
||||
type = "primary",
|
||||
auto_reset = TRUE
|
||||
auto_reset = TRUE#,state="busy"
|
||||
),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
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"))
|
||||
shiny::br()
|
||||
)
|
||||
# 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)
|
||||
|
||||
m_redcap_readServer <- function(id) {
|
||||
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
|
||||
# )
|
||||
data_rv <- shiny::reactiveValues(
|
||||
dd_status = NULL,
|
||||
data_status = NULL,
|
||||
info = NULL,
|
||||
arms = NULL,
|
||||
dd_list = NULL,
|
||||
data = NULL
|
||||
)
|
||||
|
||||
dd <- shiny::reactive({
|
||||
# tryCatch(
|
||||
# {
|
||||
shiny::observeEvent(
|
||||
list(
|
||||
input$api,
|
||||
input$uri
|
||||
),
|
||||
{
|
||||
shiny::req(input$api)
|
||||
shiny::req(input$uri)
|
||||
|
||||
|
||||
REDCapR::redcap_metadata_read(
|
||||
parameters <- list(
|
||||
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
|
||||
# browser()
|
||||
imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters), silent = TRUE)
|
||||
|
||||
## TODO: Simplify error messages
|
||||
if (inherits(imported, "try-error") || NROW(imported) < 1 || ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) {
|
||||
|
||||
if (ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) {
|
||||
mssg <- imported$raw_text
|
||||
} else {
|
||||
mssg <- attr(imported, "condition")$message
|
||||
}
|
||||
|
||||
datamods:::insert_error(mssg = mssg,selector = "connect")
|
||||
data_rv$dd_status <- "error"
|
||||
data_rv$dd_list <- NULL
|
||||
} else if (isTRUE(imported$success)) {
|
||||
|
||||
datamods:::insert_alert(
|
||||
selector = ns("connect"),
|
||||
status = "success",
|
||||
make_success_alert(
|
||||
dataIdName = "see_data",
|
||||
extra = tags$b(phosphoricons::ph("check", weight = "bold"),"Connected to server! Project data loaded."),
|
||||
btn_show_data = TRUE
|
||||
)
|
||||
)
|
||||
|
||||
data_rv$dd_status <- "success"
|
||||
data_rv$dd_list <- imported
|
||||
}
|
||||
},
|
||||
ignoreInit = TRUE
|
||||
)
|
||||
# },
|
||||
# warning = function(warn) {
|
||||
# showNotification(paste0(warn), type = "warning")
|
||||
# },
|
||||
# error = function(err) {
|
||||
# showNotification(paste0(err), type = "err")
|
||||
# }
|
||||
# )
|
||||
#
|
||||
# data_list$dict <- out$data
|
||||
# data_list$stat <- out$success
|
||||
#
|
||||
# out$data
|
||||
# })
|
||||
|
||||
shiny::observeEvent(input$see_data, {
|
||||
datamods::show_data(
|
||||
purrr::pluck(data_rv$dd_list, "data"),
|
||||
title = "Data dictionary",
|
||||
type = "modal",
|
||||
show_classes = FALSE,
|
||||
tags$b("Preview:")
|
||||
)
|
||||
})
|
||||
|
||||
arms <- shiny::reactive({
|
||||
shiny::req(input$api)
|
||||
|
|
@ -2500,21 +2533,18 @@ m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) {
|
|||
redcap_uri = input$uri,
|
||||
token = input$api
|
||||
)$data
|
||||
|
||||
# data_list$arms <- out
|
||||
# out
|
||||
})
|
||||
|
||||
output$fields <- shiny::renderUI({
|
||||
shiny::req(data_rv$dd_list)
|
||||
shinyWidgets::virtualSelectInput(
|
||||
inputId = ns("fields"),
|
||||
label = "Select fields/variables to import:",
|
||||
choices = dd() |>
|
||||
choices = purrr::pluck(data_rv$dd_list, "data") |>
|
||||
dplyr::select(field_name, form_name) |>
|
||||
(\(.x){
|
||||
split(.x$field_name, .x$form_name)
|
||||
})() # |>
|
||||
# stats::setNames(instr()[["data"]][[2]])
|
||||
})()
|
||||
,
|
||||
updateOn = "close",
|
||||
multiple = TRUE,
|
||||
|
|
@ -2523,9 +2553,20 @@ m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) {
|
|||
)
|
||||
})
|
||||
|
||||
## TODO: Get activate/inactivate action button to work
|
||||
# shiny::observeEvent(input$fields,
|
||||
# {
|
||||
# if (is.null(input$fields) | length(input$fields)==1){
|
||||
# bslib::update_task_button(id= "data_import", state = "busy")
|
||||
# # datamods:::toggle_widget(inputId = "data_import", enable = FALSE)
|
||||
# } else {
|
||||
# bslib::update_task_button(id= "data_import", state = "ready")
|
||||
# # datamods:::toggle_widget(inputId = "data_import", enable = TRUE)
|
||||
# }
|
||||
# })
|
||||
|
||||
output$arms <- shiny::renderUI({
|
||||
shiny::selectizeInput(
|
||||
# inputId = "arms",
|
||||
inputId = ns("arms"),
|
||||
selected = NULL,
|
||||
label = "Filter by events/arms",
|
||||
|
|
@ -2534,79 +2575,50 @@ m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) {
|
|||
)
|
||||
})
|
||||
|
||||
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)]
|
||||
# )
|
||||
# }
|
||||
# )
|
||||
|
||||
## Merge project name in success meassage
|
||||
## Generate Codebook link
|
||||
name <- shiny::reactive({
|
||||
shiny::req(input$api)
|
||||
if (data_rv$dd_status=="success"){
|
||||
# browser()
|
||||
REDCapR::redcap_project_info_read(
|
||||
redcap_uri = input$uri,
|
||||
token = input$api
|
||||
)$data$project_title
|
||||
)$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(
|
||||
shiny::observeEvent(input$data_import, {
|
||||
shiny::req(input$fields)
|
||||
record_id <- purrr::pluck(data_rv$dd_list, "data")[[1]][1]
|
||||
|
||||
parameters <- list(
|
||||
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
|
||||
) |>
|
||||
)
|
||||
|
||||
imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE)
|
||||
code <- rlang::call2(REDCapCAST::read_redcap_tables, !!!parameters)
|
||||
|
||||
|
||||
if (inherits(imported, "try-error") || NROW(imported) < 1) {
|
||||
|
||||
data_rv$data_status <- "error"
|
||||
data_rv$data_list <- NULL
|
||||
} else {
|
||||
data_rv$data_status <- "success"
|
||||
data_rv$data <- imported |>
|
||||
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)
|
||||
})
|
||||
|
||||
return(shiny::reactive(data_rv$data))
|
||||
}
|
||||
|
||||
shiny::moduleServer(
|
||||
|
|
@ -2615,6 +2627,26 @@ m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) {
|
|||
)
|
||||
}
|
||||
|
||||
#' @importFrom htmltools tagList tags
|
||||
#' @importFrom shiny icon getDefaultReactiveDomain
|
||||
make_success_alert <- function(dataIdName = "see_data",
|
||||
btn_show_data,
|
||||
see_data_text="Click to see data",
|
||||
extra = NULL,
|
||||
session = shiny::getDefaultReactiveDomain()) {
|
||||
if (isTRUE(btn_show_data)) {
|
||||
success_message <- tagList(
|
||||
extra,
|
||||
tags$br(),
|
||||
shiny::actionLink(
|
||||
inputId = session$ns(dataIdName),
|
||||
label = tagList(phosphoricons::ph("table"), see_data_text)
|
||||
)
|
||||
)
|
||||
}
|
||||
return(success_message)
|
||||
}
|
||||
|
||||
# #' REDCap import teal data module
|
||||
# #'
|
||||
# #' @rdname redcap_read_shiny_module
|
||||
|
|
@ -2636,77 +2668,29 @@ m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) {
|
|||
#'
|
||||
#' @examples
|
||||
#' \dontrun{
|
||||
#' redcap_app()
|
||||
#' redcap_demo_app()
|
||||
#' }
|
||||
redcap_app <- function() {
|
||||
redcap_demo_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 = " "
|
||||
# )
|
||||
# )
|
||||
# ))
|
||||
# })
|
||||
data_val$data <- m_redcap_readServer(id = "data")
|
||||
|
||||
output$data_summary <- DT::renderDataTable(
|
||||
{
|
||||
filtered_data()
|
||||
shiny::req(data_val$data)
|
||||
data_val$data()
|
||||
},
|
||||
options = list(
|
||||
scrollX = TRUE,
|
||||
pageLength = 5
|
||||
)
|
||||
),
|
||||
)
|
||||
}
|
||||
shiny::shinyApp(ui, server)
|
||||
|
|
@ -4954,12 +4938,14 @@ ui_elements <- list(
|
|||
selected = "env",
|
||||
choices = c(
|
||||
"File upload" = "file",
|
||||
"REDCap server" = "redcap",
|
||||
"Local data" = "env"
|
||||
"REDCap server export" = "redcap",
|
||||
"Local or sample data" = "env"
|
||||
),
|
||||
width = "100%"
|
||||
),
|
||||
shiny::helpText("Upload a file from your device, get data directly from REDCap or select a sample data set for testing from the app."),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='file'",
|
||||
datamods::import_file_ui("file_import",
|
||||
|
|
@ -5686,17 +5672,19 @@ server <- function(input, output, session) {
|
|||
})
|
||||
|
||||
data_redcap <- m_redcap_readServer(
|
||||
id = "redcap_import",
|
||||
output.format = "list"
|
||||
id = "redcap_import"#,
|
||||
# output.format = "list"
|
||||
)
|
||||
|
||||
shiny::observeEvent(data_redcap(), {
|
||||
rv$data_original <- purrr::pluck(data_redcap(), "data")()
|
||||
# rv$data_original <- purrr::pluck(data_redcap(), "data")()
|
||||
rv$data_original <- data_redcap()
|
||||
})
|
||||
|
||||
output$redcap_prev <- DT::renderDT(
|
||||
{
|
||||
DT::datatable(head(purrr::pluck(data_redcap(), "data")(), 5),
|
||||
DT::datatable(head(data_redcap(), 5),
|
||||
# DT::datatable(head(purrr::pluck(data_redcap(), "data")(), 5),
|
||||
caption = "First 5 observations"
|
||||
)
|
||||
},
|
||||
|
|
|
|||
|
|
@ -5,6 +5,6 @@ account: agdamsbo
|
|||
server: shinyapps.io
|
||||
hostUrl: https://api.shinyapps.io/v1
|
||||
appId: 13611288
|
||||
bundleId: 9852208
|
||||
bundleId: 9861005
|
||||
url: https://agdamsbo.shinyapps.io/freesearcheR/
|
||||
version: 1
|
||||
|
|
|
|||
|
|
@ -154,17 +154,19 @@ server <- function(input, output, session) {
|
|||
})
|
||||
|
||||
data_redcap <- m_redcap_readServer(
|
||||
id = "redcap_import",
|
||||
output.format = "list"
|
||||
id = "redcap_import"#,
|
||||
# output.format = "list"
|
||||
)
|
||||
|
||||
shiny::observeEvent(data_redcap(), {
|
||||
rv$data_original <- purrr::pluck(data_redcap(), "data")()
|
||||
# rv$data_original <- purrr::pluck(data_redcap(), "data")()
|
||||
rv$data_original <- data_redcap()
|
||||
})
|
||||
|
||||
output$redcap_prev <- DT::renderDT(
|
||||
{
|
||||
DT::datatable(head(purrr::pluck(data_redcap(), "data")(), 5),
|
||||
DT::datatable(head(data_redcap(), 5),
|
||||
# DT::datatable(head(purrr::pluck(data_redcap(), "data")(), 5),
|
||||
caption = "First 5 observations"
|
||||
)
|
||||
},
|
||||
|
|
|
|||
|
|
@ -36,12 +36,14 @@ ui_elements <- list(
|
|||
selected = "env",
|
||||
choices = c(
|
||||
"File upload" = "file",
|
||||
"REDCap server" = "redcap",
|
||||
"Local data" = "env"
|
||||
"REDCap server export" = "redcap",
|
||||
"Local or sample data" = "env"
|
||||
),
|
||||
width = "100%"
|
||||
),
|
||||
shiny::helpText("Upload a file from your device, get data directly from REDCap or select a sample data set for testing from the app."),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='file'",
|
||||
datamods::import_file_ui("file_import",
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue