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

315
inst/apps/data_analysis/server.R
View file

@ -1,315 +0,0 @@
library(readr)
library(MASS)
library(stats)
library(gtsummary)
library(gt)
library(openxlsx2)
library(haven)
library(readODS)
library(shiny)
library(bslib)
library(assertthat)
library(dplyr)
library(quarto)
library(here)
library(broom)
library(broom.helpers)
# library(REDCapCAST)
library(easystats)
library(patchwork)
library(DHARMa)
# if (!requireNamespace("webResearch")) {
# devtools::install_github("agdamsbo/webResearch", quiet = TRUE, upgrade = "never")
# }
# library(webResearch)
if (file.exists(here::here("functions.R"))) {
source(here::here("functions.R"))
}
server <- function(input, output, session) {
## Listing files in www in session start to keep when ending and removing
## everything else.
files.to.keep <- list.files("www/")
v <- shiny::reactiveValues(
list = NULL,
ds = NULL,
input = exists("webResearch_data"),
local_temp = NULL,
quarto = NULL,
test = "no"
)
test_data <- shiny::eventReactive(input$test_data, {
v$test <- "test"
})
ds <- shiny::reactive({
# input$file1 will be NULL initially. After the user selects
# and uploads a file, head of that data file by default,
# or all rows if selected, will be shown.
if (v$input) {
out <- webResearch_data
} else if (v$test == "test") {
out <- gtsummary::trial
} else {
shiny::req(input$file)
out <- read_input(input$file$datapath)
}
v$ds <- "present"
if (input$factorize == "yes") {
out <- out |>
(\(.x){
suppressWarnings(
REDCapCAST::numchar2fct(.x)
)
})()
}
return(out)
})
output$include_vars <- shiny::renderUI({
selectizeInput(
inputId = "include_vars",
selected = NULL,
label = "Covariables to include",
choices = colnames(ds()),
multiple = TRUE
)
})
output$outcome_var <- shiny::renderUI({
selectInput(
inputId = "outcome_var",
selected = NULL,
label = "Select outcome variable",
choices = colnames(ds()),
multiple = FALSE
)
})
output$strat_var <- shiny::renderUI({
selectInput(
inputId = "strat_var",
selected = "none",
label = "Select variable to stratify baseline",
choices = c("none", colnames(ds()[base_vars()])),
multiple = FALSE
)
})
output$factor_vars <- shiny::renderUI({
selectizeInput(
inputId = "factor_vars",
selected = colnames(ds())[sapply(ds(), is.factor)],
label = "Covariables to format as categorical",
choices = colnames(ds()),
multiple = TRUE
)
})
base_vars <- shiny::reactive({
if (is.null(input$include_vars)) {
out <- colnames(ds())
} else {
out <- unique(c(input$include_vars, input$outcome_var))
}
return(out)
})
output$data.input <-
DT::renderDT({
shiny::req(input$file)
ds()[base_vars()]
})
output$data.classes <- gt::render_gt({
shiny::req(input$file)
data.frame(matrix(sapply(ds(), \(.x){
class(.x)[1]
}), nrow = 1)) |>
stats::setNames(names(ds())) |>
gt::gt()
})
shiny::observeEvent(
{
input$load
},
{
shiny::req(input$outcome_var)
# Assumes all character variables can be formatted as factors
data <- ds() |>
dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor))
data <- data |> factorize(vars = input$factor_vars)
# if (is.factor(data[[input$strat_var]])) {
# by.var <- input$strat_var
# } else {
# by.var <- NULL
# }
if (input$strat_var == "none") {
by.var <- NULL
} else {
by.var <- input$strat_var
}
data <- data[base_vars()]
# model <- data |>
# regression_model(
# outcome.str = input$outcome_var,
# auto.mode = input$regression_auto == 1,
# formula.str = input$regression_formula,
# fun = input$regression_fun,
# args.list = eval(parse(text = paste0("list(", input$regression_args, ")")))
# )
models <- list(
"Univariable" = regression_model_uv,
"Multivariable" = regression_model
) |>
lapply(\(.fun){
do.call(
.fun,
c(
list(data = data),
list(outcome.str = input$outcome_var),
list(formula.str = input$regression_formula),
list(fun = input$regression_fun),
list(args.list = eval(parse(text = paste0("list(", input$regression_args, ")"))))
)
)
})
# browser()
# check <- performance::check_model(purrr::pluck(models,"Multivariable") |>
# (\(x){
# class(x) <- class(x)[class(x) != "webresearch_model"]
# return(x)
# })())
check <- purrr::pluck(models, "Multivariable") |>
performance::check_model()
v$list <- list(
data = data,
check = check,
table1 = data |>
baseline_table(
fun.args =
list(
by = by.var
)
) |>
(\(.x){
if (!is.null(by.var)) {
.x |> gtsummary::add_overall()
} else {
.x
}
})() |>
(\(.x){
if (input$add_p == "yes") {
.x |>
gtsummary::add_p() |>
gtsummary::bold_p()
} else {
.x
}
})(),
table2 = models |>
purrr::map(regression_table) |>
tbl_merge(),
input = input
)
output$table1 <- gt::render_gt(
v$list$table1 |>
gtsummary::as_gt()
)
output$table2 <- gt::render_gt(
v$list$table2 |>
gtsummary::as_gt()
)
output$check <- shiny::renderPlot({
p <- plot(check) +
patchwork::plot_annotation(title = "Multivariable regression model checks")
p
# Generate checks in one column
# layout <- sapply(seq_len(length(p)), \(.x){
# patchwork::area(.x, 1)
# })
#
# p + patchwork::plot_layout(design = Reduce(c, layout))
# patchwork::wrap_plots(ncol=1) +
# patchwork::plot_annotation(title = 'Multivariable regression model checks')
})
}
)
output$uploaded <- shiny::reactive({
if (is.null(v$ds)) {
"no"
} else {
"yes"
}
})
shiny::outputOptions(output, "uploaded", suspendWhenHidden = FALSE)
output$has_input <- shiny::reactive({
if (v$input) {
"yes"
} else {
"no"
}
})
shiny::outputOptions(output, "has_input", suspendWhenHidden = FALSE)
# Could be rendered with other tables or should show progress
# Investigate quarto render problems
# On temp file handling: https://github.com/quarto-dev/quarto-cli/issues/3992
output$report <- downloadHandler(
filename = shiny::reactive({
paste0("report.", input$output_type)
}),
content = function(file, type = input$output_type) {
## Notification is not progressing
## Presumably due to missing
shiny::withProgress(message = "Generating report. Hold on for a moment..", {
v$list |>
write_quarto(
output_format = type,
input = file.path(getwd(), "www/report.qmd")
)
})
file.rename(paste0("www/report.", type), file)
}
)
session$onSessionEnded(function() {
cat("Session Ended\n")
files <- list.files("www/")
lapply(files[!files %in% files.to.keep], \(.x){
unlink(paste0("www/", .x), recursive = FALSE)
print(paste(.x, "deleted"))
})
})
}

