andreas/FreesearchR
1
0
Fork 0
mirror of https://github.com/agdamsbo/FreesearchR.git synced 2025-09-12 09:59:39 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

correctly store regression results in list, use readr for csv import, optional p-value in regression table

Browse source
This commit is contained in:
Andreas Gammelgaard Damsbo 2025-01-20 11:27:54 +01:00
parent 7e90d38380
commit dc571182af
No known key found for this signature in database
4 changed files with 154 additions and 69 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

93
inst/apps/data_analysis_modules/app.R
View file

@ -3664,6 +3664,16 @@ ui_elements <- list(
# )
# ),
shiny::uiOutput("regression_type"),
shiny::radioButtons(
inputId = "add_regression_p",
label = "Add p-value",
inline = TRUE,
selected = "no",
choices = list(
"Yes" = "yes",
"No" = "no"
)
),
bslib::input_task_button(
id = "load",
label = "Analyse",
@ -3677,7 +3687,7 @@ ui_elements <- list(
type = "secondary",
auto_reset = TRUE
),
shiny::helpText("If you change the parameters, press 'Analyse' again to update the tables")
shiny::helpText("If you change the parameters, press 'Analyse' again to update the regression analysis")
),
bslib::accordion_panel(
value="acc_down",
@ -3825,7 +3835,7 @@ ui <- bslib::page_fixed(
),
shiny::p(
style = "margin: 1; color: #888;",
"Andreas G Damsbo | AGPLv3 license | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/freesearcheR/", target = "_blank", rel = "noopener noreferrer")
"AG Damsbo | v", format(Sys.Date(),format = '%y%m%d')," | AGPLv3 license | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/freesearcheR/", target = "_blank", rel = "noopener noreferrer")
),
)
)
@ -3939,6 +3949,9 @@ server <- function(input, output, session) {
},
dta = function(file) {
haven::read_dta(file = file)
},
csv = function(file){
readr::read_csv(file)
}
)
)
@ -4056,7 +4069,12 @@ server <- function(input, output, session) {
id = "modal_column",
data_r = reactive(rv$data)
)
shiny::observeEvent(data_modal_r(), rv$data <- data_modal_r())
shiny::observeEvent(
data_modal_r(),
{
rv$data <- data_modal_r()
}
)
######### Show result
@ -4065,7 +4083,7 @@ server <- function(input, output, session) {
# data <- rv$data
toastui::datagrid(
# data = rv$data # ,
data = data_filter()
data = data_filter(),pagination = 30,
# bordered = TRUE,
# compact = TRUE,
# striped = TRUE
@ -4108,7 +4126,8 @@ server <- function(input, output, session) {
shiny::reactive(rv$data_original),
data_filter(),
base_vars()
), {
),
{
rv$data_filtered <- data_filter()
rv$list$data <- data_filter() |>
@ -4116,7 +4135,8 @@ server <- function(input, output, session) {
(\(.x){
.x[base_vars()]
})()
})
}
)
output$filtered_code <- shiny::renderPrint({
out <- gsub(
@ -4143,7 +4163,7 @@ server <- function(input, output, session) {
##############################################################################
#########
######### Data analyses section
######### Data analyses Inputs
#########
##############################################################################
@ -4300,11 +4320,19 @@ server <- function(input, output, session) {
# gt::tab_header(shiny::md("**Table 1. Patient Characteristics**"))
# )
##############################################################################
#########
######### Data analyses results
#########
##############################################################################
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
@ -4364,6 +4392,10 @@ server <- function(input, output, session) {
# 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
@ -4379,7 +4411,16 @@ server <- function(input, output, session) {
)
})
rv$models <- model_lists
# browser()
rv$list$regression$options <- 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
@ -4398,13 +4439,13 @@ server <- function(input, output, session) {
shiny::observeEvent(
ignoreInit = TRUE,
list(
rv$models
rv$list$regression$models
),
{
shiny::req(rv$models)
shiny::req(rv$list$regression$models)
tryCatch(
{
rv$check <- lapply(rv$models, \(.x){
rv$check <- lapply(rv$list$regression$models, \(.x){
.x$model
}) |>
purrr::pluck("Multivariable") |>
@ -4440,22 +4481,26 @@ server <- function(input, output, session) {
shiny::observeEvent(
input$load,
{
shiny::req(rv$models)
# browser()
# Assumes all character variables can be formatted as factors
# data <- data_filter$filtered() |>
shiny::req(rv$list$regression$models)
tryCatch(
{
tbl <- lapply(rv$models, \(.x){
out <- lapply(rv$list$regression$models, \(.x){
.x$model
}) |>
purrr::map(regression_table) |>
tbl_merge()
purrr::map(regression_table)
rv$list$regression <- c(
rv$models,
list(Table = tbl)
if (input$add_regression_p == "no") {
out <- out |>
lapply(\(.x){
.x |>
gtsummary::modify_column_hide(
column = "p.value"
)
})
}
rv$list$regression$table <- out |>
tbl_merge()
rv$list$input <- input
},
@ -4471,10 +4516,10 @@ server <- function(input, output, session) {
)
output$table2 <- gt::render_gt({
shiny::req(rv$list$regression$Table)
rv$list$regression$Table |>
shiny::req(rv$list$regression$table)
rv$list$regression$table |>
gtsummary::as_gt() |>
gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$Multivariable$options$descr}**")))
gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$options$descr}**")))
})

76
inst/apps/data_analysis_modules/server.R
View file

@ -101,6 +101,9 @@ server <- function(input, output, session) {
},
dta = function(file) {
haven::read_dta(file = file)
},
csv = function(file){
readr::read_csv(file)
}
)
)
@ -219,9 +222,11 @@ server <- function(input, output, session) {
data_r = reactive(rv$data)
)
shiny::observeEvent(
data_modal_r(), {
data_modal_r(),
{
rv$data <- data_modal_r()
})
}
)
######### Show result
@ -230,7 +235,7 @@ server <- function(input, output, session) {
# data <- rv$data
toastui::datagrid(
# data = rv$data # ,
data = data_filter(),
data = data_filter(),pagination = 30,
# bordered = TRUE,
# compact = TRUE,
# striped = TRUE
@ -273,7 +278,8 @@ server <- function(input, output, session) {
shiny::reactive(rv$data_original),
data_filter(),
base_vars()
), {
),
{
rv$data_filtered <- data_filter()
rv$list$data <- data_filter() |>
@ -281,7 +287,8 @@ server <- function(input, output, session) {
(\(.x){
.x[base_vars()]
})()
})
}
)
output$filtered_code <- shiny::renderPrint({
out <- gsub(
@ -308,7 +315,7 @@ server <- function(input, output, session) {
##############################################################################
#########
######### Data analyses section
######### Data analyses Inputs
#########
##############################################################################
@ -465,6 +472,12 @@ server <- function(input, output, session) {
# gt::tab_header(shiny::md("**Table 1. Patient Characteristics**"))
# )
##############################################################################
#########
######### Data analyses results
#########
##############################################################################
shiny::observeEvent(
# ignoreInit = TRUE,
list(
@ -531,6 +544,10 @@ server <- function(input, output, session) {
# 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
@ -546,7 +563,16 @@ server <- function(input, output, session) {
)
})
rv$models <- model_lists
# browser()
rv$list$regression$options <- 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
@ -565,13 +591,13 @@ server <- function(input, output, session) {
shiny::observeEvent(
ignoreInit = TRUE,
list(
rv$models
rv$list$regression$models
),
{
shiny::req(rv$models)
shiny::req(rv$list$regression$models)
tryCatch(
{
rv$check <- lapply(rv$models, \(.x){
rv$check <- lapply(rv$list$regression$models, \(.x){
.x$model
}) |>
purrr::pluck("Multivariable") |>
@ -607,22 +633,26 @@ server <- function(input, output, session) {
shiny::observeEvent(
input$load,
{
shiny::req(rv$models)
# browser()
# Assumes all character variables can be formatted as factors
# data <- data_filter$filtered() |>
shiny::req(rv$list$regression$models)
tryCatch(
{
tbl <- lapply(rv$models, \(.x){
out <- lapply(rv$list$regression$models, \(.x){
.x$model
}) |>
purrr::map(regression_table) |>
tbl_merge()
purrr::map(regression_table)
rv$list$regression <- c(
rv$models,
list(Table = tbl)
if (input$add_regression_p == "no") {
out <- out |>
lapply(\(.x){
.x |>
gtsummary::modify_column_hide(
column = "p.value"
)
})
}
rv$list$regression$table <- out |>
tbl_merge()
rv$list$input <- input
},
@ -638,10 +668,10 @@ server <- function(input, output, session) {
)
output$table2 <- gt::render_gt({
shiny::req(rv$list$regression$Table)
rv$list$regression$Table |>
shiny::req(rv$list$regression$table)
rv$list$regression$table |>
gtsummary::as_gt() |>
gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$Multivariable$options$descr}**")))
gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$options$descr}**")))
})

12
inst/apps/data_analysis_modules/ui.R
View file

@ -331,6 +331,16 @@ ui_elements <- list(
# )
# ),
shiny::uiOutput("regression_type"),
shiny::radioButtons(
inputId = "add_regression_p",
label = "Add p-value",
inline = TRUE,
selected = "no",
choices = list(
"Yes" = "yes",
"No" = "no"
)
),
bslib::input_task_button(
id = "load",
label = "Analyse",
@ -344,7 +354,7 @@ ui_elements <- list(
type = "secondary",
auto_reset = TRUE
),
shiny::helpText("If you change the parameters, press 'Analyse' again to update the tables")
shiny::helpText("If you change the parameters, press 'Analyse' again to update the regression analysis")
),
bslib::accordion_panel(
value="acc_down",

12
inst/apps/data_analysis_modules/www/report.qmd
View file

@ -2,9 +2,9 @@
format:
html:
embed-resources: true
title: "webResearch analysis results"
title: "freesearcheR analysis results"
date: today
author: webResearch Tool
author: freesearcheR Tool
toc: true
execute:
echo: false
@ -17,12 +17,12 @@ web_data <- readr::read_rds(file = params$data.file)
library(gtsummary)
library(gt)
library(flextable)
# library(webResearch)
# library(freesearcheR)
```
## 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.
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
@ -40,12 +40,12 @@ web_data$table1 |>
flextable::set_table_properties(width = 1, layout = "autofit")
```
Here are the results from the `r web_data$regression$Multivariable$options$descr`.
Here are the results from the `r web_data$regression$options$descr`.
```{r}
#| label: tbl-regression
#| tbl-cap: Regression analysis results
web_data$regression$Table|>
web_data$regression$table|>
gtsummary::as_flex_table() |>
flextable::set_table_properties(width = 1, layout = "autofit")
```