andreas/FreesearchR
1
0
Fork 0
mirror of https://github.com/agdamsbo/FreesearchR.git synced 2026-06-19 12:37:30 +02:00
Code Issues Projects Releases Packages Wiki Activity

bumped to 25.2.1 - new visuals tab - all functions in place - code cleanup has started

Browse source
This commit is contained in:
Andreas Gammelgaard Damsbo 2025-02-25 09:51:42 +01:00
commit 14edce9912
No known key found for this signature in database
36 changed files with 3564 additions and 2976 deletions
Download patch file Download diff file Expand all files Collapse all files

6525
inst/apps/freesearcheR/app.R Normal file
View file

File diff suppressed because it is too large Load diff

1
inst/apps/freesearcheR/launch.R Normal file
View file

@ -0,0 +1 @@
shinyApp(ui, server)

10
inst/apps/freesearcheR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf Normal file
View file

@ -0,0 +1,10 @@
name: freesearcheR
title:
username: agdamsbo
account: agdamsbo
server: shinyapps.io
hostUrl: https://api.shinyapps.io/v1
appId: 13611288
bundleId: 9852208
url: https://agdamsbo.shinyapps.io/freesearcheR/
version: 1

10
inst/apps/freesearcheR/rsconnect/shinyapps.io/agdamsbo/webResearch.dcf Normal file
View file

@ -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

10
inst/apps/freesearcheR/rsconnect/shinyapps.io/cognitiveindex/freesearcheR_dev.dcf Normal file
View file

@ -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

10
inst/apps/freesearcheR/rsconnect/shinyapps.io/cognitiveindex/freesearcheR_extra.dcf Normal file
View file

@ -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

967
inst/apps/freesearcheR/server.R Normal file
View file

