mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2025-09-12 09:59:39 +02:00
a bit of trial and error. not completely satisfied with readcap_read-module yet
This commit is contained in:
parent
a5c0a01d8a
commit
00eb49c225
16 changed files with 1188 additions and 385 deletions
|
|
@ -39,7 +39,9 @@ Imports:
|
|||
DHARMa,
|
||||
teal,
|
||||
IDEAFilter,
|
||||
sparkline
|
||||
sparkline,
|
||||
datamods,
|
||||
toastui
|
||||
Suggests:
|
||||
styler,
|
||||
devtools,
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
19
R/helpers.R
19
R/helpers.R
|
|
@ -30,7 +30,6 @@ getfun <- function(x) {
|
|||
#' @export
|
||||
#'
|
||||
write_quarto <- function(data, ...) {
|
||||
|
||||
# Exports data to temporary location
|
||||
#
|
||||
# I assume this is more secure than putting it in the www folder and deleting
|
||||
|
|
@ -41,7 +40,8 @@ write_quarto <- function(data,...){
|
|||
## 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),
|
||||
...
|
||||
)
|
||||
}
|
||||
|
|
@ -128,7 +128,7 @@ dummy_Imports <- function() {
|
|||
}
|
||||
|
||||
|
||||
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)
|
||||
|
|
@ -137,7 +137,11 @@ file_export <- function(data,output.format=c("df","teal"),filename){
|
|||
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
|
||||
|
|
@ -146,6 +150,13 @@ file_export <- function(data,output.format=c("df","teal"),filename){
|
|||
datanames(out) <- filename
|
||||
} else if (output.format == "df") {
|
||||
out <- data
|
||||
} else if (output.format == "list") {
|
||||
out <- list(
|
||||
data = data,
|
||||
name = filename
|
||||
)
|
||||
|
||||
out <- c(out,...)
|
||||
}
|
||||
|
||||
out
|
||||
|
|
|
|||
264
R/modules.R
264
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,21 +63,34 @@ 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(
|
||||
|
||||
server_ui <- fluidRow(
|
||||
column(
|
||||
width = 6,
|
||||
shiny::textInput(
|
||||
inputId = ns("uri"),
|
||||
label = "URI",
|
||||
|
|
@ -88,59 +100,101 @@ m_redcap_readUI <- function(id) {
|
|||
inputId = ns("api"),
|
||||
label = "API token",
|
||||
value = ""
|
||||
),
|
||||
shiny::tableOutput(outputId = ns("table")),
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
params_ui <- fluidRow(
|
||||
column(
|
||||
width = 6,
|
||||
shiny::uiOutput(outputId = ns("fields")),
|
||||
shiny::uiOutput(outputId = ns("instruments")),
|
||||
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::actionButton(inputId = ns("submit"), "Submit")
|
||||
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({
|
||||
shiny::req(input$api)
|
||||
shiny::req(input$uri)
|
||||
REDCapR::redcap_instruments(redcap_uri = input$uri, token = input$api)
|
||||
})
|
||||
#' @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)
|
||||
|
||||
output$instruments <- shiny::renderUI({
|
||||
shiny::selectizeInput(
|
||||
inputId = ns("instruments"),
|
||||
# inputId = "instruments",
|
||||
selected = NULL,
|
||||
label = "Instruments to include",
|
||||
choices = instr()[["data"]][[1]],
|
||||
multiple = TRUE
|
||||
)
|
||||
})
|
||||
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)
|
||||
})
|
||||
|
||||
output$fields <- shiny::renderUI({
|
||||
shiny::selectizeInput(
|
||||
# inputId = "fields",
|
||||
inputId = ns("fields"),
|
||||
selected = NULL,
|
||||
label = "Fields/variables to include",
|
||||
choices = dd()[["data"]][[1]],
|
||||
multiple = TRUE
|
||||
)
|
||||
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)
|
||||
|
||||
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({
|
||||
|
|
@ -148,41 +202,123 @@ m_redcap_readServer <- function(id, output.format="df") {
|
|||
# inputId = "arms",
|
||||
inputId = ns("arms"),
|
||||
selected = NULL,
|
||||
label = "Arms/events to include",
|
||||
choices = arms()[["data"]][[3]],
|
||||
label = "Filter by events/arms",
|
||||
choices = arms()[[3]],
|
||||
multiple = TRUE
|
||||
)
|
||||
})
|
||||
|
||||
output$table <- shiny::renderTable({
|
||||
dd()[["data"]]
|
||||
output$table <- DT::renderDT(
|
||||
{
|
||||
shiny::req(input$api)
|
||||
shiny::req(input$uri)
|
||||
# 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
|
||||
)
|
||||
|
||||
name <- reactive({
|
||||
shiny::req(input$api)
|
||||
REDCapR::redcap_project_info_read(
|
||||
redcap_uri = input$uri,
|
||||
token = input$api
|
||||
)$data$project_title
|
||||
})
|
||||
|
||||
shiny::eventReactive(input$submit, {
|
||||
shiny::eventReactive(input$import, {
|
||||
shiny::req(input$api)
|
||||
data <- REDCapCAST::read_redcap_tables(
|
||||
record_id <- dd()[[1]][1]
|
||||
|
||||
redcap_data <- REDCapCAST::read_redcap_tables(
|
||||
uri = input$uri,
|
||||
token = input$api,
|
||||
fields = unique(c(dd()[["data"]][[1]][1], input$fields)),
|
||||
forms = input$instruments,
|
||||
fields = unique(c(record_id, 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 |>
|
||||
raw_or_label = "both",
|
||||
filter_logic = input$filter
|
||||
) |>
|
||||
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(
|
||||
dplyr::select(-dplyr::any_of(record_id)) |>
|
||||
REDCapCAST::suffix2label()
|
||||
|
||||
out_object <- file_export(redcap_data,
|
||||
output.format = output.format,
|
||||
filename = info$data$project_title
|
||||
filename = name()
|
||||
)
|
||||
|
||||
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()
|
||||
|
|
|
|||
|
|
@ -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) {
|
||||
## 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)
|
||||
}
|
||||
)
|
||||
|
|
|
|||
|
|
@ -28,7 +28,6 @@ panels <- list(
|
|||
)
|
||||
)
|
||||
|
||||
|
||||
ui <- bslib::page(
|
||||
theme = bslib::bs_theme(
|
||||
bootswatch = "minty",
|
||||
|
|
|
|||
|
|
@ -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
|
||||
352
inst/apps/data_analysis_modules/server.R
Normal file
352
inst/apps/data_analysis_modules/server.R
Normal file
|
|
@ -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"))
|
||||
})
|
||||
})
|
||||
}
|
||||
412
inst/apps/data_analysis_modules/ui.R
Normal file
412
inst/apps/data_analysis_modules/ui.R
Normal file
|
|
@ -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]]
|
||||
# # )
|
||||
# )
|
||||
# )
|
||||
3
inst/apps/data_analysis_modules/www/intro.md
Normal file
3
inst/apps/data_analysis_modules/www/intro.md
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
# Intro to webResearch/freesearcheR/VOICE
|
||||
|
||||
This is just placeholder text.
|
||||
68
inst/apps/data_analysis_modules/www/report.qmd
Normal file
68
inst/apps/data_analysis_modules/www/report.qmd
Normal file
|
|
@ -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)
|
||||
|
||||
```
|
||||
|
|
@ -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]))
|
||||
})
|
||||
}
|
||||
)
|
||||
}
|
||||
|
|
@ -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()
|
||||
})
|
||||
}
|
||||
|
|
@ -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")
|
||||
)
|
||||
|
|
@ -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
|
||||
)
|
||||
|
|
|
|||
24
man/redcap_read_shiny_module.Rd
Normal file
24
man/redcap_read_shiny_module.Rd
Normal file
|
|
@ -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
|
||||
}
|
||||
Loading…
Add table
Reference in a new issue