212
inst/apps/data_analysis/ui.R
View file

@ -1,212 +0,0 @@
library(shiny)
library(bslib)
library(IDEAFilter)
library(teal)
requireNamespace("gt")
panels <- list(
bslib::nav_panel(
title = "Data overview",
# shiny::uiOutput("data.classes"),
# shiny::uiOutput("data.input"),
# shiny::p("Classes of uploaded data"),
# gt::gt_output("data.classes"),
shiny::p("Subset data"),
DT::DTOutput("data.input")
),
bslib::nav_panel(
title = "Baseline characteristics",
gt::gt_output(outputId = "table1")
),
bslib::nav_panel(
title = "Regression table",
gt::gt_output(outputId = "table2")
),
bslib::nav_panel(
title = "Regression checks",
shiny::plotOutput(outputId = "check")
)
)
ui <- bslib::page(
theme = bslib::bs_theme(
bootswatch = "minty",
base_font = font_google("Inter"),
code_font = font_google("JetBrains Mono")
),
title = "webResearcher for easy data analysis",
bslib::page_navbar(
title = "webResearcher",
header = h6("Welcome to the webResearcher tool. This is an early alpha version to act as a proof-of-concept and in no way intended for wider public use."),
sidebar = bslib::sidebar(
width = 300,
open = "open",
shiny::h4("Upload your dataset"),
shiny::conditionalPanel(
condition = "output.has_input=='yes'",
# Input: Select a file ----
shiny::helpText("Analyses are performed on provided data")
),
shiny::conditionalPanel(
condition = "output.has_input=='no'",
# Input: Select a file ----
shiny::fileInput(
inputId = "file",
label = "Choose data file",
multiple = FALSE,
accept = c(
".csv",
".xlsx",
".xls",
".dta",
".ods",
".rds"
)
),
# Does not work??
# shiny::actionButton(inputId = "test_data",
# label = "Load test data", class = "btn-primary")
),
shiny::conditionalPanel(
condition = "output.uploaded=='yes'",
shiny::h4("Parameter specifications"),
shiny::radioButtons(
inputId = "factorize",
label = "Factorize variables with few levels?",
selected = "yes",
inline = TRUE,
choices = list(
"Yes" = "yes",
"No" = "no"
)
),
shiny::radioButtons(
inputId = "regression_auto",
label = "Automatically choose function",
inline = TRUE,
choiceNames = c(
"Yes",
"No"
),
choiceValues = c(1, 2)
),
shiny::conditionalPanel(
condition = "input.regression_auto==2",
shiny::textInput(
inputId = "regression_formula",
label = "Formula string to render with 'glue::glue'",
value = NULL
),
shiny::textInput(
inputId = "regression_fun",
label = "Function to use for analysis (needs pasckage and name)",
value = "stats::lm"
),
shiny::textInput(
inputId = "regression_args",
label = "Arguments to pass to the function (provided as a string)",
value = ""
)
),
shiny::helpText(em("Please specify relevant settings for your data, and press 'Analyse'")),
shiny::uiOutput("outcome_var"),
shiny::uiOutput("strat_var"),
shiny::conditionalPanel(
condition = "input.strat_var!='none'",
shiny::radioButtons(
inputId = "add_p",
label = "Compare strata?",
selected = "no",
inline = TRUE,
choices = list(
"No" = "no",
"Yes" = "yes"
)
),
shiny::helpText("Option to perform statistical comparisons between strata in baseline table.")
),
shiny::radioButtons(
inputId = "all",
label = "Specify covariables",
inline = TRUE, selected = 2,
choiceNames = c(
"Yes",
"No"
),
choiceValues = c(1, 2)
),
shiny::conditionalPanel(
condition = "input.all==1",
shiny::uiOutput("include_vars")
),
shiny::radioButtons(
inputId = "specify_factors",
label = "Specify categorical variables?",
selected = "no",
inline = TRUE,
choices = list(
"Yes" = "yes",
"No" = "no"
)
),
shiny::conditionalPanel(
condition = "input.specify_factors=='yes'",
shiny::uiOutput("factor_vars")
),
bslib::input_task_button(
id = "load",
label = "Analyse",
icon = shiny::icon("pencil", lib = "glyphicon"),
label_busy = "Working...",
icon_busy = fontawesome::fa_i("arrows-rotate",
class = "fa-spin",
"aria-hidden" = "true"
),
type = "primary",
auto_reset = TRUE
),
shiny::helpText("If you change the parameters, press 'Analyse' again to update the tables"),
# shiny::actionButton("load", "Analyse", class = "btn-primary"),
#
# # Horizontal line ----
tags$hr(),
shiny::conditionalPanel(
condition = "input.load",
h4("Download results"),
shiny::helpText("Choose your favourite output file format for further work."),
shiny::selectInput(
inputId = "output_type",
label = "Choose your desired output format",
selected = NULL,
choices = list(
"Word" = "docx",
"LibreOffice" = "odt"
# ,
# "PDF" = "pdf",
# "All the above" = "all"
)
),
# Button
downloadButton(
outputId = "report",
label = "Download",
icon = shiny::icon("download")
)
)
)
),
bslib::nav_spacer(),
panels[[1]],
panels[[2]],
panels[[3]],
panels[[4]]
# layout_columns(
# cards[[1]]
# ),
# layout_columns(
# cards[[2]], cards[[3]]
# )
)
)

