From dc571182af5bbe19d495c2d62e0c8a652f4f64f4 Mon Sep 17 00:00:00 2001
From: Andreas Gammelgaard Damsbo <andreas@gdamsbo.dk>
Date: Mon, 20 Jan 2025 11:27:54 +0100
Subject: [PATCH] correctly store regression results in list, use readr for csv
 import, optional p-value in regression table

---
 inst/apps/data_analysis_modules/app.R         | 107 +++++++++++++-----
 inst/apps/data_analysis_modules/server.R      |  92 ++++++++++-----
 inst/apps/data_analysis_modules/ui.R          |  12 +-
 .../apps/data_analysis_modules/www/report.qmd |  12 +-
 4 files changed, 154 insertions(+), 69 deletions(-)

diff --git a/inst/apps/data_analysis_modules/app.R b/inst/apps/data_analysis_modules/app.R
index ee21fe5..4f5923c 100644
--- a/inst/apps/data_analysis_modules/app.R
+++ b/inst/apps/data_analysis_modules/app.R
@@ -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,15 +4126,17 @@ server <- function(input, output, session) {
       shiny::reactive(rv$data_original),
       data_filter(),
       base_vars()
-      ), {
-    rv$data_filtered <- data_filter()
+    ),
+    {
+      rv$data_filtered <- data_filter()
 
-    rv$list$data <- data_filter() |>
-      REDCapCAST::fct_drop.data.frame() |>
-      (\(.x){
-        .x[base_vars()]
-      })()
-  })
+      rv$list$data <- data_filter() |>
+        REDCapCAST::fct_drop.data.frame() |>
+        (\(.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}**")))
   })
 
 
diff --git a/inst/apps/data_analysis_modules/server.R b/inst/apps/data_analysis_modules/server.R
index 43a9797..1fabdca 100644
--- a/inst/apps/data_analysis_modules/server.R
+++ b/inst/apps/data_analysis_modules/server.R
@@ -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(), {
-    rv$data <- 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,15 +278,17 @@ server <- function(input, output, session) {
       shiny::reactive(rv$data_original),
       data_filter(),
       base_vars()
-      ), {
-    rv$data_filtered <- data_filter()
+    ),
+    {
+      rv$data_filtered <- data_filter()
 
-    rv$list$data <- data_filter() |>
-      REDCapCAST::fct_drop.data.frame() |>
-      (\(.x){
-        .x[base_vars()]
-      })()
-  })
+      rv$list$data <- data_filter() |>
+        REDCapCAST::fct_drop.data.frame() |>
+        (\(.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}**")))
   })
 
 
diff --git a/inst/apps/data_analysis_modules/ui.R b/inst/apps/data_analysis_modules/ui.R
index 7611bc1..ed437f2 100644
--- a/inst/apps/data_analysis_modules/ui.R
+++ b/inst/apps/data_analysis_modules/ui.R
@@ -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",
diff --git a/inst/apps/data_analysis_modules/www/report.qmd b/inst/apps/data_analysis_modules/www/report.qmd
index c2acb74..9ddee9e 100644
--- a/inst/apps/data_analysis_modules/www/report.qmd
+++ b/inst/apps/data_analysis_modules/www/report.qmd
@@ -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")
 ```