@ -0,0 +1,967 @@
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 = NULL,
data_filtered = NULL,
models = NULL,
code = list()
)
##############################################################################
#########
######### Data import section
#########
##############################################################################
consider.na <- c("NA", "\"\"", "", "\'\'", "na")
data_file <- datamods::import_file_server(
id = "file_import",
show_data_in = "popup",
trigger_return = "change",
return_class = "data.frame",
read_fns = list(
ods = function(file) {
readODS::read_ods(
path = file,
# Sheet and skip not implemented for .ods in the original implementation
# sheet = sheet,
# skip = skip,
na = consider.na
)
},
dta = function(file) {
haven::read_dta(
file = file,
.name_repair = "unique_quiet"
)
},
csv = function(file) {
readr::read_csv(
file = file,
na = consider.na,
name_repair = "unique_quiet"
)
},
xls = function(file) {
openxlsx2::read_xlsx(
file = file,
sheet = sheet,
skip_empty_rows = TRUE,
start_row = skip - 1,
na.strings = consider.na
)
},
xlsx = function(file) {
openxlsx2::read_xlsx(
file = file,
sheet = sheet,
skip_empty_rows = TRUE,
start_row = skip - 1,
na.strings = consider.na)
},
rds = function(file) {
readr::read_rds(
file = file,
name_repair = "unique_quiet")
}
)
)
shiny::observeEvent(data_file$data(), {
shiny::req(data_file$data())
rv$data_original <- data_file$data()
rv$code <- append_list(data = data_file$code(), list = rv$code, index = "import")
})
data_redcap <- m_redcap_readServer(
id = "redcap_import",
output.format = "list"
)
shiny::observeEvent(data_redcap(), {
rv$data_original <- purrr::pluck(data_redcap(), "data")()
})
output$redcap_prev <- DT::renderDT(
{
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_original <- from_env$data()
# rv$code <- append_list(data = from_env$code(),list = rv$code,index = "import")
})
##############################################################################
#########
######### Data modification section
#########
##############################################################################
shiny::observeEvent(
eventExpr = list(
rv$data_original,
input$reset_confirm,
input$complete_cutoff
),
handlerExpr = {
shiny::req(rv$data_original)
rv$data <- rv$data_original |>
# janitor::clean_names() |>
default_parsing() |>
remove_empty_cols(
cutoff = input$complete_cutoff / 100
)
}
)
shiny::observeEvent(input$data_reset, {
shinyWidgets::ask_confirmation(
inputId = "reset_confirm",
title = "Please confirm data reset?"
)
})
# shiny::observeEvent(input$reset_confirm, {
# rv$data <- rv$data_original |> default_parsing()
# })
######### Overview
data_summary_server(
id = "data_summary",
data = shiny::reactive({
rv$data_filtered
}),
color.main = "#2A004E",
color.sec = "#C62300",
pagination = 20
)
#########
######### 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
######### Create factor
shiny::observeEvent(
input$modal_cut,
modal_cut_variable("modal_cut",title = "Modify factor levels")
)
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())
######### Modify factor
shiny::observeEvent(
input$modal_update,
datamods::modal_update_factor(id = "modal_update")
)
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()
})
######### Create column
shiny::observeEvent(
input$modal_column,
datamods::modal_create_column(id = "modal_column")
)
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()
}
)
######### Show result
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$code <- renderPrint({
attr(rv$data, "code")
})
# updated_data <- datamods::update_variables_server(
updated_data <- update_variables_server(
id = "vars_update",
data = reactive(rv$data),
return_data_on_init = FALSE
)
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"
))
})
shiny::observeEvent(updated_data(), {
rv$data <- updated_data()
})
# IDEAFilter has the least cluttered UI, but might have a License issue
data_filter <- IDEAFilter::IDEAFilter("data_filter", data = reactive(rv$data), verbose = TRUE)
shiny::observeEvent(
list(
shiny::reactive(rv$data),
shiny::reactive(rv$data_original),
data_filter(),
regression_vars(),
input$complete_cutoff
),
{
rv$data_filtered <- data_filter()
rv$list$data <- data_filter() |>
REDCapCAST::fct_drop()
}
)
shiny::observeEvent(
list(
shiny::reactive(rv$data),
shiny::reactive(rv$data_original),
data_filter(),
shiny::reactive(rv$data_filtered)
),
{
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", .x[-1]), collapse = "|> \n ")
})()
rv$code <- append_list(data = out, list = rv$code, index = "filter")
}
)
# output$filtered_code <- shiny::renderPrint({
# 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", .x[-1]), collapse = "|> \n ")
# })()
#
# cat(out)
# })
output$code_import <- shiny::renderPrint({
cat(rv$code$import)
})
output$code_data <- shiny::renderPrint({
attr(rv$data, "code")
})
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$add_p,
input$complete_cutoff
),
{
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({
shiny::selectInput(
inputId = "outcome_var_cor",
selected = NULL,
label = "Select outcome variable",
choices = c(
colnames(rv$list$data)
# ,"none"
),
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 <- dplyr::select(rv$list$data, -!!input$outcome_var_cor)
# input$outcome_var_cor=="none"){
# out <- rv$list$data
# }
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}**")))
})
# shiny::observe(
# # list(
# # input$plot_model
# # ),
# {
# shiny::req(rv$list$regression$tables)
# shiny::req(input$plot_model)
# tryCatch(
# {
# out <- merge_long(rv$list$regression, input$plot_model) |>
# plot.tbl_regression(
# colour = "variable",
# facet_col = "model"
# )
#
# rv$list$regression$plot <- out
# },
# warning = function(warn) {
# showNotification(paste0(warn), type = "warning")
# },
# error = function(err) {
# showNotification(paste0("Plotting failed with the following error: ", err), type = "err")
# }
# )
# }
# )
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'",
)
# observeEvent(input$act_start, {
# nav_show(id = "overview",target = "Import"
# )
# })
##############################################################################
#########
######### 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"))
})
})
}

660
inst/apps/freesearcheR/ui.R Normal file
View file