68
inst/apps/data_analysis/www/report.qmd
View file

@ -1,68 +0,0 @@
---
format:
html:
embed-resources: true
title: "webResearch analysis results"
date: today
author: webResearch Tool
toc: true
execute:
echo: false
params:
data.file: NA
---
```{r setup}
web_data <- readr::read_rds(file = params$data.file)
library(gtsummary)
library(gt)
library(easystats)
library(patchwork)
# library(webResearch)
```
## Introduction
Research should be free and open with easy access for all. The webResearch tool attempts to help lower the bar to participate in contributing to science.
## Methods
Analyses were conducted in R version `r paste(version["major"],version["minor"],sep=".")`.
## Results
Below is the baseline characteristics plotted.
```{r}
#| label: tbl-baseline
#| tbl-cap: Baseline characteristics of included data
web_data$table1
```
Here are the regression results.
```{r}
#| label: tbl-regression
#| tbl-cap: Regression analysis results
web_data$table2
```
## Discussion
Good luck on your further work!
## Sensitivity
Here are the results from testing the regression model:
```{r}
#| label: tbl-checks
#| fig-cap: Regression analysis checks
#| fig-height: 8
#| fig-width: 6
#| fig-dpi: 600
plot(web_data$check)
```

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

@ -1,10 +0,0 @@
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

