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::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( bslib::input_task_button(
id = "load", id = "load",
label = "Analyse", label = "Analyse",
@ -3677,7 +3687,7 @@ ui_elements <- list(
type = "secondary", type = "secondary",
auto_reset = TRUE 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( bslib::accordion_panel(
value="acc_down", value="acc_down",
@ -3825,7 +3835,7 @@ ui <- bslib::page_fixed(
), ),
shiny::p( shiny::p(
style = "margin: 1; color: #888;", 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) { dta = function(file) {
haven::read_dta(file = 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", id = "modal_column",
data_r = reactive(rv$data) 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 ######### Show result
@ -4065,7 +4083,7 @@ server <- function(input, output, session) {
# data <- rv$data # data <- rv$data
toastui::datagrid( toastui::datagrid(
# data = rv$data # , # data = rv$data # ,
data = data_filter() data = data_filter(),pagination = 30,
# bordered = TRUE, # bordered = TRUE,
# compact = TRUE, # compact = TRUE,
# striped = TRUE # striped = TRUE
@ -4108,7 +4126,8 @@ server <- function(input, output, session) {
shiny::reactive(rv$data_original), shiny::reactive(rv$data_original),
data_filter(), data_filter(),
base_vars() base_vars()
), { ),
{
rv$data_filtered <- data_filter() rv$data_filtered <- data_filter()
rv$list$data <- data_filter() |> rv$list$data <- data_filter() |>
@ -4116,7 +4135,8 @@ server <- function(input, output, session) {
(\(.x){ (\(.x){
.x[base_vars()] .x[base_vars()]
})() })()
}) }
)
output$filtered_code <- shiny::renderPrint({ output$filtered_code <- shiny::renderPrint({
out <- gsub( 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**")) # gt::tab_header(shiny::md("**Table 1. Patient Characteristics**"))
# ) # )
##############################################################################
#########
######### Data analyses results
#########
##############################################################################
shiny::observeEvent( shiny::observeEvent(
# ignoreInit = TRUE, # ignoreInit = TRUE,
list( list(
shiny::reactive(rv$list$data), shiny::reactive(rv$list$data),
shiny::reactive(rv$data), shiny::reactive(rv$data),
shiny::reactive(rv$data_original),
data_filter(),
input$strat_var, input$strat_var,
input$include_vars, input$include_vars,
input$add_p input$add_p
@ -4364,6 +4392,10 @@ server <- function(input, output, session) {
# data <- data_filter$filtered() |> # data <- data_filter$filtered() |>
tryCatch( tryCatch(
{ {
## Which models to create should be decided by input
## Could also include
## imputed or
## minimally adjusted
model_lists <- list( model_lists <- list(
"Univariable" = regression_model_uv_list, "Univariable" = regression_model_uv_list,
"Multivariable" = regression_model_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){ # rv$models <- lapply(model_lists, \(.x){
# .x$model # .x$model
@ -4398,13 +4439,13 @@ server <- function(input, output, session) {
shiny::observeEvent( shiny::observeEvent(
ignoreInit = TRUE, ignoreInit = TRUE,
list( list(
rv$models rv$list$regression$models
), ),
{ {
shiny::req(rv$models) shiny::req(rv$list$regression$models)
tryCatch( tryCatch(
{ {
rv$check <- lapply(rv$models, \(.x){ rv$check <- lapply(rv$list$regression$models, \(.x){
.x$model .x$model
}) |> }) |>
purrr::pluck("Multivariable") |> purrr::pluck("Multivariable") |>
@ -4440,22 +4481,26 @@ server <- function(input, output, session) {
shiny::observeEvent( shiny::observeEvent(
input$load, input$load,
{ {
shiny::req(rv$models) shiny::req(rv$list$regression$models)
# browser()
# Assumes all character variables can be formatted as factors
# data <- data_filter$filtered() |>
tryCatch( tryCatch(
{ {
tbl <- lapply(rv$models, \(.x){ out <- lapply(rv$list$regression$models, \(.x){
.x$model .x$model
}) |> }) |>
purrr::map(regression_table) |> purrr::map(regression_table)
tbl_merge()
rv$list$regression <- c( if (input$add_regression_p == "no") {
rv$models, out <- out |>
list(Table = tbl) lapply(\(.x){
.x |>
gtsummary::modify_column_hide(
column = "p.value"
) )
})
}
rv$list$regression$table <- out |>
tbl_merge()
rv$list$input <- input rv$list$input <- input
}, },
@ -4471,10 +4516,10 @@ server <- function(input, output, session) {
) )
output$table2 <- gt::render_gt({ output$table2 <- gt::render_gt({
shiny::req(rv$list$regression$Table) shiny::req(rv$list$regression$table)
rv$list$regression$Table |> rv$list$regression$table |>
gtsummary::as_gt() |> 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) { dta = function(file) {
haven::read_dta(file = 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) data_r = reactive(rv$data)
) )
shiny::observeEvent( shiny::observeEvent(
data_modal_r(), { data_modal_r(),
{
rv$data <- data_modal_r() rv$data <- data_modal_r()
}) }
)
######### Show result ######### Show result
@ -230,7 +235,7 @@ server <- function(input, output, session) {
# data <- rv$data # data <- rv$data
toastui::datagrid( toastui::datagrid(
# data = rv$data # , # data = rv$data # ,
data = data_filter(), data = data_filter(),pagination = 30,
# bordered = TRUE, # bordered = TRUE,
# compact = TRUE, # compact = TRUE,
# striped = TRUE # striped = TRUE
@ -273,7 +278,8 @@ server <- function(input, output, session) {
shiny::reactive(rv$data_original), shiny::reactive(rv$data_original),
data_filter(), data_filter(),
base_vars() base_vars()
), { ),
{
rv$data_filtered <- data_filter() rv$data_filtered <- data_filter()
rv$list$data <- data_filter() |> rv$list$data <- data_filter() |>
@ -281,7 +287,8 @@ server <- function(input, output, session) {
(\(.x){ (\(.x){
.x[base_vars()] .x[base_vars()]
})() })()
}) }
)
output$filtered_code <- shiny::renderPrint({ output$filtered_code <- shiny::renderPrint({
out <- gsub( 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**")) # gt::tab_header(shiny::md("**Table 1. Patient Characteristics**"))
# ) # )
##############################################################################
#########
######### Data analyses results
#########
##############################################################################
shiny::observeEvent( shiny::observeEvent(
# ignoreInit = TRUE, # ignoreInit = TRUE,
list( list(
@ -531,6 +544,10 @@ server <- function(input, output, session) {
# data <- data_filter$filtered() |> # data <- data_filter$filtered() |>
tryCatch( tryCatch(
{ {
## Which models to create should be decided by input
## Could also include
## imputed or
## minimally adjusted
model_lists <- list( model_lists <- list(
"Univariable" = regression_model_uv_list, "Univariable" = regression_model_uv_list,
"Multivariable" = regression_model_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){ # rv$models <- lapply(model_lists, \(.x){
# .x$model # .x$model
@ -565,13 +591,13 @@ server <- function(input, output, session) {
shiny::observeEvent( shiny::observeEvent(
ignoreInit = TRUE, ignoreInit = TRUE,
list( list(
rv$models rv$list$regression$models
), ),
{ {
shiny::req(rv$models) shiny::req(rv$list$regression$models)
tryCatch( tryCatch(
{ {
rv$check <- lapply(rv$models, \(.x){ rv$check <- lapply(rv$list$regression$models, \(.x){
.x$model .x$model
}) |> }) |>
purrr::pluck("Multivariable") |> purrr::pluck("Multivariable") |>
@ -607,22 +633,26 @@ server <- function(input, output, session) {
shiny::observeEvent( shiny::observeEvent(
input$load, input$load,
{ {
shiny::req(rv$models) shiny::req(rv$list$regression$models)
# browser()
# Assumes all character variables can be formatted as factors
# data <- data_filter$filtered() |>
tryCatch( tryCatch(
{ {
tbl <- lapply(rv$models, \(.x){ out <- lapply(rv$list$regression$models, \(.x){
.x$model .x$model
}) |> }) |>
purrr::map(regression_table) |> purrr::map(regression_table)
tbl_merge()
rv$list$regression <- c( if (input$add_regression_p == "no") {
rv$models, out <- out |>
list(Table = tbl) lapply(\(.x){
.x |>
gtsummary::modify_column_hide(
column = "p.value"
) )
})
}
rv$list$regression$table <- out |>
tbl_merge()
rv$list$input <- input rv$list$input <- input
}, },
@ -638,10 +668,10 @@ server <- function(input, output, session) {
) )
output$table2 <- gt::render_gt({ output$table2 <- gt::render_gt({
shiny::req(rv$list$regression$Table) shiny::req(rv$list$regression$table)
rv$list$regression$Table |> rv$list$regression$table |>
gtsummary::as_gt() |> 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::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( bslib::input_task_button(
id = "load", id = "load",
label = "Analyse", label = "Analyse",
@ -344,7 +354,7 @@ ui_elements <- list(
type = "secondary", type = "secondary",
auto_reset = TRUE 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( bslib::accordion_panel(
value="acc_down", value="acc_down",

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

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