From 00eb49c225f8c3656a1400b241c8e0dfeb77eec7 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Mon, 9 Dec 2024 14:00:44 +0100 Subject: [PATCH] a bit of trial and error. not completely satisfied with readcap_read-module yet --- DESCRIPTION | 4 +- NAMESPACE | 2 + R/helpers.R | 45 +- R/modules.R | 336 +++++++++----- inst/apps/data_analysis/server.R | 15 +- inst/apps/data_analysis/ui.R | 1 - .../shinyapps.io/agdamsbo/webResearch.dcf | 10 + inst/apps/data_analysis_modules/server.R | 352 +++++++++++++++ inst/apps/data_analysis_modules/ui.R | 412 ++++++++++++++++++ inst/apps/data_analysis_modules/www/intro.md | 3 + .../apps/data_analysis_modules/www/report.qmd | 68 +++ inst/apps/redcap_module/rc_modules.R | 103 ----- inst/apps/redcap_module/server.R | 91 ---- inst/apps/redcap_module/ui.R | 23 - inst/apps/teal_test/app.R | 84 ++-- man/redcap_read_shiny_module.Rd | 24 + 16 files changed, 1188 insertions(+), 385 deletions(-) create mode 100644 inst/apps/data_analysis_modules/rsconnect/shinyapps.io/agdamsbo/webResearch.dcf create mode 100644 inst/apps/data_analysis_modules/server.R create mode 100644 inst/apps/data_analysis_modules/ui.R create mode 100644 inst/apps/data_analysis_modules/www/intro.md create mode 100644 inst/apps/data_analysis_modules/www/report.qmd delete mode 100644 inst/apps/redcap_module/rc_modules.R delete mode 100644 inst/apps/redcap_module/server.R delete mode 100644 inst/apps/redcap_module/ui.R create mode 100644 man/redcap_read_shiny_module.Rd diff --git a/DESCRIPTION b/DESCRIPTION index ecba0bc..ca0e24c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -39,7 +39,9 @@ Imports: DHARMa, teal, IDEAFilter, - sparkline + sparkline, + datamods, + toastui Suggests: styler, devtools, diff --git a/NAMESPACE b/NAMESPACE index d3cf8eb..4c55412 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,6 +10,8 @@ export(format_writer) export(getfun) export(index_embed) export(m_datafileUI) +export(m_redcap_readServer) +export(m_redcap_readUI) export(modify_qmd) export(read_input) export(regression_model) diff --git a/R/helpers.R b/R/helpers.R index d586da4..5c4efca 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -10,13 +10,13 @@ #' @examples #' getfun("stats::lm") getfun <- function(x) { - if("character" %in% class(x)){ + if ("character" %in% class(x)) { if (length(grep("::", x)) > 0) { parts <- strsplit(x, "::")[[1]] requireNamespace(parts[1]) getExportedValue(parts[1], parts[2]) } - }else { + } else { x } } @@ -29,20 +29,20 @@ getfun <- function(x) { #' @return output file name #' @export #' -write_quarto <- function(data,...){ - +write_quarto <- function(data, ...) { # Exports data to temporary location # # I assume this is more secure than putting it in the www folder and deleting # on session end temp <- tempfile(fileext = ".rds") - readr::write_rds(data,file=temp) + readr::write_rds(data, file = temp) ## Specifying a output path will make the rendering fail ## Ref: https://github.com/quarto-dev/quarto-cli/discussions/4041 ## Outputs to the same as the .qmd file - quarto::quarto_render(execute_params = list(data.file=temp), - ... + quarto::quarto_render( + execute_params = list(data.file = temp), + ... ) } @@ -87,7 +87,7 @@ read_input <- function(file, consider.na = c("NA", '""', "")) { #' @return list #' @export #' -argsstring2list <- function(string){ +argsstring2list <- function(string) { eval(parse(text = paste0("list(", string, ")"))) } @@ -99,7 +99,7 @@ argsstring2list <- function(string){ #' #' @return data.frame #' @export -factorize <- function(data,vars){ +factorize <- function(data, vars) { if (!is.null(vars)) { data |> dplyr::mutate( @@ -123,29 +123,40 @@ dummy_Imports <- function() { parameters::ci(), DT::addRow(), bslib::accordion() - ) - #https://github.com/hadley/r-pkgs/issues/828 - } + ) + # https://github.com/hadley/r-pkgs/issues/828 +} -file_export <- function(data,output.format=c("df","teal"),filename){ +file_export <- function(data, output.format = c("df", "teal", "list"), filename, ...) { output.format <- match.arg(output.format) - filename <- gsub("-","_",filename) + filename <- gsub("-", "_", filename) - if (output.format=="teal"){ + if (output.format == "teal") { out <- within( teal_data(), { - assign(name, value |> dplyr::bind_cols()) + assign(name, value |> + dplyr::bind_cols() |> + REDCapCAST::parse_data() |> + REDCapCAST::as_factor() |> + REDCapCAST::numchar2fct()) }, value = data, name = filename ) datanames(out) <- filename - } else if (output.format=="df"){ + } else if (output.format == "df") { out <- data + } else if (output.format == "list") { + out <- list( + data = data, + name = filename + ) + + out <- c(out,...) } out diff --git a/R/modules.R b/R/modules.R index 3b75b8e..340c880 100644 --- a/R/modules.R +++ b/R/modules.R @@ -30,7 +30,6 @@ m_datafileUI <- function(id) { } m_datafileServer <- function(id, output.format = "df") { - ns <- shiny::NS(id) shiny::moduleServer(id, function(input, output, session, ...) { ns <- shiny::NS(id) ds <- shiny::reactive({ @@ -54,7 +53,7 @@ m_datafileServer <- function(id, output.format = "df") { } else { out <- input$include_vars } - return(out) + out }) output$data_input <- @@ -64,125 +63,262 @@ m_datafileServer <- function(id, output.format = "df") { }) shiny::eventReactive(input$submit, { - shiny::req(input$file) + # shiny::req(input$file) - file_export( - data = ds()[base_vars()] |> REDCapCAST::numchar2fct(), + data <- shiny::isolate({ + ds()[base_vars()] + }) + + file_export(data, output.format = output.format, - filename = tools::file_path_sans_ext(input$file$name) + tools::file_path_sans_ext(input$file$name) ) }) }) } +#' Shiny module to browser and export REDCap data +#' +#' @param id Namespace id +#' @rdname redcap_read_shiny_module +#' +#' @return shiny ui element +#' @export m_redcap_readUI <- function(id) { ns <- shiny::NS(id) - shiny::tagList( - shiny::textInput( - inputId = ns("uri"), - label = "URI", - value = "https://redcap.your.institution/api/" - ), - shiny::textInput( - inputId = ns("api"), - label = "API token", - value = "" - ), - shiny::tableOutput(outputId = ns("table")), - shiny::uiOutput(outputId = ns("fields")), - shiny::uiOutput(outputId = ns("instruments")), - shiny::uiOutput(outputId = ns("arms")), - shiny::actionButton(inputId = ns("submit"), "Submit") + + server_ui <- fluidRow( + column( + width = 6, + shiny::textInput( + inputId = ns("uri"), + label = "URI", + value = "https://redcap.your.institution/api/" + ), + shiny::textInput( + inputId = ns("api"), + label = "API token", + value = "" + ) + ) + ) + + params_ui <- fluidRow( + column( + width = 6, + shiny::uiOutput(outputId = ns("fields")), + shinyWidgets::switchInput( + inputId = "do_filter", + label = "Apply filter?", + value = FALSE, + inline = TRUE + ), + # 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( + server_ui, + params_ui, + shiny::actionButton(inputId = ns("import"), label = "Import"), + shiny::br(), + DT::DTOutput(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")) ) } -m_redcap_readServer <- function(id, output.format="df") { - ns <- shiny::NS(id) - shiny::moduleServer( - id, - function(input, output, session,...) { - ns <- shiny::NS(id) - instr <- shiny::reactive({ +#' @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 + + dd <- shiny::reactive({ + shiny::req(input$api) + shiny::req(input$uri) + + REDCapR::redcap_metadata_read( + redcap_uri = input$uri, + token = input$api + )$data + }) + + arms <- shiny::reactive({ + shiny::req(input$api) + shiny::req(input$uri) + + REDCapR::redcap_event_read( + redcap_uri = input$uri, + token = input$api + )$data + }) + + output$fields <- shiny::renderUI({ + shinyWidgets::virtualSelectInput( + inputId = ns("fields"), + label = "Multiple select:", + 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 + ) + }) + + 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) - REDCapR::redcap_instruments(redcap_uri = input$uri, token = input$api) - }) - - output$instruments <- shiny::renderUI({ - shiny::selectizeInput( - inputId = ns("instruments"), - # inputId = "instruments", - selected = NULL, - label = "Instruments to include", - choices = instr()[["data"]][[1]], - multiple = TRUE + # dd()[["data"]][c(1,2,4,5,6,8)] + data.df <- dd()[c(1, 2, 4, 5, 6, 8)] + DT::datatable(data.df, + caption = "Subset of data dictionary" ) - }) + }, + server = TRUE + ) - dd <- shiny::reactive({ - shiny::req(input$api) - shiny::req(input$uri) - REDCapR::redcap_metadata_read(redcap_uri = input$uri, token = input$api) - }) + name <- reactive({ + shiny::req(input$api) + REDCapR::redcap_project_info_read( + redcap_uri = input$uri, + token = input$api + )$data$project_title + }) - output$fields <- shiny::renderUI({ - shiny::selectizeInput( - # inputId = "fields", - inputId = ns("fields"), - selected = NULL, - label = "Fields/variables to include", - choices = dd()[["data"]][[1]], - multiple = TRUE - ) - }) + shiny::eventReactive(input$import, { + shiny::req(input$api) + record_id <- dd()[[1]][1] - arms <- shiny::reactive({ - shiny::req(input$api) - shiny::req(input$uri) - REDCapR::redcap_event_read(redcap_uri = input$uri, token = input$api) - }) + 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() - output$arms <- shiny::renderUI({ - shiny::selectizeInput( - # inputId = "arms", - inputId = ns("arms"), - selected = NULL, - label = "Arms/events to include", - choices = arms()[["data"]][[3]], - multiple = TRUE - ) - }) + out_object <- file_export(redcap_data, + output.format = output.format, + filename = name() + ) - output$table <- shiny::renderTable({ - dd()[["data"]] - }) - - shiny::eventReactive(input$submit, { - shiny::req(input$api) - data <- REDCapCAST::read_redcap_tables( - uri = input$uri, - token = input$api, - fields = unique(c(dd()[["data"]][[1]][1], input$fields)), - forms = input$instruments, - events = input$arms, - raw_or_label = "both" - ) - - info <- REDCapR::redcap_project_info_read(redcap_uri = input$uri, - token = input$api) - - data |> - REDCapCAST::redcap_wider() |> - REDCapCAST::suffix2label() |> - REDCapCAST::as_factor() |> - dplyr::select(-dplyr::ends_with("_complete")) |> - dplyr::select(-dplyr::any_of(dd()[["data"]][[1]][1])) |> - file_export( - output.format = output.format, - filename = info$data$project_title + if (output.format == "list") { + out <- list( + data = shiny::reactive(redcap_data) + # meta = dd()[["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 <- fluidPage( + m_redcap_readUI("data"), + DT::DTOutput(outputId = "redcap_prev") + ) + server <- function(input, output, session) { + ds <- m_redcap_readServer("data") + output$redcap_prev <- DT::renderDT( + { + + # df <- shiny::isolate(data_redcap()) + # browser() + # + DT::datatable(ds(), + caption = "Observations" + ) + }, + server = TRUE + ) + } + shinyApp(ui, server) +} + +redcap_app() diff --git a/inst/apps/data_analysis/server.R b/inst/apps/data_analysis/server.R index b65def8..76dad1d 100644 --- a/inst/apps/data_analysis/server.R +++ b/inst/apps/data_analysis/server.R @@ -23,7 +23,6 @@ library(REDCapCAST) library(easystats) library(patchwork) library(DHARMa) -library(IDEAFilter) # if (!requireNamespace("webResearch")) { # devtools::install_github("agdamsbo/webResearch", quiet = TRUE, upgrade = "never") # } @@ -296,11 +295,15 @@ server <- function(input, output, session) { paste0("report.", input$output_type) }), content = function(file, type = input$output_type) { - v$list |> - write_quarto( - output_format = type, - input = file.path(getwd(), "www/report.qmd") - ) + ## Notification is not progressing + ## Presumably due to missing + shiny::withProgress(message = "Generating report. Hold on for a moment..", { + v$list |> + write_quarto( + output_format = type, + input = file.path(getwd(), "www/report.qmd") + ) + }) file.rename(paste0("www/report.", type), file) } ) diff --git a/inst/apps/data_analysis/ui.R b/inst/apps/data_analysis/ui.R index 989b85a..9cb559f 100644 --- a/inst/apps/data_analysis/ui.R +++ b/inst/apps/data_analysis/ui.R @@ -28,7 +28,6 @@ panels <- list( ) ) - ui <- bslib::page( theme = bslib::bs_theme( bootswatch = "minty", diff --git a/inst/apps/data_analysis_modules/rsconnect/shinyapps.io/agdamsbo/webResearch.dcf b/inst/apps/data_analysis_modules/rsconnect/shinyapps.io/agdamsbo/webResearch.dcf new file mode 100644 index 0000000..6fa449f --- /dev/null +++ b/inst/apps/data_analysis_modules/rsconnect/shinyapps.io/agdamsbo/webResearch.dcf @@ -0,0 +1,10 @@ +name: webResearch +title: +username: agdamsbo +account: agdamsbo +server: shinyapps.io +hostUrl: https://api.shinyapps.io/v1 +appId: 13276335 +bundleId: 9436643 +url: https://agdamsbo.shinyapps.io/webResearch/ +version: 1 diff --git a/inst/apps/data_analysis_modules/server.R b/inst/apps/data_analysis_modules/server.R new file mode 100644 index 0000000..43ba086 --- /dev/null +++ b/inst/apps/data_analysis_modules/server.R @@ -0,0 +1,352 @@ +# project.aid::merge_scripts(list.files("R/",full.names = TRUE),dest = here::here("app/functions.R")) +# source(here::here("app/functions.R")) + +# source("https://raw.githubusercontent.com/agdamsbo/webResearch/refs/heads/main/app/functions.R") + +library(readr) +library(MASS) +library(stats) +library(gtsummary) +library(gt) +library(openxlsx2) +library(haven) +library(readODS) +library(shiny) +library(bslib) +library(assertthat) +library(dplyr) +library(quarto) +library(here) +library(broom) +library(broom.helpers) +library(REDCapCAST) +library(easystats) +library(patchwork) +library(DHARMa) +# if (!requireNamespace("webResearch")) { +# devtools::install_github("agdamsbo/webResearch", quiet = TRUE, upgrade = "never") +# } +# library(webResearch) + +if (file.exists(here::here("functions.R"))) { + source(here::here("functions.R")) +} + +server <- function(input, output, session) { + ## Listing files in www in session start to keep when ending and removing + ## everything else. + files.to.keep <- list.files("www/") + + v <- shiny::reactiveValues( + list = NULL, + ds = NULL, + input = exists("webResearch_data"), + local_temp = NULL, + quarto = NULL, + test = "no" + ) + + data_file <- datamods::import_file_server( + id = "file_import", + show_data_in = "popup", + trigger_return = "button", + return_class = "data.frame", + read_fns = list( + ods = function(file) { + readODS::read_ods(path = file) + }, + dta = function(file) { + haven::read_dta(file = file) + } + ) + ) + + data_redcap <- m_redcap_readServer( + id = "redcap_import", + output.format = "list" + ) + + output$redcap_prev <- DT::renderDT( + { + DT::datatable(head(purrr::pluck(data_redcap(), 1)(), 5), + caption = "First 5 observations" + ) + }, + server = TRUE + ) + + ds <- shiny::reactive({ + # input$file1 will be NULL initially. After the user selects + # and uploads a file, head of that data file by default, + # or all rows if selected, will be shown. + if (v$input) { + out <- webResearch_data + } else if (input$source == "file") { + out <- data_file$data() |> + REDCapCAST::numchar2fct() + } else if (input$source == "redcap") { + out <- purrr::pluck(data_redcap(), 1)() |> + REDCapCAST::parse_data() |> + REDCapCAST::as_factor() |> + REDCapCAST::numchar2fct() + } + + v$ds <- "loaded" + # browser() + # if (input$factorize == "yes") { + # out <- out |> + # REDCapCAST::numchar2fct() + # } + + out + }) + + output$include_vars <- shiny::renderUI({ + selectizeInput( + inputId = "include_vars", + selected = NULL, + label = "Covariables to include", + choices = colnames(ds()), + multiple = TRUE + ) + }) + + output$outcome_var <- shiny::renderUI({ + selectInput( + inputId = "outcome_var", + selected = NULL, + label = "Select outcome variable", + choices = colnames(ds()), + multiple = FALSE + ) + }) + + output$strat_var <- shiny::renderUI({ + selectInput( + inputId = "strat_var", + selected = "none", + label = "Select variable to stratify baseline", + choices = c("none", colnames(ds()[base_vars()])), + multiple = FALSE + ) + }) + + output$factor_vars <- shiny::renderUI({ + selectizeInput( + inputId = "factor_vars", + selected = colnames(ds())[sapply(ds(), is.factor)], + label = "Covariables to format as categorical", + choices = colnames(ds()), + multiple = TRUE + ) + }) + + base_vars <- shiny::reactive({ + if (is.null(input$include_vars)) { + out <- colnames(ds()) + } else { + out <- unique(c(input$include_vars, input$outcome_var)) + } + return(out) + }) + + ## Have a look at column filters at some point + ## There should be a way to use the filtering the filter data for further analyses + ## Disabled for now, as the JS is apparently not isolated + output$data_table <- + DT::renderDT( + { + DT::datatable(ds()[base_vars()]) + }, + server = FALSE + ) + + output$data.classes <- gt::render_gt({ + shiny::req(input$file) + data.frame(matrix(sapply(ds(), \(.x){ + class(.x)[1] + }), nrow = 1)) |> + stats::setNames(names(ds())) |> + gt::gt() + }) + + shiny::observeEvent(input$act_start, { + bslib::nav_select(id = "main_panel", selected = "Data analysis") + }) + + shiny::observeEvent( + { + input$load + }, + { + shiny::req(input$outcome_var) + + # Assumes all character variables can be formatted as factors + data <- ds() |> + dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor)) + + data <- data |> factorize(vars = input$factor_vars) + + # if (is.factor(data[[input$strat_var]])) { + # by.var <- input$strat_var + # } else { + # by.var <- NULL + # } + + if (input$strat_var == "none") { + by.var <- NULL + } else { + by.var <- input$strat_var + } + + data <- data[base_vars()] + + # model <- data |> + # regression_model( + # outcome.str = input$outcome_var, + # auto.mode = input$regression_auto == 1, + # formula.str = input$regression_formula, + # fun = input$regression_fun, + # args.list = eval(parse(text = paste0("list(", input$regression_args, ")"))) + # ) + + models <- list( + "Univariable" = regression_model_uv, + "Multivariable" = regression_model + ) |> + lapply(\(.fun){ + do.call( + .fun, + c( + list(data = data), + list(outcome.str = input$outcome_var), + list(formula.str = input$regression_formula), + list(fun = input$regression_fun), + list(args.list = eval(parse(text = paste0("list(", input$regression_args, ")")))) + ) + ) + }) + + # browser() + # check <- performance::check_model(purrr::pluck(models,"Multivariable") |> + # (\(x){ + # class(x) <- class(x)[class(x) != "webresearch_model"] + # return(x) + # })()) + + check <- purrr::pluck(models, "Multivariable") |> + performance::check_model() + + + v$list <- list( + data = data, + check = check, + table1 = data |> + baseline_table( + fun.args = + list( + by = by.var + ) + ) |> + (\(.x){ + if (!is.null(by.var)) { + .x |> gtsummary::add_overall() + } else { + .x + } + })() |> + (\(.x){ + if (input$add_p == "yes") { + .x |> + gtsummary::add_p() |> + gtsummary::bold_p() + } else { + .x + } + })(), + table2 = models |> + purrr::map(regression_table) |> + tbl_merge(), + input = input + ) + + output$table1 <- gt::render_gt( + v$list$table1 |> + gtsummary::as_gt() + ) + + output$table2 <- gt::render_gt( + v$list$table2 |> + gtsummary::as_gt() + ) + + output$check <- shiny::renderPlot({ + p <- plot(check) + + patchwork::plot_annotation(title = "Multivariable regression model checks") + p + # Generate checks in one column + # layout <- sapply(seq_len(length(p)), \(.x){ + # patchwork::area(.x, 1) + # }) + # + # p + patchwork::plot_layout(design = Reduce(c, layout)) + + # patchwork::wrap_plots(ncol=1) + + # patchwork::plot_annotation(title = 'Multivariable regression model checks') + }) + } + ) + + + + + output$uploaded <- shiny::reactive({ + if (is.null(v$ds)) { + "no" + } else { + "yes" + } + }) + + shiny::outputOptions(output, "uploaded", suspendWhenHidden = FALSE) + + output$has_input <- shiny::reactive({ + if (v$input) { + "yes" + } else { + "no" + } + }) + + shiny::outputOptions(output, "has_input", suspendWhenHidden = FALSE) + + # Could be rendered with other tables or should show progress + # Investigate quarto render problems + # On temp file handling: https://github.com/quarto-dev/quarto-cli/issues/3992 + output$report <- downloadHandler( + filename = shiny::reactive({ + paste0("report.", input$output_type) + }), + content = function(file, type = input$output_type) { + ## Notification is not progressing + ## Presumably due to missing + shiny::withProgress(message = "Generating report. Hold on for a moment..", { + v$list |> + write_quarto( + output_format = type, + input = file.path(getwd(), "www/report.qmd") + ) + }) + file.rename(paste0("www/report.", type), file) + } + ) + + session$onSessionEnded(function() { + cat("Session Ended\n") + files <- list.files("www/") + lapply(files[!files %in% files.to.keep], \(.x){ + unlink(paste0("www/", .x), recursive = FALSE) + print(paste(.x, "deleted")) + }) + }) +} diff --git a/inst/apps/data_analysis_modules/ui.R b/inst/apps/data_analysis_modules/ui.R new file mode 100644 index 0000000..3e46894 --- /dev/null +++ b/inst/apps/data_analysis_modules/ui.R @@ -0,0 +1,412 @@ +library(shiny) +library(bslib) +library(datamods) +library(shinyWidgets) +library(DT) +requireNamespace("gt") + +# ns <- NS(id) + +ui_elements <- list( + # bslib::nav_panel( + # title = "Data overview", + # # shiny::uiOutput("data.classes"), + # # shiny::uiOutput("data.input"), + # # shiny::p("Classes of uploaded data"), + # # gt::gt_output("data.classes"), + # shiny::p("Subset data"), + # DT::DTOutput(outputId = "data.input") + # ), + # bslib::nav_panel( + # title = "Baseline characteristics", + # gt::gt_output(outputId = "table1") + # ), + # bslib::nav_panel( + # title = "Regression table", + # gt::gt_output(outputId = "table2") + # ), + # bslib::nav_panel( + # title = "Regression checks", + # shiny::plotOutput(outputId = "check") + # ), + ############################################################################## + ######### + ######### Import panel + ######### + ############################################################################## + "import" = bslib::nav_panel( + title = "Data import", + shiny::h4("Upload your dataset"), + shiny::conditionalPanel( + condition = "output.has_input=='yes'", + # Input: Select a file ---- + shiny::helpText("Analyses are performed on provided data") + ), + shiny::conditionalPanel( + condition = "output.has_input=='no'", + # Input: Select a file ---- + shiny::radioButtons( + inputId = "source", + label = "Upload file or export from REDCap?", + selected = "file", + inline = TRUE, + choices = list( + "File" = "file", + "REDCap" = "redcap" + ) + ), + shiny::conditionalPanel( + condition = "input.source=='file'", + datamods::import_file_ui("file_import", + title = "Choose a datafile to upload", + file_extensions = c(".csv", ".txt", ".xls", ".xlsx", ".rds", ".fst", ".sas7bdat", ".sav", ".ods", ".dta") + ) + ), + shiny::conditionalPanel( + condition = "input.source=='redcap'", + m_redcap_readUI("redcap_import"), + DT::DTOutput(outputId = "redcap_prev") + ) + ), + shiny::br(), + shiny::actionButton(inputId = "act_start",label = "Start") + ), + ############################################################################## + ######### + ######### Data analyses panel + ######### + ############################################################################## + "analyze" = bslib::nav_panel( + title = "Data analysis", + bslib::page_navbar( + title = "", + # bslib::layout_sidebar( + # fillable = TRUE, + sidebar = bslib::sidebar( + shiny::helpText(em("Please specify relevant settings for your data, and press 'Analyse'")), + shiny::uiOutput("outcome_var"), + shiny::uiOutput("strat_var"), + shiny::conditionalPanel( + condition = "input.strat_var!='none'", + shiny::radioButtons( + inputId = "add_p", + label = "Compare strata?", + selected = "no", + inline = TRUE, + choices = list( + "No" = "no", + "Yes" = "yes" + ) + ), + shiny::helpText("Option to perform statistical comparisons between strata in baseline table.") + ), + shiny::radioButtons( + inputId = "all", + label = "Specify covariables", + inline = TRUE, selected = 2, + choiceNames = c( + "Yes", + "No" + ), + choiceValues = c(1, 2) + ), + shiny::conditionalPanel( + condition = "input.all==1", + shiny::uiOutput("include_vars") + ), + shiny::radioButtons( + inputId = "specify_factors", + label = "Specify categorical variables?", + selected = "no", + inline = TRUE, + choices = list( + "Yes" = "yes", + "No" = "no" + ) + ), + shiny::conditionalPanel( + condition = "input.specify_factors=='yes'", + shiny::uiOutput("factor_vars") + ), + bslib::input_task_button( + id = "load", + label = "Analyse", + icon = shiny::icon("pencil", lib = "glyphicon"), + label_busy = "Working...", + icon_busy = fontawesome::fa_i("arrows-rotate", + class = "fa-spin", + "aria-hidden" = "true" + ), + type = "primary", + auto_reset = TRUE + ), + shiny::helpText("If you change the parameters, press 'Analyse' again to update the tables") + # ) + ), + bslib::nav_spacer(), + bslib::nav_panel( + title = "Data overview", + DT::DTOutput(outputId = "data_table") + ), + bslib::nav_panel( + title = "Baseline characteristics", + gt::gt_output(outputId = "table1") + ), + bslib::nav_panel( + title = "Regression table", + gt::gt_output(outputId = "table2") + ), + bslib::nav_panel( + title = "Regression checks", + shiny::plotOutput(outputId = "check") + ) + ) + ), + ############################################################################## + ######### + ######### Documentation panel + ######### + ############################################################################## + "docs" = bslib::nav_panel( + title = "Intro", + shiny::markdown(readLines("www/intro.md")), + shiny::br() + ) +) + +# cards <- list( + # "overview"=bslib::card( + # title = "Data overview", + # # shiny::uiOutput("data.classes"), + # # shiny::uiOutput("data.input"), + # # shiny::p("Classes of uploaded data"), + # # gt::gt_output("data.classes"), + # shiny::p("Subset data"), + # DT::DTOutput(outputId = "data_table") + # ), +# "baseline"=bslib::card( +# title = "Baseline characteristics", +# gt::gt_output(outputId = "table1") +# ), +# "regression"= bslib::card( +# title = "Regression table", +# gt::gt_output(outputId = "table2") +# ), +# "checks" =bslib::card( +# title = "Regression checks", +# shiny::plotOutput(outputId = "check") +# ) +# ) + +ui <- bslib::page( + title = "freesearcheR", + theme = bslib::bs_theme( + primary = "#1E4A8F", + secondary = "#FF6F61", + bootswatch = "minty", + base_font = bslib::font_google("Montserrat"), + code_font = bslib::font_google("Open Sans") + ), + bslib::page_navbar( + id = "main_panel", + ui_elements$import, + ui_elements$analyze, + ui_elements$docs + ) +) + + + + + + + +# ui <- bslib::page( +# theme = bslib::bs_theme( +# bootswatch = "minty", +# base_font = font_google("Inter"), +# code_font = font_google("JetBrains Mono") +# ), +# title = "fresearcheR - free, web-based research analyses", +# bslib::page_navbar( +# title = "fresearcheR - free, web-based research analyses", +# header = h6("Welcome to the fresearcheR tool. This is an early alpha version to act as a proof-of-concept and in no way intended for wider public use."), +# sidebar = bslib::sidebar( +# width = 300, +# open = "open", +# shiny::h4("Upload your dataset"), +# shiny::conditionalPanel( +# condition = "output.has_input=='yes'", +# # Input: Select a file ---- +# shiny::helpText("Analyses are performed on provided data") +# ), +# shiny::conditionalPanel( +# condition = "output.has_input=='no'", +# # Input: Select a file ---- +# shiny::radioButtons( +# inputId = "source", +# label = "Upload file or export from REDCap?", +# selected = "file", +# inline = TRUE, +# choices = list( +# "File" = "file", +# "REDCap" = "redcap" +# ) +# ), +# shiny::conditionalPanel( +# condition = "input.source=='file'", +# datamods::import_file_ui("file_import", +# file_extensions = c(".csv", ".txt", ".xls", ".xlsx", ".rds", ".fst", ".sas7bdat", ".sav",".ods",".dta")) +# ) +# , +# shiny::conditionalPanel( +# condition = "input.source=='redcap'", +# m_redcap_readUI("redcap_import") +# ), +# # Does not work?? +# # shiny::actionButton(inputId = "test_data", +# # label = "Load test data", class = "btn-primary") +# ), +# shiny::conditionalPanel( +# condition = "output.uploaded=='yes'", +# shiny::h4("Parameter specifications"), +# shiny::radioButtons( +# inputId = "factorize", +# label = "Factorize variables with few levels?", +# selected = "yes", +# inline = TRUE, +# choices = list( +# "Yes" = "yes", +# "No" = "no" +# ) +# ), +# shiny::radioButtons( +# inputId = "regression_auto", +# label = "Automatically choose function", +# inline = TRUE, +# choiceNames = c( +# "Yes", +# "No" +# ), +# choiceValues = c(1, 2) +# ), +# shiny::conditionalPanel( +# condition = "input.regression_auto==2", +# shiny::textInput( +# inputId = "regression_formula", +# label = "Formula string to render with 'glue::glue'", +# value = NULL +# ), +# shiny::textInput( +# inputId = "regression_fun", +# label = "Function to use for analysis (needs pasckage and name)", +# value = "stats::lm" +# ), +# shiny::textInput( +# inputId = "regression_args", +# label = "Arguments to pass to the function (provided as a string)", +# value = "" +# ) +# ), +# shiny::helpText(em("Please specify relevant settings for your data, and press 'Analyse'")), +# shiny::uiOutput("outcome_var"), +# shiny::uiOutput("strat_var"), +# shiny::conditionalPanel( +# condition = "input.strat_var!='none'", +# shiny::radioButtons( +# inputId = "add_p", +# label = "Compare strata?", +# selected = "no", +# inline = TRUE, +# choices = list( +# "No" = "no", +# "Yes" = "yes" +# ) +# ), +# shiny::helpText("Option to perform statistical comparisons between strata in baseline table.") +# ), +# shiny::radioButtons( +# inputId = "all", +# label = "Specify covariables", +# inline = TRUE, selected = 2, +# choiceNames = c( +# "Yes", +# "No" +# ), +# choiceValues = c(1, 2) +# ), +# shiny::conditionalPanel( +# condition = "input.all==1", +# shiny::uiOutput("include_vars") +# ), +# shiny::radioButtons( +# inputId = "specify_factors", +# label = "Specify categorical variables?", +# selected = "no", +# inline = TRUE, +# choices = list( +# "Yes" = "yes", +# "No" = "no" +# ) +# ), +# shiny::conditionalPanel( +# condition = "input.specify_factors=='yes'", +# shiny::uiOutput("factor_vars") +# ), +# bslib::input_task_button( +# id = "load", +# label = "Analyse", +# icon = shiny::icon("pencil", lib = "glyphicon"), +# label_busy = "Working...", +# icon_busy = fontawesome::fa_i("arrows-rotate", +# class = "fa-spin", +# "aria-hidden" = "true" +# ), +# type = "primary", +# auto_reset = TRUE +# ), +# shiny::helpText("If you change the parameters, press 'Analyse' again to update the tables"), +# # shiny::actionButton("load", "Analyse", class = "btn-primary"), +# # +# # # Horizontal line ---- +# tags$hr(), +# shiny::conditionalPanel( +# condition = "input.load", +# h4("Download results"), +# shiny::helpText("Choose your favourite output file format for further work."), +# shiny::selectInput( +# inputId = "output_type", +# label = "Choose your desired output format", +# selected = NULL, +# choices = list( +# "Word" = "docx", +# "LibreOffice" = "odt" +# # , +# # "PDF" = "pdf", +# # "All the above" = "all" +# ) +# ), +# +# # Button +# downloadButton( +# outputId = "report", +# label = "Download", +# icon = shiny::icon("download") +# ) +# ) +# ) +# ), +# bslib::nav_spacer(), +# panels[[1]], +# panels[[2]], +# panels[[3]], +# panels[[4]] +# +# # layout_columns( +# # cards[[1]] +# # ), +# # layout_columns( +# # cards[[2]], cards[[3]] +# # ) +# ) +# ) diff --git a/inst/apps/data_analysis_modules/www/intro.md b/inst/apps/data_analysis_modules/www/intro.md new file mode 100644 index 0000000..329b5e5 --- /dev/null +++ b/inst/apps/data_analysis_modules/www/intro.md @@ -0,0 +1,3 @@ +# Intro to webResearch/freesearcheR/VOICE + +This is just placeholder text. diff --git a/inst/apps/data_analysis_modules/www/report.qmd b/inst/apps/data_analysis_modules/www/report.qmd new file mode 100644 index 0000000..51e3faa --- /dev/null +++ b/inst/apps/data_analysis_modules/www/report.qmd @@ -0,0 +1,68 @@ +--- +format: + html: + embed-resources: true +title: "webResearch analysis results" +date: today +author: webResearch Tool +toc: true +execute: + echo: false +params: + data.file: NA +--- + +```{r setup} +web_data <- readr::read_rds(file = params$data.file) +library(gtsummary) +library(gt) +library(easystats) +library(patchwork) +# library(webResearch) +``` + +## Introduction + +Research should be free and open with easy access for all. The webResearch tool attempts to help lower the bar to participate in contributing to science. + +## Methods + +Analyses were conducted in R version `r paste(version["major"],version["minor"],sep=".")`. + +## Results + +Below is the baseline characteristics plotted. + +```{r} +#| label: tbl-baseline +#| tbl-cap: Baseline characteristics of included data +web_data$table1 +``` + +Here are the regression results. + +```{r} +#| label: tbl-regression +#| tbl-cap: Regression analysis results +web_data$table2 +``` + +## Discussion + +Good luck on your further work! + +## Sensitivity + +Here are the results from testing the regression model: + + +```{r} +#| label: tbl-checks +#| fig-cap: Regression analysis checks +#| fig-height: 8 +#| fig-width: 6 +#| fig-dpi: 600 + +plot(web_data$check) + +``` diff --git a/inst/apps/redcap_module/rc_modules.R b/inst/apps/redcap_module/rc_modules.R deleted file mode 100644 index f56cf9f..0000000 --- a/inst/apps/redcap_module/rc_modules.R +++ /dev/null @@ -1,103 +0,0 @@ -m_redcap_readUI <- function(id) { - ns <- NS(id) - tagList( - shiny::textInput( - inputId = "uri", - label = "URI", - value = "https://redcap.your.institution/api/" - ), - shiny::textInput( - inputId = "api", - label = "API token", - value = "" - ), - shiny::tableOutput(outputId = ns("table")), - shiny::uiOutput(outputId = ns("fields")), - shiny::uiOutput(outputId = ns("instruments")), - shiny::uiOutput(outputId = ns("arms")), - shiny::actionButton(inputId = ns("submit"), "Submit") - ) -} - -m_redcap_readServer <- function(id) { - ns <- NS(id) - moduleServer( - id, - function(input, output, session) { - ns <- NS(id) - instr <- shiny::reactive({ - shiny::req(input$api) - shiny::req(input$uri) - REDCapR::redcap_instruments(redcap_uri = input$uri, token = input$api) - }) - - output$instruments <- shiny::renderUI({ - shiny::selectizeInput( - inputId = ns("instruments"), - selected = NULL, - label = "Instruments to include", - choices = instr()[["data"]][[1]], - multiple = TRUE - ) - }) - - dd <- shiny::reactive({ - shiny::req(input$api) - shiny::req(input$uri) - REDCapR::redcap_metadata_read(redcap_uri = input$uri, token = input$api) - }) - - output$fields <- shiny::renderUI({ - shiny::selectizeInput( - inputId = ns("fields"), - selected = NULL, - label = "Fields/variables to include", - choices = dd()[["data"]][[1]], - multiple = TRUE - ) - }) - - arms <- shiny::reactive({ - shiny::req(input$api) - shiny::req(input$uri) - REDCapR::redcap_event_read(redcap_uri = input$uri, token = input$api) - }) - - output$arms <- shiny::renderUI({ - shiny::selectizeInput( - inputId = ns("arms"), - selected = NULL, - label = "Arms/events to include", - choices = arms()[["data"]][[3]], - multiple = TRUE - ) - }) - - output$table <- shiny::renderTable({ - dd()[["data"]] - }) - - shiny::eventReactive(input$submit, { - shiny::req(input$api) - data <- REDCapCAST::read_redcap_tables( - uri=input$uri, - token = input$api, - fields = unique(c(dd()[["data"]][[1]][1],input$fields)), - forms = input$instruments, - events = input$arms, - raw_or_label = "both" - ) - - info <- REDCapR::redcap_project_info_read(redcap_uri = input$uri, token = input$api) - filename <- info$data$project_title - - data |> - REDCapCAST::redcap_wider() |> - REDCapCAST::suffix2label() |> - REDCapCAST::as_factor() |> - dplyr::select(-dplyr::ends_with("_complete")) |> - dplyr::select(-dplyr::any_of(dd()[["data"]][[1]][1])) - }) - } - ) -} diff --git a/inst/apps/redcap_module/server.R b/inst/apps/redcap_module/server.R deleted file mode 100644 index 71f8bd5..0000000 --- a/inst/apps/redcap_module/server.R +++ /dev/null @@ -1,91 +0,0 @@ -library(REDCapCAST) -library(REDCapR) -library(shiny) - -# ns <- shiny::NS(id) - - - - -server <- function(input, output, session) { - # ns <- NS(id) - - instr <- shiny::reactive({ - shiny::req(input$api) - shiny::req(input$uri) - REDCapR::redcap_instruments(redcap_uri = input$uri, token = input$api) - }) - - output$instruments <- shiny::renderUI({ - shiny::selectizeInput( - inputId = "instruments", - selected = NULL, - label = "Instruments to include", - choices = instr()[["data"]][[1]], - multiple = TRUE - ) - }) - - dd <- shiny::reactive({ - shiny::req(input$api) - shiny::req(input$uri) - REDCapR::redcap_metadata_read(redcap_uri = input$uri, token = input$api) - }) - - output$fields <- shiny::renderUI({ - shiny::selectizeInput( - inputId = "fields", - selected = NULL, - label = "Fields/variables to include", - choices = dd()[["data"]][[1]], - multiple = TRUE - ) - }) - - arms <- shiny::reactive({ - shiny::req(input$api) - shiny::req(input$uri) - REDCapR::redcap_event_read(redcap_uri = input$uri, token = input$api) - }) - - output$arms <- shiny::renderUI({ - shiny::selectizeInput( - inputId = "arms", - selected = NULL, - label = "Arms/events to include", - choices = arms()[["data"]][[3]], - multiple = TRUE - ) - }) - - output$table <- shiny::renderTable({ - dd()[["data"]] - }) - - data <- shiny::eventReactive(input$submit, { - browser() - shiny::req(input$api) - data <- REDCapCAST::read_redcap_tables( - uri = input$uri, - token = input$api, - fields = unique(c(dd()[["data"]][[1]][1], input$fields)), - forms = input$instruments, - events = input$arms, - raw_or_label = "both" - ) - - info <- REDCapR::redcap_project_info_read(redcap_uri = input$uri, token = input$api) - filename <- info$data$project_title - - data |> - REDCapCAST::redcap_wider() |> - REDCapCAST::suffix2label() |> - REDCapCAST::as_factor() |> - dplyr::select(-dplyr::ends_with("_complete")) |> - dplyr::select(-dplyr::any_of(dd()[["data"]][[1]][1])) - }) - - output$export <- DT::renderDT({ - data() - }) -} diff --git a/inst/apps/redcap_module/ui.R b/inst/apps/redcap_module/ui.R deleted file mode 100644 index a79a8f1..0000000 --- a/inst/apps/redcap_module/ui.R +++ /dev/null @@ -1,23 +0,0 @@ -library(REDCapCAST) -library(REDCapR) -library(shiny) - -ui <- shiny::fluidPage( - # shiny::helpText("Submit URL and API token to browse download options"), - shiny::textInput( - inputId = "uri", - label = "URI", - value = "https://redcap.your.institution/api/" - ), - shiny::textInput( - inputId = "api", - label = "API token", - value = "" - ), - shiny::tableOutput("table"), - shiny::uiOutput("fields"), - shiny::uiOutput("instruments"), - shiny::uiOutput("arms"), - shiny::actionButton("submit", "Submit"), - DT::DTOutput("export") -) diff --git a/inst/apps/teal_test/app.R b/inst/apps/teal_test/app.R index 445c803..344a631 100644 --- a/inst/apps/teal_test/app.R +++ b/inst/apps/teal_test/app.R @@ -31,43 +31,21 @@ if (file.exists(here::here("functions.R"))) { source(here::here("functions.R")) } -data_upload <- teal_data_module( - ui <- function(id) { - ns <- NS(id) - shiny::fluidPage( - shiny::radioButtons( - inputId = "import", - label = "Specify categorical variables?", - selected = "no", - inline = TRUE, - choices = list( - "Upload file" = "file", - "Export from REDCap" = "redcap" - ) - ), - shiny::conditionalPanel( - condition = "input.import=='file'", - m_datafileUI(id) - ), - shiny::conditionalPanel( - condition = "input.import=='redcap'", - m_redcap_readUI(id) - ) - ) - }, - server = function(id) { - ns <- NS(id) - moduleServer(id, function(input, output, session) { - shiny::reactive({ - if (input$import == "file") { - m_datafileServer(id, output.format = "teal") - } else { - m_redcap_readServer(id, output.format = "teal") - } - }) - }) - } -) +## This setup works for a single possible source +## The UI will work, even with server dependent selection and REDCap exports, +## but when submitting, it only works for the module mentioned first in the server function +## Also most data formatting is lost when passing to a teal_data_object. Bummer! +## +## FRUSTRATION!! +## +## As I read this, two different apps has to be created as things are now: one for upload, one for REDCap. +## https://insightsengineering.github.io/teal/latest-tag/articles/data-as-shiny-module.html#warning +## +## +## +## Ad option to widen data or keep long (new function, would allow easy(ish) MMRM analyses) + + tm_variable_browser_module <- tm_variable_browser( label = "Variable browser", @@ -76,7 +54,6 @@ tm_variable_browser_module <- tm_variable_browser( ) ) - filters <- teal::teal_slices() app_source <- "https://github.com/agdamsbo/webresearch" @@ -84,7 +61,7 @@ gh_issues_page <- "https://github.com/agdamsbo/webresearch/issues" header <- tags$span( style = "display: flex; align-items: center; justify-content: space-between; margin: 10px 0 10px 0;", - tags$span("webResearch (teal)", style = "font-size: 30px;") # , + tags$span("REDCap data evaluation", style = "font-size: 30px;") # , # tags$span( # style = "display: flex; align-items: center;", # tags$img(src = nest_logo, alt = "NEST logo", height = "45px", style = "margin-right:10px;"), @@ -93,19 +70,40 @@ header <- tags$span( ) footer <- tags$p( - "This teal app was developed by AGDamsbo using the {teal} framework for Shiny apps:", + "This is a simple, app for REDCap-based data browsing and evaluation. Data is only stored temporarily and deleted when the browser is refreshed or closed. The app was developed by AGDamsbo using the {teal} framework for building Shiny apps:", tags$a(href = app_source, target = "_blank", "Source Code"), ", ", tags$a(href = gh_issues_page, target = "_blank", "Report Issues") ) -app <- init( - data = data_upload, +# teal_init <- function(data = tdm_redcap_read, +# filter = filters, +# modules = teal::modules( +# teal.modules.general::tm_data_table("Data Table"), +# tm_variable_browser_module +# ), +# title = teal::build_app_title("REDCap browser (teal)"), +# header = header, +# footer = footer, ...) { +# teal::init(data, +# filter, +# modules, +# title, +# header, +# footer, +# ... +# ) +# } +# +# redcap_browser_app <- teal_init(data = tdm_data_upload) + +app <- teal::init( + data = tdm_redcap_read, filter = filters, modules = modules( tm_data_table("Data Table"), tm_variable_browser_module ), - title = build_app_title("webResearch (teal)"), + title = build_app_title("REDCap data evaluation"), header = header, footer = footer ) diff --git a/man/redcap_read_shiny_module.Rd b/man/redcap_read_shiny_module.Rd new file mode 100644 index 0000000..3456743 --- /dev/null +++ b/man/redcap_read_shiny_module.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/modules.R +\name{m_redcap_readUI} +\alias{m_redcap_readUI} +\alias{m_redcap_readServer} +\title{Shiny module to browser and export REDCap data} +\usage{ +m_redcap_readUI(id) + +m_redcap_readServer(id, output.format = "df") +} +\arguments{ +\item{id}{Namespace id} + +\item{output.format}{data.frame ("df") or teal data object ("teal")} +} +\value{ +shiny ui element + +shiny server module +} +\description{ +Shiny module to browser and export REDCap data +}