1704
inst/apps/data_analysis_modules/app.R → inst/apps/freesearcheR/app.R
View file

File diff suppressed because it is too large Load diff

0
inst/apps/data_analysis_modules/launch.R → inst/apps/freesearcheR/launch.R
View file

2
inst/apps/data_analysis_modules/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf → inst/apps/freesearcheR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf
View file

@ -5,6 +5,6 @@ account: agdamsbo
server: shinyapps.io
hostUrl: https://api.shinyapps.io/v1
appId: 13611288
bundleId: 9765526
bundleId: 9852208
url: https://agdamsbo.shinyapps.io/freesearcheR/
version: 1

0
inst/apps/data_analysis/rsconnect/shinyapps.io/agdamsbo/webResearch.dcf → inst/apps/freesearcheR/rsconnect/shinyapps.io/agdamsbo/webResearch.dcf
View file

0
inst/apps/data_analysis_modules/rsconnect/shinyapps.io/cognitiveindex/freesearcheR_dev.dcf → inst/apps/freesearcheR/rsconnect/shinyapps.io/cognitiveindex/freesearcheR_dev.dcf
View file

0
inst/apps/data_analysis_modules/rsconnect/shinyapps.io/cognitiveindex/freesearcheR_extra.dcf → inst/apps/freesearcheR/rsconnect/shinyapps.io/cognitiveindex/freesearcheR_extra.dcf
View file

221
inst/apps/data_analysis_modules/server.R → inst/apps/freesearcheR/server.R
View file

