format chr as factor and stratify baseline

R/regression_model.R

@@ -15,7 +15,7 @@
 #'
 #' @examples
 #' gtsummary::trial |>
-#'   regression_model(outcome.str = "age")
+#'   regression_model(outcome.str = "age",)
 #' gtsummary::trial |>
 #'   regression_model(
 #'     outcome.str = "age",
@@ -35,7 +35,11 @@ regression_model <- function(data,
                              args.list = NULL,
                              fun = NULL,
                              vars = NULL) {
-  if (!is.null(formula.str) | formula.str != "") {
+  if (formula.str==""){
+    formula.str <- NULL
+  }
+
+  if (!is.null(formula.str)) {
     formula.str <- glue::glue(formula.str)
   } else {
     assertthat::assert_that(outcome.str %in% names(data),

app/functions.R

@@ -131,6 +131,19 @@ read_input <- function(file, consider.na = c("NA", '""', "")) {
 
 
 
+
+
+
+
+
+
+
+
+argsstring2list <- function(string){
+  eval(parse(text = paste0("list(", string, ")")))
+}
+
+
 ########
 #### Current file: R//regression_model.R 
 ########
@@ -172,6 +185,10 @@ regression_model <- function(data,
                              args.list = NULL,
                              fun = NULL,
                              vars = NULL) {
+  if (formula.str==""){
+    formula.str <- NULL
+  }
+
   if (!is.null(formula.str)) {
     formula.str <- glue::glue(formula.str)
   } else {
@@ -181,10 +198,10 @@ regression_model <- function(data,
     formula.str <- glue::glue("{outcome.str}~.")
 
     if (!is.null(vars)) {
-      if (outcome.str %in% vars){
+      if (outcome.str %in% vars) {
         vars <- vars[vars %in% outcome.str]
       }
-      data <- data |> dplyr::select(dplyr::all_of(c(vars,outcome.str)))
+      data <- data |> dplyr::select(dplyr::all_of(c(vars, outcome.str)))
     }
   }
 
@@ -194,16 +211,15 @@ regression_model <- function(data,
 
   # browser()
   if (auto.mode) {
-    if (is.numeric(data[[outcome.str]])){
+    if (is.numeric(data[[outcome.str]])) {
       fun <- "stats::lm"
-    } else if (is.factor(data[[outcome.str]])){
+    } else if (is.factor(data[[outcome.str]])) {
-      if (length(levels(data[[outcome.str]]))==2){
+      if (length(levels(data[[outcome.str]])) == 2) {
         fun <- "stats::glm"
-        args.list = list(family = binomial(link = "logit"))
+        args.list <- list(family = binomial(link = "logit"))
-
+      } else if (length(levels(data[[outcome.str]])) > 2) {
-      } else if (length(levels(data[[outcome.str]]))>2){
         fun <- "MASS::polr"
-        args.list = list(
+        args.list <- list(
           Hess = TRUE,
           method = "logistic"
         )
@@ -213,7 +229,6 @@ regression_model <- function(data,
     } else {
       stop("Output variable should be either numeric or factor for auto.mode")
     }
-
   }
 
   assertthat::assert_that("character" %in% class(fun),

app/server.R

@@ -1,5 +1,5 @@
 # project.aid::merge_scripts(list.files("R/",full.names = TRUE),dest = here::here("app/functions.R"))
-# source(here::here("functions.R"))
+# source(here::here("app/functions.R"))
 
 source("https://raw.githubusercontent.com/agdamsbo/webResearch/refs/heads/main/app/functions.R")
 
@@ -43,7 +43,7 @@ server <- function(input, output, session) {
       inputId = "include_vars",
       selected = NULL,
       label = "Covariables to include",
-      choices = colnames(ds()),
+      choices = colnames(ds())[-match(input$outcome_var, colnames(ds()))],
       multiple = TRUE
     )
   })
@@ -70,12 +70,25 @@ server <- function(input, output, session) {
     {
       shiny::req(input$outcome_var)
 
-      v$list <- ds() |>
+      # Assumes all character variables can be formatted as factors
-        (\(data){
+      data <- ds() |>
-          # browser()
+        dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor))
-          list(
+
+      if (is.factor(data[[input$outcome_var]])) {
+        by.var <- input$outcome_var
+      } else {
+        by.var <- NULL
+      }
+
+      v$list <- list(
             data = data,
-            table1 = data |> baseline_table(),
+            table1 = data |>
+              baseline_table(
+                fun.args =
+                  list(
+                    by = by.var
+                  )
+              ),
             table2 = data |>
               regression_model(
                 outcome.str = input$outcome_var,
@@ -87,7 +100,6 @@ server <- function(input, output, session) {
               ) |>
               regression_table()
           )
-        })()
 
       output$table1 <- gt::render_gt(
         v$list$table1 |>
@@ -98,7 +110,6 @@ server <- function(input, output, session) {
         v$list$table2 |>
           gtsummary::as_gt()
       )
-
     }
   )
 
@@ -129,8 +140,10 @@ server <- function(input, output, session) {
     filename = "analyses.html",
     content = function(file) {
       v$list |>
-        write_quarto(file = file,
+        write_quarto(
-                     qmd.file = "www/analyses.qmd")
+          file = file,
+          qmd.file = "www/analyses.qmd"
+        )
     }
   )
 

app/ui.R

@@ -28,6 +28,15 @@ cards <- list(
   )
 )
 
+panels <- list(
+  bslib::nav_panel(title="Data overview",
+                   shiny::uiOutput("data.input")),
+  bslib::nav_panel(title="Baseline characteristics",
+                   gt::gt_output(outputId = "table1")),
+  bslib::nav_panel(title="Multivariable regression table",
+                   gt::gt_output(outputId = "table2"))
+)
+
 
 ui <- bslib::page_sidebar(
   theme = bslib::bs_theme(bootswatch = "minty"),
@@ -73,7 +82,7 @@ ui <- bslib::page_sidebar(
         textInput(
           inputId = "regression_formula",
           label = "Formula string to render with 'glue::glue'",
-          value = "{outcome.str}~."
+          value = NULL
         ),
         textInput(
           inputId = "regression_fun",
@@ -115,10 +124,17 @@ ui <- bslib::page_sidebar(
      #                label= "Download",
      #                icon = shiny::icon("download"))
   ),
-  layout_columns(
+  bslib::navset_card_underline(
-    cards[[1]]
+    title="Data and results",
-  ),
+    panels[[1]],
-  layout_columns(
+    panels[[2]],
-    cards[[2]], cards[[3]]
+    panels[[3]]
   )
+
+  # layout_columns(
+  #   cards[[1]]
+  # ),
+  # layout_columns(
+  #   cards[[2]], cards[[3]]
+  # )
 )

publish_shiny.R

@@ -4,6 +4,7 @@
 project.aid::merge_scripts(list.files("R/",full.names = TRUE),dest = here::here("app/functions.R"))
 
 # Typical shiny
+shiny::runApp(appDir = here::here("app/"))
 shiny::runApp(appDir = here::here("app/"), launch.browser = TRUE)
 
 project.aid::deploy_shiny(