@ -0,0 +1,660 @@
# 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" = "redcap",
"Local 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::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")
),
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("Exclude in-complete variables"),
shiny::p("Before going further, you can exclude variables with a low degree of completeness."),
shiny::br(),
shinyWidgets::noUiSliderInput(
inputId = "complete_cutoff",
label = "Choose completeness threshold (%)",
min = 0,
max = 100,
step = 10,
value = 70,
format = shinyWidgets::wNumbFormat(decimals = 0),
color = datamods:::get_primary_color()
),
shiny::helpText("Only include variables with completeness above a specified percentage."),
shiny::br(),
shiny::br(),
shiny::actionButton(
inputId = "act_start",
label = "Start",
width = "100%",
icon = shiny::icon("play")
),
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 = "Modify",
tags$h3("Subset, rename and convert variables"),
fluidRow(
shiny::column(
width = 9,
shiny::tags$p(shiny::markdown("Below, you can subset the data (select variables to include on clicking 'Apply changes'), rename variables, set new labels (for nicer tables in the report) and change variable classes (numeric, factor/categorical etc.).
Italic text can be edited/changed.
On the right, you can create and modify factor/categorical variables as well as create new variables with *R* code."))
)
),
fluidRow(
shiny::column(
width = 9,
update_variables_ui("vars_update"),
shiny::tags$br()
),
shiny::column(
width = 3,
tags$h4("Create new variables"),
shiny::tags$br(),
shiny::actionButton(
inputId = "modal_cut",
label = "Create factor variable",
width = "100%"
),
shiny::tags$br(),
shiny::helpText("Create factor/categorical variable from an other value."),
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::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() # ,
# shiny::tags$br(),
# shiny::tags$br(),
# IDEAFilter::IDEAFilter_ui("data_filter") # ,
# shiny::actionButton("save_filter", "Apply the filter")
)
# datamods::update_variables_ui("vars_update")
)
),
bslib::nav_panel(
title = "Filter",
tags$h3("Data 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(
# column(
# width = 3,
# shiny::uiOutput("filter_vars"),
# shiny::conditionalPanel(
# condition = "(typeof input.filter_vars !== 'undefined' && input.filter_vars.length > 0)",
# datamods::filter_data_ui("filtering", max_height = "500px")
# )
# ),
# column(
# width = 9,
# DT::DTOutput(outputId = "filtered_table"),
# tags$b("Code dplyr:"),
# verbatimTextOutput(outputId = "filtered_code")
# ),
shiny::column(
width = 9,
data_summary_ui(id = "data_summary")
),
shiny::column(
width = 3,
IDEAFilter::IDEAFilter_ui("data_filter"),
# shiny::tags$br(),
# shiny::tags$b("Filter code:"),
# shiny::verbatimTextOutput(outputId = "filtered_code"),
shiny::tags$br()
)
)
),
bslib::nav_panel(
title = "Restore",
tags$h3("Compare to original and restore"),
fluidRow(
shiny::column(
width = 9,
shiny::tags$p(
"Right below, you have the option to restore to the originally imported data.
At the bottom you'll find a raw overview of the original vs the modified data."
)
),
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.")
),
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")
)
)
),
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(
# column(
# width = 3,
# shiny::uiOutput("filter_vars"),
# shiny::conditionalPanel(
# condition = "(typeof input.filter_vars !== 'undefined' && input.filter_vars.length > 0)",
# datamods::filter_data_ui("filtering", max_height = "500px")
# )
# ),
# column(
# width = 9,
# DT::DTOutput(outputId = "filtered_table"),
# tags$b("Code dplyr:"),
# verbatimTextOutput(outputId = "filtered_code")
# ),
# shiny::column(
# width = 8,
fluidRow(
toastui::datagridOutput(outputId = "table_mod")
),
shiny::tags$br(),
shiny::tags$br(),
shiny::tags$br(),
shiny::tags$br(),
shiny::tags$br()
# ,
# shiny::tags$b("Reproducible code:"),
# shiny::verbatimTextOutput(outputId = "filtered_code")
# ),
# shiny::column(
# width = 4,
# shiny::actionButton("modal_cut", "Create factor from a variable"),
# shiny::tags$br(),
# shiny::tags$br(),
# shiny::actionButton("modal_update", "Reorder factor levels")#,
# # shiny::tags$br(),
# # shiny::tags$br(),
# # IDEAFilter::IDEAFilter_ui("data_filter") # ,
# # shiny::actionButton("save_filter", "Apply the filter")
# )
# )
)
# column(
# 8,
# shiny::verbatimTextOutput("filtered_code"),
# DT::DTOutput("filtered_table")
# ),
# column(4, IDEAFilter::IDEAFilter_ui("data_filter"))
)
),
##############################################################################
#########
######### Descriptive analyses panel
#########
##############################################################################
"describe" =
bslib::nav_panel(
title = "Evaluate",
id = "navdescribe",
bslib::navset_bar(
title = "",
# bslib::layout_sidebar(
# fillable = TRUE,
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("table"),
shiny::uiOutput("outcome_var_cor"),
shiny::helpText("This variable will be excluded from the correlation plot."),
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()
)
)
)
),
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::tags$b("Code snippets:"),
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/freesearcheR/",
"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/freesearcheR/", target = "_blank", rel = "noopener noreferrer")
),
)
)
)

438
inst/apps/freesearcheR/www/intro.html Normal file
View file

File diff suppressed because one or more lines are too long

29
inst/apps/freesearcheR/www/intro.md Normal file
View 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/freesearcheR/www/notes_visuals.html Normal file
View file

File diff suppressed because one or more lines are too long

11
inst/apps/freesearcheR/www/notes_visuals.md Normal file
View 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/freesearcheR/www/report.rmd Normal file
View 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/freesearcheR/www/umami-app.html Normal file
View file

@ -0,0 +1 @@
<script defer src="https://analytics.gdamsbo.dk/script.js" data-website-id="e7d4e13a-5824-4778-bbc0-8f92fb08303a"></script>