mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2026-06-19 12:37:30 +02:00
renaming
This commit is contained in:
parent
68c93d94e4
commit
04784a7a24
34 changed files with 121 additions and 137 deletions
8285
inst/apps/FreesearchR/app.R
Normal file
8285
inst/apps/FreesearchR/app.R
Normal file
File diff suppressed because it is too large
Load diff
1
inst/apps/FreesearchR/launch.R
Normal file
1
inst/apps/FreesearchR/launch.R
Normal file
|
|
@ -0,0 +1 @@
|
|||
shinyApp(ui, server)
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
name: freesearcheR
|
||||
title:
|
||||
username: agdamsbo
|
||||
account: agdamsbo
|
||||
server: shinyapps.io
|
||||
hostUrl: https://api.shinyapps.io/v1
|
||||
appId: 13611288
|
||||
bundleId: 9961770
|
||||
url: https://agdamsbo.shinyapps.io/freesearcheR/
|
||||
version: 1
|
||||
|
|
@ -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
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
name: freesearcheR_dev
|
||||
title:
|
||||
username: cognitiveindex
|
||||
account: cognitiveindex
|
||||
server: shinyapps.io
|
||||
hostUrl: https://api.shinyapps.io/v1
|
||||
appId: 13786206
|
||||
bundleId: 9688582
|
||||
url: https://cognitiveindex.shinyapps.io/freesearcheR_dev/
|
||||
version: 1
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
name: freesearcheR_extra
|
||||
title:
|
||||
username: cognitiveindex
|
||||
account: cognitiveindex
|
||||
server: shinyapps.io
|
||||
hostUrl: https://api.shinyapps.io/v1
|
||||
appId: 13622743
|
||||
bundleId: 9544828
|
||||
url: https://cognitiveindex.shinyapps.io/freesearcheR_extra/
|
||||
version: 1
|
||||
976
inst/apps/FreesearchR/server.R
Normal file
976
inst/apps/FreesearchR/server.R
Normal file
|
|
@ -0,0 +1,976 @@
|
|||
library(readr)
|
||||
library(MASS)
|
||||
library(stats)
|
||||
library(gt)
|
||||
library(openxlsx2)
|
||||
library(haven)
|
||||
library(readODS)
|
||||
require(shiny)
|
||||
library(bslib)
|
||||
library(assertthat)
|
||||
library(dplyr)
|
||||
library(quarto)
|
||||
library(here)
|
||||
library(broom)
|
||||
library(broom.helpers)
|
||||
# library(REDCapCAST)
|
||||
library(easystats)
|
||||
library(esquisse)
|
||||
library(patchwork)
|
||||
library(DHARMa)
|
||||
library(apexcharter)
|
||||
library(toastui)
|
||||
library(datamods)
|
||||
library(data.table)
|
||||
library(IDEAFilter)
|
||||
library(shinyWidgets)
|
||||
library(DT)
|
||||
library(gtsummary)
|
||||
# library(freesearcheR)
|
||||
|
||||
# source("functions.R")
|
||||
|
||||
data(mtcars)
|
||||
trial <- gtsummary::trial |> default_parsing()
|
||||
|
||||
# light <- custom_theme()
|
||||
#
|
||||
# dark <- custom_theme(bg = "#000",fg="#fff")
|
||||
|
||||
|
||||
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/")
|
||||
|
||||
output$docs_file <- shiny::renderUI({
|
||||
# shiny::includeHTML("www/docs.html")
|
||||
shiny::HTML(readLines("www/docs.html"))
|
||||
})
|
||||
|
||||
##############################################################################
|
||||
#########
|
||||
######### Night mode (just very popular, not really needed)
|
||||
#########
|
||||
##############################################################################
|
||||
|
||||
# observeEvent(input$dark_mode,{
|
||||
# session$setCurrentTheme(
|
||||
# if (isTRUE(input$dark_mode)) dark else light
|
||||
# )})
|
||||
|
||||
# observe({
|
||||
# if(input$dark_mode==TRUE)
|
||||
# session$setCurrentTheme(bs_theme_update(theme = custom_theme(version = 5)))
|
||||
# if(input$dark_mode==FALSE)
|
||||
# session$setCurrentTheme(bs_theme_update(theme = custom_theme(version = 5, bg = "#000",fg="#fff")))
|
||||
# })
|
||||
|
||||
|
||||
##############################################################################
|
||||
#########
|
||||
######### Setting reactive values
|
||||
#########
|
||||
##############################################################################
|
||||
|
||||
rv <- shiny::reactiveValues(
|
||||
list = list(),
|
||||
ds = NULL,
|
||||
local_temp = NULL,
|
||||
ready = NULL,
|
||||
test = "no",
|
||||
data_original = NULL,
|
||||
data_temp = NULL,
|
||||
data = NULL,
|
||||
data_filtered = NULL,
|
||||
models = NULL,
|
||||
code = list()
|
||||
)
|
||||
|
||||
##############################################################################
|
||||
#########
|
||||
######### Data import section
|
||||
#########
|
||||
##############################################################################
|
||||
|
||||
data_file <- import_file_server(
|
||||
id = "file_import",
|
||||
show_data_in = "popup",
|
||||
trigger_return = "change",
|
||||
return_class = "data.frame"
|
||||
)
|
||||
|
||||
shiny::observeEvent(data_file$data(), {
|
||||
shiny::req(data_file$data())
|
||||
rv$data_temp <- data_file$data()
|
||||
rv$code <- append_list(data = data_file$code(), list = rv$code, index = "import")
|
||||
})
|
||||
|
||||
from_redcap <- m_redcap_readServer(
|
||||
id = "redcap_import"
|
||||
)
|
||||
|
||||
shiny::observeEvent(from_redcap$data(), {
|
||||
# rv$data_original <- purrr::pluck(data_redcap(), "data")()
|
||||
rv$data_temp <- from_redcap$data()
|
||||
rv$code <- append_list(data = from_redcap$code(), list = rv$code, index = "import")
|
||||
})
|
||||
|
||||
output$redcap_prev <- DT::renderDT(
|
||||
{
|
||||
DT::datatable(head(from_redcap$data(), 5),
|
||||
# DT::datatable(head(purrr::pluck(data_redcap(), "data")(), 5),
|
||||
caption = "First 5 observations"
|
||||
)
|
||||
},
|
||||
server = TRUE
|
||||
)
|
||||
|
||||
from_env <- datamods::import_globalenv_server(
|
||||
id = "env",
|
||||
trigger_return = "change",
|
||||
btn_show_data = FALSE,
|
||||
reset = reactive(input$hidden)
|
||||
)
|
||||
|
||||
shiny::observeEvent(from_env$data(), {
|
||||
shiny::req(from_env$data())
|
||||
|
||||
rv$data_temp <- from_env$data()
|
||||
# rv$code <- append_list(data = from_env$code(),list = rv$code,index = "import")
|
||||
})
|
||||
|
||||
output$import_var <- shiny::renderUI({
|
||||
shiny::req(rv$data_temp)
|
||||
|
||||
preselect <- names(rv$data_temp)[sapply(rv$data_temp, missing_fraction) <= input$complete_cutoff / 100]
|
||||
|
||||
shinyWidgets::virtualSelectInput(
|
||||
inputId = "import_var",
|
||||
label = "Select variables to include",
|
||||
selected = preselect,
|
||||
choices = names(rv$data_temp),
|
||||
updateOn = "change",
|
||||
multiple = TRUE,
|
||||
search = TRUE,
|
||||
showValueAsTags = TRUE
|
||||
)
|
||||
})
|
||||
|
||||
|
||||
shiny::observeEvent(
|
||||
eventExpr = list(
|
||||
input$import_var
|
||||
),
|
||||
handlerExpr = {
|
||||
shiny::req(rv$data_temp)
|
||||
|
||||
rv$data_original <- rv$data_temp |>
|
||||
dplyr::select(input$import_var) |>
|
||||
default_parsing()
|
||||
|
||||
rv$code$import <- rv$code$import |>
|
||||
deparse() |>
|
||||
paste(collapse = "") |>
|
||||
paste("|>
|
||||
dplyr::select(", paste(input$import_var, collapse = ","), ") |>
|
||||
freesearcheR::default_parsing()") |>
|
||||
(\(.x){
|
||||
paste0("data <- ", .x)
|
||||
})()
|
||||
|
||||
rv$code$filter <- NULL
|
||||
rv$code$modify <- NULL
|
||||
}
|
||||
)
|
||||
|
||||
|
||||
shiny::observeEvent(rv$data_original, {
|
||||
if (is.null(rv$data_original) | NROW(rv$data_original) == 0) {
|
||||
shiny::updateActionButton(inputId = "act_start", disabled = TRUE)
|
||||
} else {
|
||||
shiny::updateActionButton(inputId = "act_start", disabled = FALSE)
|
||||
}
|
||||
})
|
||||
|
||||
##############################################################################
|
||||
#########
|
||||
######### Data modification section
|
||||
#########
|
||||
##############################################################################
|
||||
|
||||
shiny::observeEvent(
|
||||
eventExpr = list(
|
||||
rv$data_original,
|
||||
input$complete_cutoff
|
||||
),
|
||||
handlerExpr = {
|
||||
shiny::req(rv$data_original)
|
||||
|
||||
rv$data <- rv$data_original
|
||||
}
|
||||
)
|
||||
|
||||
## For now this solution work, but I would prefer to solve this with the above
|
||||
shiny::observeEvent(input$reset_confirm,
|
||||
{
|
||||
if (isTRUE(input$reset_confirm)) {
|
||||
shiny::req(rv$data_original)
|
||||
rv$data <- rv$data_original
|
||||
rv$code$filter <- NULL
|
||||
rv$code$modify <- NULL
|
||||
}
|
||||
},
|
||||
ignoreNULL = TRUE
|
||||
)
|
||||
|
||||
|
||||
shiny::observeEvent(input$data_reset, {
|
||||
shinyWidgets::ask_confirmation(
|
||||
cancelOnDismiss = TRUE,
|
||||
inputId = "reset_confirm",
|
||||
title = "Please confirm data reset?",
|
||||
type = "warning"
|
||||
)
|
||||
})
|
||||
|
||||
|
||||
#########
|
||||
######### Modifications
|
||||
#########
|
||||
|
||||
## Using modified version of the datamods::cut_variable_server function
|
||||
## Further modifications are needed to have cut/bin options based on class of variable
|
||||
## Could be defined server-side
|
||||
|
||||
shiny::observeEvent(
|
||||
input$modal_variables,
|
||||
modal_update_variables("modal_variables", title = "Update and select variables")
|
||||
)
|
||||
|
||||
|
||||
######### Create factor
|
||||
|
||||
shiny::observeEvent(
|
||||
input$modal_cut,
|
||||
modal_cut_variable("modal_cut", title = "Create new factor")
|
||||
)
|
||||
|
||||
data_modal_cut <- cut_variable_server(
|
||||
id = "modal_cut",
|
||||
data_r = shiny::reactive(rv$data)
|
||||
)
|
||||
|
||||
shiny::observeEvent(data_modal_cut(), {
|
||||
rv$data <- data_modal_cut()
|
||||
rv$code$modify[[length(rv$code$modify) + 1]] <- attr(rv$data, "code")
|
||||
})
|
||||
|
||||
######### Modify factor
|
||||
|
||||
shiny::observeEvent(
|
||||
input$modal_update,
|
||||
datamods::modal_update_factor(id = "modal_update", title = "Reorder factor levels")
|
||||
)
|
||||
|
||||
data_modal_update <- datamods::update_factor_server(
|
||||
id = "modal_update",
|
||||
data_r = reactive(rv$data)
|
||||
)
|
||||
|
||||
shiny::observeEvent(data_modal_update(), {
|
||||
shiny::removeModal()
|
||||
rv$data <- data_modal_update()
|
||||
rv$code$modify[[length(rv$code$modify) + 1]] <- attr(rv$data, "code")
|
||||
})
|
||||
|
||||
######### Create column
|
||||
|
||||
shiny::observeEvent(
|
||||
input$modal_column,
|
||||
datamods::modal_create_column(
|
||||
id = "modal_column",
|
||||
footer = "This window is aimed at advanced users and require some R-experience!",
|
||||
title = "Create new variables"
|
||||
)
|
||||
)
|
||||
data_modal_r <- datamods::create_column_server(
|
||||
id = "modal_column",
|
||||
data_r = reactive(rv$data)
|
||||
)
|
||||
shiny::observeEvent(
|
||||
data_modal_r(),
|
||||
{
|
||||
rv$data <- data_modal_r()
|
||||
rv$code$modify[[length(rv$code$modify) + 1]] <- attr(rv$data, "code")
|
||||
}
|
||||
)
|
||||
|
||||
######### Subset, rename, reclass
|
||||
|
||||
updated_data <- update_variables_server(
|
||||
id = "modal_variables",
|
||||
data = shiny::reactive(rv$data),
|
||||
return_data_on_init = FALSE
|
||||
)
|
||||
|
||||
shiny::observeEvent(updated_data(), {
|
||||
rv$data <- updated_data()
|
||||
rv$code$modify[[length(rv$code$modify) + 1]] <- attr(rv$data, "code")
|
||||
})
|
||||
|
||||
######### Data filter
|
||||
# IDEAFilter has the least cluttered UI, but might have a License issue
|
||||
data_filter <- IDEAFilter::IDEAFilter("data_filter",
|
||||
data = shiny::reactive(rv$data),
|
||||
verbose = TRUE
|
||||
)
|
||||
|
||||
shiny::observeEvent(
|
||||
list(
|
||||
shiny::reactive(rv$data),
|
||||
shiny::reactive(rv$data_original),
|
||||
data_filter(),
|
||||
regression_vars(),
|
||||
input$complete_cutoff
|
||||
),
|
||||
{
|
||||
### Save filtered data
|
||||
rv$data_filtered <- data_filter()
|
||||
|
||||
### Save filtered data
|
||||
rv$list$data <- data_filter() |>
|
||||
REDCapCAST::fct_drop()
|
||||
|
||||
out <- gsub(
|
||||
"filter", "dplyr::filter",
|
||||
gsub(
|
||||
"\\s{2,}", " ",
|
||||
paste0(
|
||||
capture.output(attr(rv$data_filtered, "code")),
|
||||
collapse = " "
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
out <- strsplit(out, "%>%") |>
|
||||
unlist() |>
|
||||
(\(.x){
|
||||
paste(c("data <- data", .x[-1], "REDCapCAST::fct_drop()"),
|
||||
collapse = "|> \n "
|
||||
)
|
||||
})()
|
||||
|
||||
rv$code <- append_list(data = out, list = rv$code, index = "filter")
|
||||
}
|
||||
)
|
||||
|
||||
# shiny::observeEvent(
|
||||
# list(
|
||||
# shiny::reactive(rv$data),
|
||||
# shiny::reactive(rv$data_original),
|
||||
# data_filter(),
|
||||
# shiny::reactive(rv$data_filtered)
|
||||
# ),
|
||||
# {
|
||||
#
|
||||
# }
|
||||
# )
|
||||
|
||||
######### Data preview
|
||||
|
||||
### Overview
|
||||
|
||||
data_summary_server(
|
||||
id = "data_summary",
|
||||
data = shiny::reactive({
|
||||
rv$data_filtered
|
||||
}),
|
||||
color.main = "#2A004E",
|
||||
color.sec = "#C62300",
|
||||
pagination = 20
|
||||
)
|
||||
|
||||
tryCatch(
|
||||
{
|
||||
output$table_mod <- toastui::renderDatagrid({
|
||||
shiny::req(rv$data)
|
||||
# data <- rv$data
|
||||
toastui::datagrid(
|
||||
# data = rv$data # ,
|
||||
data = data_filter(),
|
||||
pagination = 10
|
||||
# bordered = TRUE,
|
||||
# compact = TRUE,
|
||||
# striped = TRUE
|
||||
)
|
||||
})
|
||||
},
|
||||
warning = function(warn) {
|
||||
showNotification(paste0(warn), type = "warning")
|
||||
},
|
||||
error = function(err) {
|
||||
showNotification(paste0(err), type = "err")
|
||||
}
|
||||
)
|
||||
|
||||
output$original_str <- renderPrint({
|
||||
str(rv$data_original)
|
||||
})
|
||||
|
||||
output$modified_str <- renderPrint({
|
||||
str(as.data.frame(rv$data_filtered) |>
|
||||
REDCapCAST::set_attr(
|
||||
label = NULL,
|
||||
attr = "code"
|
||||
))
|
||||
})
|
||||
|
||||
|
||||
######### Code export
|
||||
output$code_import <- shiny::renderPrint({
|
||||
shiny::req(rv$code$import)
|
||||
cat(rv$code$import)
|
||||
})
|
||||
|
||||
output$code_data <- shiny::renderPrint({
|
||||
shiny::req(rv$code$modify)
|
||||
ls <- rv$code$modify |> unique()
|
||||
out <- paste("data <- data |>",
|
||||
sapply(ls, \(.x) paste(deparse(.x), collapse = ",")),
|
||||
collapse = "|>"
|
||||
) |>
|
||||
(\(.x){
|
||||
gsub(
|
||||
"\\|>", "\\|> \n",
|
||||
gsub(
|
||||
"%>%", "",
|
||||
gsub(
|
||||
"\\s{2,}", " ",
|
||||
gsub(",\\s{,},", ", ", .x)
|
||||
)
|
||||
)
|
||||
)
|
||||
})()
|
||||
cat(out)
|
||||
})
|
||||
|
||||
output$code_filter <- shiny::renderPrint({
|
||||
cat(rv$code$filter)
|
||||
})
|
||||
|
||||
##############################################################################
|
||||
#########
|
||||
######### Data analyses Inputs
|
||||
#########
|
||||
##############################################################################
|
||||
|
||||
## Keep these "old" selection options as a simple alternative to the modification pane
|
||||
|
||||
output$include_vars <- shiny::renderUI({
|
||||
shiny::selectizeInput(
|
||||
inputId = "include_vars",
|
||||
selected = NULL,
|
||||
label = "Covariables to include",
|
||||
choices = colnames(rv$data_filtered),
|
||||
multiple = TRUE
|
||||
)
|
||||
})
|
||||
|
||||
output$outcome_var <- shiny::renderUI({
|
||||
shiny::selectInput(
|
||||
inputId = "outcome_var",
|
||||
selected = NULL,
|
||||
label = "Select outcome variable",
|
||||
choices = colnames(rv$data_filtered),
|
||||
multiple = FALSE
|
||||
)
|
||||
})
|
||||
|
||||
output$regression_type <- shiny::renderUI({
|
||||
shiny::req(input$outcome_var)
|
||||
shiny::selectizeInput(
|
||||
inputId = "regression_type",
|
||||
label = "Choose regression analysis",
|
||||
## The below ifelse statement handles the case of loading a new dataset
|
||||
choices = possible_functions(
|
||||
data = dplyr::select(
|
||||
rv$data_filtered,
|
||||
ifelse(input$outcome_var %in% names(rv$data_filtered),
|
||||
input$outcome_var,
|
||||
names(rv$data_filtered)[1]
|
||||
)
|
||||
), design = "cross-sectional"
|
||||
),
|
||||
multiple = FALSE
|
||||
)
|
||||
})
|
||||
|
||||
output$factor_vars <- shiny::renderUI({
|
||||
shiny::selectizeInput(
|
||||
inputId = "factor_vars",
|
||||
selected = colnames(rv$data_filtered)[sapply(rv$data_filtered, is.factor)],
|
||||
label = "Covariables to format as categorical",
|
||||
choices = colnames(rv$data_filtered),
|
||||
multiple = TRUE
|
||||
)
|
||||
})
|
||||
|
||||
## Collected regression variables
|
||||
regression_vars <- shiny::reactive({
|
||||
if (is.null(input$include_vars)) {
|
||||
out <- colnames(rv$data_filtered)
|
||||
} else {
|
||||
out <- unique(c(input$include_vars, input$outcome_var))
|
||||
}
|
||||
return(out)
|
||||
})
|
||||
|
||||
output$strat_var <- shiny::renderUI({
|
||||
shiny::selectInput(
|
||||
inputId = "strat_var",
|
||||
selected = "none",
|
||||
label = "Select variable to stratify baseline",
|
||||
choices = c(
|
||||
"none",
|
||||
rv$data_filtered |>
|
||||
(\(.x){
|
||||
lapply(.x, \(.c){
|
||||
if (identical("factor", class(.c))) {
|
||||
.c
|
||||
}
|
||||
}) |>
|
||||
dplyr::bind_cols()
|
||||
})() |>
|
||||
colnames()
|
||||
),
|
||||
multiple = FALSE
|
||||
)
|
||||
})
|
||||
|
||||
|
||||
output$plot_model <- shiny::renderUI({
|
||||
shiny::req(rv$list$regression$tables)
|
||||
shiny::selectInput(
|
||||
inputId = "plot_model",
|
||||
selected = "none",
|
||||
label = "Select models to plot",
|
||||
choices = names(rv$list$regression$tables),
|
||||
multiple = TRUE
|
||||
)
|
||||
})
|
||||
|
||||
|
||||
##############################################################################
|
||||
#########
|
||||
######### Descriptive evaluations
|
||||
#########
|
||||
##############################################################################
|
||||
|
||||
shiny::observeEvent(
|
||||
# ignoreInit = TRUE,
|
||||
list(
|
||||
shiny::reactive(rv$list$data),
|
||||
shiny::reactive(rv$data),
|
||||
shiny::reactive(rv$data_original),
|
||||
data_filter(),
|
||||
input$strat_var,
|
||||
input$include_vars,
|
||||
input$complete_cutoff,
|
||||
input$add_p
|
||||
),
|
||||
{
|
||||
shiny::req(input$strat_var)
|
||||
shiny::req(rv$list$data)
|
||||
|
||||
if (input$strat_var == "none" | !input$strat_var %in% names(rv$list$data)) {
|
||||
by.var <- NULL
|
||||
} else {
|
||||
by.var <- input$strat_var
|
||||
}
|
||||
|
||||
rv$list$table1 <-
|
||||
rv$list$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" & !is.null(by.var)) {
|
||||
.x |>
|
||||
gtsummary::add_p() |>
|
||||
gtsummary::bold_p()
|
||||
} else {
|
||||
.x
|
||||
}
|
||||
})()
|
||||
|
||||
# gtsummary::as_kable(rv$list$table1) |>
|
||||
# readr::write_lines(file="./www/_table1.md")
|
||||
}
|
||||
)
|
||||
|
||||
output$outcome_var_cor <- shiny::renderUI({
|
||||
columnSelectInput(
|
||||
inputId = "outcome_var_cor",
|
||||
selected = "none",
|
||||
data = rv$list$data,
|
||||
label = "Select outcome variable",
|
||||
col_subset = c(
|
||||
"none",
|
||||
colnames(rv$list$data)
|
||||
),
|
||||
multiple = FALSE
|
||||
)
|
||||
})
|
||||
|
||||
output$table1 <- gt::render_gt({
|
||||
shiny::req(rv$list$table1)
|
||||
|
||||
rv$list$table1 |>
|
||||
gtsummary::as_gt() |>
|
||||
gt::tab_header(gt::md("**Table 1: Baseline Characteristics**"))
|
||||
})
|
||||
|
||||
data_correlations_server(
|
||||
id = "correlations",
|
||||
data = shiny::reactive({
|
||||
shiny::req(rv$list$data)
|
||||
out <- rv$list$data
|
||||
if (!is.null(input$outcome_var_cor) && input$outcome_var_cor != "none") {
|
||||
out <- out[!names(out) %in% input$outcome_var_cor]
|
||||
}
|
||||
out
|
||||
}),
|
||||
cutoff = shiny::reactive(input$cor_cutoff)
|
||||
)
|
||||
|
||||
##############################################################################
|
||||
#########
|
||||
######### Data visuals
|
||||
#########
|
||||
##############################################################################
|
||||
|
||||
pl <- data_visuals_server("visuals", data = shiny::reactive(rv$data))
|
||||
|
||||
##############################################################################
|
||||
#########
|
||||
######### Regression model analyses
|
||||
#########
|
||||
##############################################################################
|
||||
|
||||
shiny::observeEvent(
|
||||
input$load,
|
||||
{
|
||||
shiny::req(input$outcome_var)
|
||||
# browser()
|
||||
# Assumes all character variables can be formatted as factors
|
||||
# data <- data_filter$filtered() |>
|
||||
tryCatch(
|
||||
{
|
||||
## Which models to create should be decided by input
|
||||
## Could also include
|
||||
## imputed or
|
||||
## minimally adjusted
|
||||
model_lists <- list(
|
||||
"Univariable" = regression_model_uv_list,
|
||||
"Multivariable" = regression_model_list
|
||||
) |>
|
||||
lapply(\(.fun){
|
||||
ls <- do.call(
|
||||
.fun,
|
||||
c(
|
||||
list(data = rv$list$data |>
|
||||
(\(.x){
|
||||
.x[regression_vars()]
|
||||
})()),
|
||||
list(outcome.str = input$outcome_var),
|
||||
list(fun.descr = input$regression_type)
|
||||
)
|
||||
)
|
||||
})
|
||||
|
||||
# browser()
|
||||
|
||||
rv$list$regression$params <- get_fun_options(input$regression_type) |>
|
||||
(\(.x){
|
||||
.x[[1]]
|
||||
})()
|
||||
|
||||
rv$list$regression$models <- model_lists
|
||||
|
||||
# names(rv$list$regression)
|
||||
|
||||
# rv$models <- lapply(model_lists, \(.x){
|
||||
# .x$model
|
||||
# })
|
||||
},
|
||||
warning = function(warn) {
|
||||
showNotification(paste0(warn), type = "warning")
|
||||
},
|
||||
error = function(err) {
|
||||
showNotification(paste0("Creating regression models failed with the following error: ", err), type = "err")
|
||||
}
|
||||
)
|
||||
}
|
||||
)
|
||||
|
||||
shiny::observeEvent(
|
||||
ignoreInit = TRUE,
|
||||
list(
|
||||
rv$list$regression$models
|
||||
),
|
||||
{
|
||||
shiny::req(rv$list$regression$models)
|
||||
tryCatch(
|
||||
{
|
||||
rv$check <- lapply(rv$list$regression$models, \(.x){
|
||||
.x$model
|
||||
}) |>
|
||||
purrr::pluck("Multivariable") |>
|
||||
performance::check_model()
|
||||
},
|
||||
warning = function(warn) {
|
||||
showNotification(paste0(warn), type = "warning")
|
||||
},
|
||||
error = function(err) {
|
||||
showNotification(paste0("Running model assumptions checks failed with the following error: ", err), type = "err")
|
||||
}
|
||||
)
|
||||
}
|
||||
)
|
||||
|
||||
output$check <- shiny::renderPlot(
|
||||
{
|
||||
shiny::req(rv$check)
|
||||
# browser()
|
||||
# p <- plot(rv$check) +
|
||||
# patchwork::plot_annotation(title = "Multivariable regression model checks")
|
||||
|
||||
p <- plot(rv$check) +
|
||||
patchwork::plot_annotation(title = "Multivariable regression model checks")
|
||||
|
||||
for (i in seq_len(length(p))) {
|
||||
p[[i]] <- p[[i]] + gg_theme_shiny()
|
||||
}
|
||||
|
||||
p
|
||||
|
||||
# p + patchwork::plot_layout(ncol = 1, design = ggplot2::waiver())
|
||||
|
||||
# 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')
|
||||
},
|
||||
height = 600,
|
||||
alt = "Assumptions testing of the multivariable regression model"
|
||||
)
|
||||
|
||||
|
||||
shiny::observeEvent(
|
||||
input$load,
|
||||
{
|
||||
shiny::req(rv$list$regression$models)
|
||||
tryCatch(
|
||||
{
|
||||
out <- lapply(rv$list$regression$models, \(.x){
|
||||
.x$model
|
||||
}) |>
|
||||
purrr::map(regression_table)
|
||||
|
||||
if (input$add_regression_p == "no") {
|
||||
out <- out |>
|
||||
lapply(\(.x){
|
||||
.x |>
|
||||
gtsummary::modify_column_hide(
|
||||
column = "p.value"
|
||||
)
|
||||
})
|
||||
}
|
||||
|
||||
rv$list$regression$tables <- out
|
||||
|
||||
# rv$list$regression$table <- out |>
|
||||
# tbl_merge()
|
||||
|
||||
# gtsummary::as_kable(rv$list$regression$table) |>
|
||||
# readr::write_lines(file="./www/_regression_table.md")
|
||||
|
||||
rv$list$input <- input
|
||||
},
|
||||
warning = function(warn) {
|
||||
showNotification(paste0(warn), type = "warning")
|
||||
},
|
||||
error = function(err) {
|
||||
showNotification(paste0("Creating a regression table failed with the following error: ", err), type = "err")
|
||||
}
|
||||
)
|
||||
rv$ready <- "ready"
|
||||
}
|
||||
)
|
||||
|
||||
output$table2 <- gt::render_gt({
|
||||
shiny::req(rv$list$regression$tables)
|
||||
rv$list$regression$tables |>
|
||||
tbl_merge() |>
|
||||
gtsummary::as_gt() |>
|
||||
gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$params$descr}**")))
|
||||
})
|
||||
|
||||
output$regression_plot <- shiny::renderPlot(
|
||||
{
|
||||
# shiny::req(rv$list$regression$plot)
|
||||
shiny::req(input$plot_model)
|
||||
|
||||
out <- merge_long(rv$list$regression, input$plot_model) |>
|
||||
plot.tbl_regression(
|
||||
colour = "variable",
|
||||
facet_col = "model"
|
||||
)
|
||||
|
||||
out +
|
||||
ggplot2::scale_y_discrete(labels = scales::label_wrap(15)) +
|
||||
gg_theme_shiny()
|
||||
|
||||
# rv$list$regression$tables$Multivariable |>
|
||||
# plot(colour = "variable") +
|
||||
# ggplot2::scale_y_discrete(labels = scales::label_wrap(15)) +
|
||||
# gg_theme_shiny()
|
||||
},
|
||||
height = 500,
|
||||
alt = "Regression coefficient plot"
|
||||
)
|
||||
|
||||
shiny::conditionalPanel(
|
||||
condition = "output.uploaded == 'yes'",
|
||||
)
|
||||
|
||||
##############################################################################
|
||||
#########
|
||||
######### Page navigation
|
||||
#########
|
||||
##############################################################################
|
||||
|
||||
shiny::observeEvent(input$act_start, {
|
||||
bslib::nav_select(id = "main_panel", selected = "Data")
|
||||
})
|
||||
|
||||
##############################################################################
|
||||
#########
|
||||
######### Reactivity
|
||||
#########
|
||||
##############################################################################
|
||||
|
||||
output$uploaded <- shiny::reactive({
|
||||
if (is.null(rv$ds)) {
|
||||
"no"
|
||||
} else {
|
||||
"yes"
|
||||
}
|
||||
})
|
||||
|
||||
shiny::outputOptions(output, "uploaded", suspendWhenHidden = FALSE)
|
||||
|
||||
output$ready <- shiny::reactive({
|
||||
if (is.null(rv$ready)) {
|
||||
"no"
|
||||
} else {
|
||||
"yes"
|
||||
}
|
||||
})
|
||||
|
||||
shiny::outputOptions(output, "ready", suspendWhenHidden = FALSE)
|
||||
|
||||
# Reimplement from environment at later time
|
||||
# output$has_input <- shiny::reactive({
|
||||
# if (rv$input) {
|
||||
# "yes"
|
||||
# } else {
|
||||
# "no"
|
||||
# }
|
||||
# })
|
||||
|
||||
# shiny::outputOptions(output, "has_input", suspendWhenHidden = FALSE)
|
||||
|
||||
##############################################################################
|
||||
#########
|
||||
######### Downloads
|
||||
#########
|
||||
##############################################################################
|
||||
|
||||
# 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) {
|
||||
# shiny::req(rv$list$regression)
|
||||
## Notification is not progressing
|
||||
## Presumably due to missing
|
||||
|
||||
# Simplified for .rmd output attempt
|
||||
format <- ifelse(type == "docx", "word_document", "odt_document")
|
||||
|
||||
shiny::withProgress(message = "Generating the report. Hold on for a moment..", {
|
||||
rv$list |>
|
||||
write_rmd(
|
||||
output_format = format,
|
||||
input = file.path(getwd(), "www/report.rmd")
|
||||
)
|
||||
|
||||
# write_quarto(
|
||||
# output_format = type,
|
||||
# input = file.path(getwd(), "www/report.qmd")
|
||||
# )
|
||||
})
|
||||
file.rename(paste0("www/report.", type), file)
|
||||
}
|
||||
)
|
||||
|
||||
output$data_modified <- downloadHandler(
|
||||
filename = shiny::reactive({
|
||||
paste0("modified_data.", input$data_type)
|
||||
}),
|
||||
content = function(file, type = input$data_type) {
|
||||
if (type == "rds") {
|
||||
readr::write_rds(rv$list$data, file = file)
|
||||
} else if (type == "dta") {
|
||||
haven::write_dta(as.data.frame(rv$list$data), path = file)
|
||||
} else if (type == "csv") {
|
||||
readr::write_csv(rv$list$data, file = file)
|
||||
}
|
||||
}
|
||||
)
|
||||
|
||||
##############################################################################
|
||||
#########
|
||||
######### Clearing the session on end
|
||||
#########
|
||||
##############################################################################
|
||||
|
||||
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"))
|
||||
})
|
||||
})
|
||||
}
|
||||
631
inst/apps/FreesearchR/ui.R
Normal file
631
inst/apps/FreesearchR/ui.R
Normal file
|
|
@ -0,0 +1,631 @@
|
|||
# ns <- NS(id)
|
||||
|
||||
ui_elements <- list(
|
||||
##############################################################################
|
||||
#########
|
||||
######### Home panel
|
||||
#########
|
||||
##############################################################################
|
||||
"home" = bslib::nav_panel(
|
||||
title = "freesearcheR",
|
||||
shiny::fluidRow(
|
||||
shiny::column(width = 2),
|
||||
shiny::column(
|
||||
width = 8,
|
||||
shiny::markdown(readLines("www/intro.md")),
|
||||
shiny::column(width = 2)
|
||||
)
|
||||
),
|
||||
icon = shiny::icon("home")
|
||||
),
|
||||
##############################################################################
|
||||
#########
|
||||
######### Import panel
|
||||
#########
|
||||
##############################################################################
|
||||
"import" = bslib::nav_panel(
|
||||
title = "Import",
|
||||
shiny::fluidRow(
|
||||
shiny::column(width = 2),
|
||||
shiny::column(
|
||||
width = 8,
|
||||
shiny::h4("Choose your data source"),
|
||||
shiny::br(),
|
||||
shinyWidgets::radioGroupButtons(
|
||||
inputId = "source",
|
||||
selected = "env",
|
||||
choices = c(
|
||||
"File upload" = "file",
|
||||
"REDCap server export" = "redcap",
|
||||
"Local or sample data" = "env"
|
||||
),
|
||||
width = "100%"
|
||||
),
|
||||
shiny::helpText("Upload a file from your device, get data directly from REDCap or select a sample data set for testing from the app."),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='file'",
|
||||
import_file_ui(
|
||||
id = "file_import",
|
||||
layout_params = "dropdown",
|
||||
# title = "Choose a datafile to upload",
|
||||
file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".ods", ".dta")
|
||||
)
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='redcap'",
|
||||
m_redcap_readUI(
|
||||
id = "redcap_import",
|
||||
title = ""
|
||||
)
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='env'",
|
||||
import_globalenv_ui(id = "env", title = NULL)
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.source=='redcap'",
|
||||
DT::DTOutput(outputId = "redcap_prev")
|
||||
),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::h5("Specify variables to include"),
|
||||
shiny::fluidRow(
|
||||
shiny::column(
|
||||
width = 6,
|
||||
shiny::br(),
|
||||
shiny::p("Filter by completeness threshold and manual selection:"),
|
||||
shiny::br(),
|
||||
shiny::br()
|
||||
),
|
||||
shiny::column(
|
||||
width = 6,
|
||||
shinyWidgets::noUiSliderInput(
|
||||
inputId = "complete_cutoff",
|
||||
label = NULL,
|
||||
min = 0,
|
||||
max = 100,
|
||||
step = 5,
|
||||
value = 70,
|
||||
format = shinyWidgets::wNumbFormat(decimals = 0),
|
||||
color = datamods:::get_primary_color()
|
||||
),
|
||||
shiny::helpText("Filter variables with completeness above the specified percentage."),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::uiOutput(outputId = "import_var")
|
||||
)
|
||||
),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::actionButton(
|
||||
inputId = "act_start",
|
||||
label = "Start",
|
||||
width = "100%",
|
||||
icon = shiny::icon("play"),
|
||||
disabled = TRUE
|
||||
),
|
||||
shiny::helpText('After importing, hit "Start" or navigate to the desired tab.'),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::column(width = 2)
|
||||
)
|
||||
)
|
||||
),
|
||||
##############################################################################
|
||||
#########
|
||||
######### Data overview panel
|
||||
#########
|
||||
##############################################################################
|
||||
"overview" =
|
||||
# bslib::nav_panel_hidden(
|
||||
bslib::nav_panel(
|
||||
# value = "overview",
|
||||
title = "Data",
|
||||
bslib::navset_bar(
|
||||
fillable = TRUE,
|
||||
bslib::nav_panel(
|
||||
title = "Overview",
|
||||
tags$h3("Overview and filtering"),
|
||||
fluidRow(
|
||||
shiny::column(
|
||||
width = 9,
|
||||
shiny::tags$p(
|
||||
"Below is a short summary table of the provided data.
|
||||
On the right hand side you have the option to create filters.
|
||||
At the bottom you'll find a raw overview of the original vs the modified data."
|
||||
)
|
||||
)
|
||||
),
|
||||
fluidRow(
|
||||
shiny::column(
|
||||
width = 9,
|
||||
data_summary_ui(id = "data_summary")
|
||||
),
|
||||
shiny::column(
|
||||
width = 3,
|
||||
IDEAFilter::IDEAFilter_ui("data_filter"),
|
||||
shiny::tags$br()
|
||||
)
|
||||
)
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Browse",
|
||||
tags$h3("Browse the provided data"),
|
||||
shiny::tags$p(
|
||||
"Below is a table with all the modified data provided to browse and understand data."
|
||||
),
|
||||
shinyWidgets::html_dependency_winbox(),
|
||||
fluidRow(
|
||||
toastui::datagridOutput(outputId = "table_mod")
|
||||
),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br()
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Modify",
|
||||
tags$h3("Subset, rename and convert variables"),
|
||||
fluidRow(
|
||||
shiny::column(
|
||||
width = 9,
|
||||
shiny::tags$p(shiny::markdown("Below, are several options to update variables (rename, set new labels (for nicer tables in the report) and change variable classes (numeric, factor/categorical etc.).), modify factor/categorical variables as well as create new factor from a continous variable or new variables with *R* code."))
|
||||
)
|
||||
),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
fluidRow(
|
||||
shiny::column(
|
||||
width = 2
|
||||
),
|
||||
shiny::column(
|
||||
width = 8,
|
||||
fluidRow(
|
||||
shiny::column(
|
||||
width = 6,
|
||||
tags$h4("Update or modify variables"),
|
||||
shiny::tags$br(),
|
||||
shiny::actionButton(
|
||||
inputId = "modal_variables",
|
||||
label = "Subset, rename and change class/type",
|
||||
width = "100%"
|
||||
),
|
||||
shiny::tags$br(),
|
||||
shiny::helpText("Subset variables, rename variables and labels, and apply new class to variables"),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
shiny::actionButton(
|
||||
inputId = "modal_update",
|
||||
label = "Reorder factor levels",
|
||||
width = "100%"
|
||||
),
|
||||
shiny::tags$br(),
|
||||
shiny::helpText("Reorder the levels of factor/categorical variables."),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br()
|
||||
),
|
||||
shiny::column(
|
||||
width = 6,
|
||||
tags$h4("Create new variables"),
|
||||
shiny::tags$br(),
|
||||
shiny::actionButton(
|
||||
inputId = "modal_cut",
|
||||
label = "New factor",
|
||||
width = "100%"
|
||||
),
|
||||
shiny::tags$br(),
|
||||
shiny::helpText("Create factor/categorical variable from a continous variable (number/date/time)."),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
shiny::actionButton(
|
||||
inputId = "modal_column",
|
||||
label = "New variable",
|
||||
width = "100%"
|
||||
),
|
||||
shiny::tags$br(),
|
||||
shiny::helpText(shiny::markdown("Create a new variable/column based on an *R*-expression.")),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br()
|
||||
)
|
||||
),
|
||||
tags$h4("Restore"),
|
||||
shiny::actionButton(
|
||||
inputId = "data_reset",
|
||||
label = "Restore original data",
|
||||
width = "100%"
|
||||
),
|
||||
shiny::tags$br(),
|
||||
shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing.")
|
||||
),
|
||||
shiny::column(
|
||||
width = 2
|
||||
)
|
||||
),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
tags$h4("Restore"),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$p(
|
||||
"Below, you'll find a raw overview of the original vs the modified data."
|
||||
),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
fluidRow(
|
||||
column(
|
||||
width = 6,
|
||||
tags$b("Original data:"),
|
||||
# verbatimTextOutput("original"),
|
||||
verbatimTextOutput("original_str")
|
||||
),
|
||||
column(
|
||||
width = 6,
|
||||
tags$b("Modified data:"),
|
||||
# verbatimTextOutput("modified"),
|
||||
verbatimTextOutput("modified_str")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
##############################################################################
|
||||
#########
|
||||
######### Descriptive analyses panel
|
||||
#########
|
||||
##############################################################################
|
||||
"describe" =
|
||||
bslib::nav_panel(
|
||||
title = "Evaluate",
|
||||
id = "navdescribe",
|
||||
bslib::navset_bar(
|
||||
title = "",
|
||||
sidebar = bslib::sidebar(
|
||||
bslib::accordion(
|
||||
open = "acc_chars",
|
||||
multiple = FALSE,
|
||||
bslib::accordion_panel(
|
||||
value = "acc_chars",
|
||||
title = "Characteristics",
|
||||
icon = bsicons::bs_icon("table"),
|
||||
shiny::uiOutput("strat_var"),
|
||||
shiny::helpText("Only factor/categorical variables are available for stratification. Go back to the 'Data' tab to reclass a variable if it's not on the list."),
|
||||
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.")
|
||||
)
|
||||
),
|
||||
bslib::accordion_panel(
|
||||
vlaue = "acc_cor",
|
||||
title = "Correlations",
|
||||
icon = bsicons::bs_icon("bounding-box"),
|
||||
shiny::uiOutput("outcome_var_cor"),
|
||||
shiny::helpText("To avoid evaluating the correlation of the outcome variable, this can be excluded from the plot or select 'none'."),
|
||||
shiny::br(),
|
||||
shinyWidgets::noUiSliderInput(
|
||||
inputId = "cor_cutoff",
|
||||
label = "Correlation cut-off",
|
||||
min = 0,
|
||||
max = 1,
|
||||
step = .01,
|
||||
value = .8,
|
||||
format = shinyWidgets::wNumbFormat(decimals = 2),
|
||||
color = datamods:::get_primary_color()
|
||||
),
|
||||
shiny::helpText("Set the cut-off for considered 'highly correlated'.")
|
||||
)
|
||||
)
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Baseline characteristics",
|
||||
gt::gt_output(outputId = "table1")
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Variable correlations",
|
||||
data_correlations_ui(id = "correlations", height = 600)
|
||||
)
|
||||
)
|
||||
),
|
||||
##############################################################################
|
||||
#########
|
||||
######### Download panel
|
||||
#########
|
||||
##############################################################################
|
||||
"visuals" = bslib::nav_panel(
|
||||
title = "Visuals",
|
||||
id = "navvisuals",
|
||||
do.call(
|
||||
bslib::navset_bar,
|
||||
c(
|
||||
data_visuals_ui("visuals"),
|
||||
shiny::tagList(
|
||||
bslib::nav_spacer(),
|
||||
bslib::nav_panel(
|
||||
title = "Notes",
|
||||
shiny::fluidRow(
|
||||
shiny::column(width = 2),
|
||||
shiny::column(
|
||||
width = 8,
|
||||
shiny::markdown(readLines("www/notes_visuals.md")),
|
||||
shiny::column(width = 2)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
##############################################################################
|
||||
#########
|
||||
######### Regression analyses panel
|
||||
#########
|
||||
##############################################################################
|
||||
"analyze" =
|
||||
bslib::nav_panel(
|
||||
title = "Regression",
|
||||
id = "navanalyses",
|
||||
bslib::navset_bar(
|
||||
title = "",
|
||||
# bslib::layout_sidebar(
|
||||
# fillable = TRUE,
|
||||
sidebar = bslib::sidebar(
|
||||
bslib::accordion(
|
||||
open = "acc_reg",
|
||||
multiple = FALSE,
|
||||
bslib::accordion_panel(
|
||||
value = "acc_reg",
|
||||
title = "Regression",
|
||||
icon = bsicons::bs_icon("calculator"),
|
||||
shiny::uiOutput("outcome_var"),
|
||||
# shiny::selectInput(
|
||||
# inputId = "design",
|
||||
# label = "Study design",
|
||||
# selected = "no",
|
||||
# inline = TRUE,
|
||||
# choices = list(
|
||||
# "Cross-sectional" = "cross-sectional"
|
||||
# )
|
||||
# ),
|
||||
shiny::uiOutput("regression_type"),
|
||||
shiny::radioButtons(
|
||||
inputId = "add_regression_p",
|
||||
label = "Add p-value",
|
||||
inline = TRUE,
|
||||
selected = "yes",
|
||||
choices = list(
|
||||
"Yes" = "yes",
|
||||
"No" = "no"
|
||||
)
|
||||
),
|
||||
bslib::input_task_button(
|
||||
id = "load",
|
||||
label = "Analyse",
|
||||
# icon = shiny::icon("pencil", lib = "glyphicon"),
|
||||
icon = bsicons::bs_icon("pencil"),
|
||||
label_busy = "Working...",
|
||||
icon_busy = fontawesome::fa_i("arrows-rotate",
|
||||
class = "fa-spin",
|
||||
"aria-hidden" = "true"
|
||||
),
|
||||
type = "secondary",
|
||||
auto_reset = TRUE
|
||||
),
|
||||
shiny::helpText("Press 'Analyse' again after changing parameters."),
|
||||
shiny::tags$br(),
|
||||
shiny::uiOutput("plot_model")
|
||||
),
|
||||
bslib::accordion_panel(
|
||||
value = "acc_advanced",
|
||||
title = "Advanced",
|
||||
icon = bsicons::bs_icon("gear"),
|
||||
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::helpText(em("Please specify relevant settings for your data, and press 'Analyse'")),
|
||||
# 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")
|
||||
# ),
|
||||
# shiny::conditionalPanel(
|
||||
# condition = "output.ready=='yes'",
|
||||
# shiny::tags$hr(),
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Regression table",
|
||||
gt::gt_output(outputId = "table2")
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Coefficient plot",
|
||||
shiny::plotOutput(outputId = "regression_plot")
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Model checks",
|
||||
shiny::plotOutput(outputId = "check")
|
||||
# shiny::uiOutput(outputId = "check_1")
|
||||
)
|
||||
)
|
||||
),
|
||||
##############################################################################
|
||||
#########
|
||||
######### Download panel
|
||||
#########
|
||||
##############################################################################
|
||||
"download" =
|
||||
bslib::nav_panel(
|
||||
title = "Download",
|
||||
id = "navdownload",
|
||||
shiny::fluidRow(
|
||||
shiny::column(width = 2),
|
||||
shiny::column(
|
||||
width = 8,
|
||||
shiny::fluidRow(
|
||||
shiny::column(
|
||||
width = 6,
|
||||
shiny::h4("Report"),
|
||||
shiny::helpText("Choose your favourite output file format for further work, and download, when the analyses are done."),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::selectInput(
|
||||
inputId = "output_type",
|
||||
label = "Output format",
|
||||
selected = NULL,
|
||||
choices = list(
|
||||
"MS Word" = "docx",
|
||||
"LibreOffice" = "odt"
|
||||
# ,
|
||||
# "PDF" = "pdf",
|
||||
# "All the above" = "all"
|
||||
)
|
||||
),
|
||||
shiny::br(),
|
||||
# Button
|
||||
shiny::downloadButton(
|
||||
outputId = "report",
|
||||
label = "Download report",
|
||||
icon = shiny::icon("download")
|
||||
)
|
||||
# shiny::helpText("If choosing to output to MS Word, please note, that when opening the document, two errors will pop-up. Choose to repair and choose not to update references. The issue is being worked on. You can always choose LibreOffice instead."),
|
||||
),
|
||||
shiny::column(
|
||||
width = 6,
|
||||
shiny::h4("Data"),
|
||||
shiny::helpText("Choose your favourite output data format to download the modified data."),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::selectInput(
|
||||
inputId = "data_type",
|
||||
label = "Data format",
|
||||
selected = NULL,
|
||||
choices = list(
|
||||
"R" = "rds",
|
||||
"stata" = "dta",
|
||||
"CSV" = "csv"
|
||||
)
|
||||
),
|
||||
shiny::helpText("No metadata is saved when exporting to csv."),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
# Button
|
||||
shiny::downloadButton(
|
||||
outputId = "data_modified",
|
||||
label = "Download data",
|
||||
icon = shiny::icon("download")
|
||||
)
|
||||
)
|
||||
),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::h4("Code snippets"),
|
||||
shiny::tags$p("Below are the code used to create the final data set. This can be saved for reproducibility. The code may not be 100 % correct, but kan be used for learning and example code to get started on coding yourself."),
|
||||
shiny::verbatimTextOutput(outputId = "code_import"),
|
||||
shiny::verbatimTextOutput(outputId = "code_data"),
|
||||
shiny::verbatimTextOutput(outputId = "code_filter"),
|
||||
shiny::tags$br(),
|
||||
shiny::br(),
|
||||
shiny::column(width = 2)
|
||||
)
|
||||
)
|
||||
),
|
||||
##############################################################################
|
||||
#########
|
||||
######### Documentation panel
|
||||
#########
|
||||
##############################################################################
|
||||
"docs" = bslib::nav_item(
|
||||
# shiny::img(shiny::icon("book")),
|
||||
shiny::tags$a(
|
||||
href = "https://agdamsbo.github.io/FreesearchR/",
|
||||
"Docs (external)",
|
||||
target = "_blank",
|
||||
rel = "noopener noreferrer"
|
||||
)
|
||||
)
|
||||
# bslib::nav_panel(
|
||||
# title = "Documentation",
|
||||
# # shiny::tags$iframe("www/docs.html", height=600, width=535),
|
||||
# shiny::htmlOutput("docs_file"),
|
||||
# shiny::br()
|
||||
# )
|
||||
)
|
||||
# Initial attempt at creating light and dark versions
|
||||
light <- custom_theme()
|
||||
dark <- custom_theme(
|
||||
bg = "#000",
|
||||
fg = "#fff"
|
||||
)
|
||||
|
||||
# Fonts to consider:
|
||||
# https://webdesignerdepot.com/17-open-source-fonts-youll-actually-love/
|
||||
|
||||
ui <- bslib::page_fixed(
|
||||
shiny::tags$head(includeHTML(("www/umami-app.html"))),
|
||||
shiny::tags$style(
|
||||
type = "text/css",
|
||||
# add the name of the tab you want to use as title in data-value
|
||||
shiny::HTML(
|
||||
".container-fluid > .nav > li >
|
||||
a[data-value='freesearcheR'] {font-size: 28px}"
|
||||
)
|
||||
),
|
||||
title = "freesearcheR",
|
||||
theme = light,
|
||||
shiny::useBusyIndicators(),
|
||||
bslib::page_navbar(
|
||||
id = "main_panel",
|
||||
ui_elements$home,
|
||||
ui_elements$import,
|
||||
ui_elements$overview,
|
||||
ui_elements$describe,
|
||||
ui_elements$visuals,
|
||||
ui_elements$analyze,
|
||||
ui_elements$download,
|
||||
bslib::nav_spacer(),
|
||||
ui_elements$docs,
|
||||
fillable = FALSE,
|
||||
footer = shiny::tags$footer(
|
||||
style = "background-color: #14131326; padding: 4px; text-align: center; bottom: 0; width: 100%;",
|
||||
shiny::p(
|
||||
style = "margin: 1",
|
||||
"Data is only stored for analyses and deleted immediately afterwards."
|
||||
),
|
||||
shiny::p(
|
||||
style = "margin: 1; color: #888;",
|
||||
"AG Damsbo | v", app_version(), " | AGPLv3 license | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/FreesearchR/", target = "_blank", rel = "noopener noreferrer")
|
||||
),
|
||||
)
|
||||
)
|
||||
)
|
||||
438
inst/apps/FreesearchR/www/intro.html
Normal file
438
inst/apps/FreesearchR/www/intro.html
Normal file
File diff suppressed because one or more lines are too long
29
inst/apps/FreesearchR/www/intro.md
Normal file
29
inst/apps/FreesearchR/www/intro.md
Normal file
|
|
@ -0,0 +1,29 @@
|
|||
# Welcome
|
||||
|
||||
This is the ***freesearcheR*** data analysis tool. We intend the ***freesearcheR*** to be a powerful and free tool for easy data evaluation and analysis at the hands of the clinician. If you need more advanced tools for regression models or plotting, you'll probably be better off using *R* or similar directly on your own machine.
|
||||
|
||||
By intention, this tool has been designed to be simple to use with a minimum of mandatory options to keep the workflow streamlined, while also including a few options to go even further.
|
||||
|
||||
There are some simple steps to go through (see corresponding tabs in the top):
|
||||
|
||||
1. Import data (a spreadsheet/file on your machine, direct export from a REDCap server, or a local file provided with a package) to get started.
|
||||
|
||||
1. Data inspection and modification (change variable classes, create new variables (categorical from numeric or time data, or completely new variables from the data)
|
||||
|
||||
1. Evaluate data using descriptive analyses methods and inspect cross-correlations
|
||||
|
||||
1. Create simple, clean plots for data overview.
|
||||
|
||||
1. Create regression models for even more advanced data analyses
|
||||
|
||||
- Linear, dichotomous or ordinal logistic regression will be used depending on specified outcome variable
|
||||
|
||||
- Plot regression analysis coefficients
|
||||
|
||||
- Evaluation of model assumptions
|
||||
|
||||
1. Export the the analyses results for MS Word or [LibreOffice](https://www.libreoffice.org/) as well as the data with preserved metadata.
|
||||
|
||||
Have a look at the [documentations page](https://agdamsbo.github.io/freesearcheR/) for further project description. If you're interested in the source code, then go on, [have a look](https://github.com/agdamsbo/freesearcheR)!
|
||||
|
||||
If you encounter anything strange or the app doesn't act as expected. Please [report on Github](https://github.com/agdamsbo/freesearcheR/issues).
|
||||
413
inst/apps/FreesearchR/www/notes_visuals.html
Normal file
413
inst/apps/FreesearchR/www/notes_visuals.html
Normal file
File diff suppressed because one or more lines are too long
11
inst/apps/FreesearchR/www/notes_visuals.md
Normal file
11
inst/apps/FreesearchR/www/notes_visuals.md
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
# Basic visualisations
|
||||
|
||||
This section on plotting data is kept very minimal, and includes only the most common plot types for clinical projects.
|
||||
|
||||
If you want to go further, have a look at these sites with suggestions and sample code for data plotting:
|
||||
|
||||
- [*R* Charts](https://r-charts.com/): Extensive gallery with great plots
|
||||
|
||||
- [*R* Graph gallery](https://r-graph-gallery.com/): Another gallery with great graphs
|
||||
|
||||
- [grphics principles](https://graphicsprinciples.github.io/): Easy to follow recommendations for clear visuals.
|
||||
72
inst/apps/FreesearchR/www/report.rmd
Normal file
72
inst/apps/FreesearchR/www/report.rmd
Normal file
|
|
@ -0,0 +1,72 @@
|
|||
---
|
||||
title: "freesearcheR data report"
|
||||
date: "Report generated `r gsub('(\\D)0', '\\1', format(Sys.time(), '%A, %d.%m.%Y'))`"
|
||||
format: docx
|
||||
author: freesearcheR data analysis tool
|
||||
toc: false
|
||||
params:
|
||||
data.file: NA
|
||||
---
|
||||
|
||||
```{r setup, echo = FALSE}
|
||||
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
|
||||
# glue::glue("{format(lubridate::today(),'%A')}, {lubridate::day(lubridate::today())}.{lubridate::month(lubridate::today())}.{lubridate::year(lubridate::today())}")
|
||||
```
|
||||
|
||||
|
||||
```{r}
|
||||
web_data <- readr::read_rds(file = params$data.file)
|
||||
library(gtsummary)
|
||||
library(gt)
|
||||
|
||||
tbl_merge <- function(data) {
|
||||
if (is.null(names(data))) {
|
||||
data |> gtsummary::tbl_merge()
|
||||
} else {
|
||||
data |> gtsummary::tbl_merge(tab_spanner = names(data))
|
||||
}
|
||||
}
|
||||
|
||||
vec2sentence <- function(data, sep.word = "and") {
|
||||
sep.word <- paste0(" ", gsub(" ", "", sep.word), " ")
|
||||
if (length(data) < 2) {
|
||||
out <- data
|
||||
} else if (length(data) == 2) {
|
||||
out <- paste(data, collapse = sep.word)
|
||||
} else {
|
||||
out <- paste(paste(data[-length(data)], collapse = ","), data[length(data)], sep = sep.word)
|
||||
}
|
||||
return(out)
|
||||
}
|
||||
```
|
||||
|
||||
## Introduction
|
||||
|
||||
Research should be free and open with easy access for all. The freesearcheR tool attempts to help lower the bar to participate in contributing to science by making guided data analysis easily accessible in the web-browser.
|
||||
|
||||
## Methods
|
||||
|
||||
Analyses were conducted in the *freesearcheR* data analysis web-tool based on R version 4.4.1.
|
||||
|
||||
## Results
|
||||
|
||||
Below are the baseline characteristics.
|
||||
|
||||
```{r, results = 'asis'}
|
||||
if ("table1" %in% names(web_data)){
|
||||
tbl <- gtsummary::as_gt(web_data$table1)
|
||||
knitr::knit_print(tbl)}
|
||||
```
|
||||
|
||||
`r if ("regression" %in% names(web_data)) glue::glue("Below are the results from the { tolower(vec2sentence(names(web_data$regression$tables)))} {web_data$regression$params$descr}.")`
|
||||
|
||||
```{r, results = 'asis'}
|
||||
if ("regression" %in% names(web_data)){
|
||||
reg_tbl <- web_data$regression$tables
|
||||
knitr::knit_print(tbl_merge(reg_tbl))
|
||||
}
|
||||
```
|
||||
|
||||
## Discussion
|
||||
|
||||
Good luck on your further work!
|
||||
1
inst/apps/FreesearchR/www/umami-app.html
Normal file
1
inst/apps/FreesearchR/www/umami-app.html
Normal file
|
|
@ -0,0 +1 @@
|
|||
<script defer src="https://analytics.gdamsbo.dk/script.js" data-website-id="e7d4e13a-5824-4778-bbc0-8f92fb08303a"></script>
|
||||
Loading…
Add table
Add a link
Reference in a new issue