@ -15,6 +15,7 @@ library(broom)
library(broom.helpers)
# library(REDCapCAST)
library(easystats)
library(esquisse)
library(patchwork)
library(DHARMa)
library(apexcharter)
@ -81,7 +82,8 @@ server <- function(input, output, session) {
data_original = NULL,
data = NULL,
data_filtered = NULL,
models = NULL
models = NULL,
code = list()
)
##############################################################################
@ -99,23 +101,48 @@ server <- function(input, output, session) {
return_class = "data.frame",
read_fns = list(
ods = function(file) {
readODS::read_ods(path = file, na = consider.na)
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")
haven::read_dta(
file = file,
.name_repair = "unique_quiet"
)
},
csv = function(file) {
readr::read_csv(file = file, na = consider.na, name_repair = "unique_quiet") #|>
# janitor::remove_empty(which = "cols", cutoff = 1, quiet = TRUE)
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)
},
# xls = function(file){
# openxlsx2::read_xlsx(file = file, na.strings = consider.na,)
# },
# xlsx = function(file){
# openxlsx2::read_xlsx(file = file, na.strings = consider.na,)
# },
rds = function(file) {
readr::read_rds(file = file, name_repair = "unique_quiet")
readr::read_rds(
file = file,
name_repair = "unique_quiet")
}
)
)
@ -123,6 +150,7 @@ server <- function(input, output, session) {
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(
@ -143,7 +171,7 @@ server <- function(input, output, session) {
server = TRUE
)
from_env <- import_globalenv_server(
from_env <- datamods::import_globalenv_server(
id = "env",
trigger_return = "change",
btn_show_data = FALSE,
@ -153,6 +181,7 @@ server <- function(input, output, session) {
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")
})
@ -214,12 +243,14 @@ server <- function(input, output, session) {
shiny::observeEvent(
input$modal_cut,
modal_cut_variable("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
@ -228,10 +259,12 @@ server <- function(input, output, session) {
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()
@ -257,25 +290,26 @@ server <- function(input, output, session) {
######### 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
)
})
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")
})
warning = function(warn) {
showNotification(paste0(warn), type = "warning")
},
error = function(err) {
showNotification(paste0(err), type = "err")
}
)
output$code <- renderPrint({
attr(rv$data, "code")
@ -312,46 +346,78 @@ server <- function(input, output, session) {
shiny::reactive(rv$data),
shiny::reactive(rv$data_original),
data_filter(),
base_vars(),
regression_vars(),
input$complete_cutoff
),
{
rv$data_filtered <- data_filter()
rv$list$data <- data_filter() |>
REDCapCAST::fct_drop() |>
(\(.x){
.x[base_vars()]
})() #|>
# janitor::remove_empty(
# which = "cols",
# cutoff = input$complete_cutoff / 100
# )
REDCapCAST::fct_drop()
}
)
output$filtered_code <- shiny::renderPrint({
out <- gsub(
"filter", "dplyr::filter",
gsub(
"\\s{2,}", " ",
paste0(
capture.output(attr(rv$data_filtered, "code")),
collapse = " "
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 ")
})()
out <- strsplit(out, "%>%") |>
unlist() |>
(\(.x){
paste(c("data", .x[-1]), collapse = "|> \n ")
})()
cat(out)
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)
})
##############################################################################
#########
@ -410,7 +476,8 @@ server <- function(input, output, session) {
)
})
base_vars <- shiny::reactive({
## Collected regression variables
regression_vars <- shiny::reactive({
if (is.null(input$include_vars)) {
out <- colnames(rv$data_filtered)
} else {
@ -426,7 +493,7 @@ server <- function(input, output, session) {
label = "Select variable to stratify baseline",
choices = c(
"none",
rv$data_filtered[base_vars()] |>
rv$data_filtered |>
(\(.x){
lapply(.x, \(.c){
if (identical("factor", class(.c))) {
@ -520,7 +587,7 @@ server <- function(input, output, session) {
choices = c(
colnames(rv$list$data)
# ,"none"
),
),
multiple = FALSE
)
})
@ -533,17 +600,26 @@ server <- function(input, output, session) {
gt::tab_header(gt::md("**Table 1: Baseline Characteristics**"))
})
data_correlations_server(id = "correlations",
data = shiny::reactive({
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_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))
##############################################################################
#########
@ -572,7 +648,10 @@ server <- function(input, output, session) {
ls <- do.call(
.fun,
c(
list(data = rv$list$data),
list(data = rv$list$data|>
(\(.x){
.x[regression_vars()]
})()),
list(outcome.str = input$outcome_var),
list(fun.descr = input$regression_type)
)
@ -865,7 +944,7 @@ server <- function(input, output, session) {
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"){
} else if (type == "csv") {
readr::write_csv(rv$list$data, file = file)
}
}

246
inst/apps/data_analysis_modules/ui.R → inst/apps/freesearcheR/ui.R
View file

@ -8,7 +8,14 @@ ui_elements <- list(
##############################################################################
"home" = bslib::nav_panel(
title = "freesearcheR",
shiny::markdown(readLines("www/intro.md")),
shiny::fluidRow(
shiny::column(width = 2),
shiny::column(
width = 8,
shiny::markdown(readLines("www/intro.md")),
shiny::column(width = 2)
)
),
icon = shiny::icon("home")
),
##############################################################################
@ -18,21 +25,22 @@ ui_elements <- list(
##############################################################################
"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",
# label = "Choice: ",
choices = c(
"File upload" = "file",
"REDCap server" = "redcap",
"Local data" = "env"
),
# checkIcon = list(
# yes = icon("square-check"),
# no = icon("square")
# ),
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."),
@ -60,14 +68,15 @@ ui_elements <- list(
shiny::h5("Exclude in-complete variables"),
shiny::p("Before going further, you can exclude variables with a low degree of completeness."),
shiny::br(),
shiny::sliderInput(
shinyWidgets::noUiSliderInput(
inputId = "complete_cutoff",
label = "Choose completeness threshold (%)",
min = 0,
max = 100,
step = 10,
value = 70,
ticks = FALSE
format = shinyWidgets::wNumbFormat(decimals = 0),
color = datamods:::get_primary_color()
),
shiny::helpText("Only include variables with completeness above a specified percentage."),
shiny::br(),
@ -80,7 +89,10 @@ ui_elements <- list(
),
shiny::helpText('After importing, hit "Start" or navigate to the desired tab.'),
shiny::br(),
shiny::br()
shiny::br(),
shiny::column(width = 2)
)
)
),
##############################################################################
#########
@ -94,75 +106,15 @@ ui_elements <- list(
title = "Data",
bslib::navset_bar(
fillable = TRUE,
bslib::nav_panel(
title = "Summary & filter",
tags$h3("Data summary 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(
# 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()
)
),
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 = "Overview",
# DT::DTOutput(outputId = "table")
# ),
bslib::nav_panel(
title = "Modify",
tags$h3("Subset, rename and convert variables"),
fluidRow(
shiny::column(
width = 9,
shiny::tags$p("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.).
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 resetting the data to the originally imported data.")
On the right, you can create and modify factor/categorical variables as well as create new variables with *R* code."))
)
),
fluidRow(
@ -199,17 +151,8 @@ ui_elements <- list(
width = "100%"
),
shiny::tags$br(),
shiny::helpText("Create a new variable/column based on an R-expression."),
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::tags$br() # ,
# shiny::tags$br(),
# shiny::tags$br(),
@ -220,10 +163,88 @@ ui_elements <- list(
)
),
bslib::nav_panel(
title = "Browser",
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 data table with all the modified data provided to browse and understand data."
"Below is a table with all the modified data provided to browse and understand data."
),
shinyWidgets::html_dependency_winbox(),
# fluidRow(
@ -323,14 +344,15 @@ ui_elements <- list(
shiny::uiOutput("outcome_var_cor"),
shiny::helpText("This variable will be excluded from the correlation plot."),
shiny::br(),
shiny::sliderInput(
shinyWidgets::noUiSliderInput(
inputId = "cor_cutoff",
label = "Correlation cut-off",
min = 0,
max = 1,
step = .02,
step = .01,
value = .8,
ticks = FALSE
format = shinyWidgets::wNumbFormat(decimals = 2),
color = datamods:::get_primary_color()
)
)
)
@ -347,6 +369,35 @@ ui_elements <- list(
),
##############################################################################
#########
######### 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
#########
##############################################################################
@ -467,11 +518,17 @@ ui_elements <- list(
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",
@ -497,6 +554,8 @@ ui_elements <- list(
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",
@ -507,6 +566,8 @@ ui_elements <- list(
"CSV" = "csv"
)
),
shiny::helpText("No metadata is saved when exporting to csv."),
shiny::br(),
shiny::br(),
# Button
shiny::downloadButton(
@ -516,7 +577,17 @@ ui_elements <- list(
)
)
),
shiny::br()
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)
)
)
),
##############################################################################
#########
@ -568,6 +639,7 @@ ui <- bslib::page_fixed(
ui_elements$import,
ui_elements$overview,
ui_elements$describe,
ui_elements$visuals,
ui_elements$analyze,
ui_elements$download,
bslib::nav_spacer(),

0
inst/apps/data_analysis_modules/www/intro.html → inst/apps/freesearcheR/www/intro.html
View file

4
inst/apps/data_analysis_modules/www/intro.md → inst/apps/freesearcheR/www/intro.md
View file

@ -1,6 +1,6 @@
# 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.
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.
@ -12,6 +12,8 @@ There are some simple steps to go through (see corresponding tabs in the top):
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

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.

0
inst/apps/data_analysis_modules/www/report.rmd → inst/apps/freesearcheR/www/report.rmd
View file

0
inst/apps/data_analysis_modules/www/umami-app.html → inst/apps/freesearcheR/www/umami-app.html
View file

113
inst/apps/teal_test/app.R
View file

@ -1,113 +0,0 @@
library(teal)
library(teal.modules.general)
library(teal.widgets)
library(readr)
library(MASS)
library(stats)
library(gtsummary)
library(gt)
library(openxlsx2)
library(haven)
library(readODS)
library(shiny)
library(bslib)
library(assertthat)
library(dplyr)
library(quarto)
library(here)
library(broom)
library(broom.helpers)
library(REDCapCAST)
library(easystats)
library(patchwork)
library(DHARMa)
# library(IDEAFilter)
# if (!requireNamespace("webResearch")) {
# devtools::install_github("agdamsbo/webResearch", quiet = TRUE, upgrade = "never")
# }
# library(webResearch)
if (file.exists(here::here("functions.R"))) {
source(here::here("functions.R"))
}
## This setup works for a single possible source
## The UI will work, even with server dependent selection and REDCap exports,
## but when submitting, it only works for the module mentioned first in the server function
## Also most data formatting is lost when passing to a teal_data_object. Bummer!
##
## FRUSTRATION!!
##
## As I read this, two different apps has to be created as things are now: one for upload, one for REDCap.
## https://insightsengineering.github.io/teal/latest-tag/articles/data-as-shiny-module.html#warning
##
##
##
## Ad option to widen data or keep long (new function, would allow easy(ish) MMRM analyses)
tm_variable_browser_module <- tm_variable_browser(
label = "Variable browser",
ggplot2_args = ggplot2_args(
labs = list(subtitle = "Plot generated by Variable Browser Module")
)
)
filters <- teal::teal_slices()
app_source <- "https://github.com/agdamsbo/freesearcheR"
gh_issues_page <- "https://github.com/agdamsbo/freesearcheR/issues"
header <- tags$span(
style = "display: flex; align-items: center; justify-content: space-between; margin: 10px 0 10px 0;",
tags$span("REDCap data evaluation", style = "font-size: 30px;") # ,
# tags$span(
# style = "display: flex; align-items: center;",
# tags$img(src = nest_logo, alt = "NEST logo", height = "45px", style = "margin-right:10px;"),
# tags$span(style = "font-size: 24px;", "agdamsbo")
# )
)
footer <- tags$p(
"This is a simple, app for REDCap-based data browsing and evaluation. Data is only stored temporarily and deleted when the browser is refreshed or closed. The app was developed by AGDamsbo using the {teal} framework for building Shiny apps:",
tags$a(href = app_source, target = "_blank", "Source Code"), ", ",
tags$a(href = gh_issues_page, target = "_blank", "Report Issues")
)
# teal_init <- function(data = tdm_redcap_read,
# filter = filters,
# modules = teal::modules(
# teal.modules.general::tm_data_table("Data Table"),
# tm_variable_browser_module
# ),
# title = teal::build_app_title("REDCap browser (teal)"),
# header = header,
# footer = footer, ...) {
# teal::init(data,
# filter,
# modules,
# title,
# header,
# footer,
# ...
# )
# }
#
# redcap_browser_app <- teal_init(data = tdm_data_upload)
app <- teal::init(
data=tdm_data_read,
# data = tdm_data_upload,
# data = tdm_redcap_read,
filter = filters,
modules = modules(
tm_data_table("Data Table"),
tm_variable_browser_module
),
title = build_app_title("REDCap data evaluation"),
header = header,
footer = footer
)
shinyApp(app$ui, app$server)