modifications to ui and using DT for tables

DESCRIPTION

@@ -26,7 +26,10 @@ Imports:
     REDCapCAST,
     purrr,
     broom,
-    broom.helpers
+    broom.helpers,
+    cardx,
+    parameters,
+    DT
 Suggests: 
     styler,
     devtools,

NAMESPACE

@@ -1,5 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(regression_table,list)
+S3method(regression_table,webresearch_model)
 export(argsstring2list)
 export(baseline_table)
 export(default_format_arguments)
@@ -8,11 +10,12 @@ export(format_writer)
 export(getfun)
 export(index_embed)
 export(modify_qmd)
-export(panel_space)
 export(read_input)
 export(regression_model)
+export(regression_model_uv)
 export(regression_table)
 export(shiny_webResearch)
 export(specify_qmd_format)
+export(tbl_merge)
 export(write_quarto)
 importFrom(stats,as.formula)

R/helpers.R

@@ -118,7 +118,11 @@ dummy_Imports <- function() {
     MASS::as.fractions(),
     broom::augment(),
     broom.helpers::all_categorical(),
-    here::here()
+    here::here(),
+    cardx::all_of(),
+    parameters::ci(),
+    DT::addRow(),
+    bslib::accordion()
     )
   #https://github.com/hadley/r-pkgs/issues/828
   }

R/regression_model.R

@@ -1,4 +1,4 @@
-#' Print a flexible baseline characteristics table
+#' Create a regression model programatically
 #'
 #' @param data data set
 #' @param fun Name of function as character vector or function to use for model creation.
@@ -7,6 +7,7 @@
 #' @param auto.mode Make assumptions on function dependent on outcome data format. Overwrites other arguments.
 #' @param formula.str Formula as string. Passed through 'glue::glue'. If given, 'outcome.str' and 'vars' are ignored. Optional.
 #' @param args.list List of arguments passed to 'fun' with 'do.call'.
+#' @param ... ignored for now
 #'
 #' @importFrom stats as.formula
 #'
@@ -36,7 +37,8 @@ regression_model <- function(data,
                              formula.str = NULL,
                              args.list = NULL,
                              fun = NULL,
-                             vars = NULL) {
+                             vars = NULL,
+                             ...) {
   if (!is.null(formula.str)) {
     if (formula.str == "") {
       formula.str <- NULL
@@ -61,9 +63,18 @@ regression_model <- function(data,
 
   # Formatting character variables as factor
   # Improvement should add a missing vector to format as NA
-  data <- data |> dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor))
+  data <- data |>
+    purrr::map(\(.x){
+      if (is.character(.x)) {
+        suppressWarnings(REDCapCAST::as_factor(.x))
+      } else {
+        .x
+      }
+    }) |>
+    dplyr::bind_cols()
+
+  if (is.null(fun)) auto.mode <- TRUE
 
-  # browser()
   if (auto.mode) {
     if (is.numeric(data[[outcome.str]])) {
       fun <- "stats::lm"
@@ -101,5 +112,93 @@ regression_model <- function(data,
   # Recreating the call
   # out$call <-  match.call(definition=eval(parse(text=fun)), call(fun, data = 'data',formula = as.formula(formula.str),args.list))
 
+  class(out) <- c("webresearch_model", class(out))
+  return(out)
+}
+
+#' Create a regression model programatically
+#'
+#' @param data data set
+#' @param fun Name of function as character vector or function to use for model creation.
+#' @param vars character vector of variables to include
+#' @param outcome.str Name of outcome variable. Character vector.
+#' @param args.list List of arguments passed to 'fun' with 'do.call'.
+#' @param ... ignored for now
+#'
+#' @importFrom stats as.formula
+#'
+#' @return object of standard class for fun
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' gtsummary::trial |>
+#'   regression_model_uv(outcome.str = "age")
+#' gtsummary::trial |>
+#'   regression_model_uv(
+#'     outcome.str = "age",
+#'     fun = "stats::lm",
+#'     args.list = NULL
+#'   )
+#' gtsummary::trial |> regression_model_uv(
+#'   outcome.str = "trt",
+#'   fun = "stats::glm",
+#'   args.list = list(family = stats::binomial(link = "logit"))
+#' )
+#' }
+regression_model_uv <- function(data,
+                                outcome.str,
+                                args.list = NULL,
+                                fun = NULL,
+                                vars = NULL,
+                                ...) {
+  if (!is.null(vars)) {
+    data <- data |>
+      dplyr::select(dplyr::all_of(
+        unique(c(outcome.str, vars))
+      ))
+  }
+
+  if (is.null(args.list)) {
+    args.list <- list()
+  }
+
+  if (is.null(fun)) {
+    if (is.numeric(data[[outcome.str]])) {
+      fun <- "stats::lm"
+    } else if (is.factor(data[[outcome.str]])) {
+      if (length(levels(data[[outcome.str]])) == 2) {
+        fun <- "stats::glm"
+        args.list <- list(family = stats::binomial(link = "logit"))
+      } else if (length(levels(data[[outcome.str]])) > 2) {
+        fun <- "MASS::polr"
+        args.list <- list(
+          Hess = TRUE,
+          method = "logistic"
+        )
+      } else {
+        stop("The provided output variable only has one level")
+      }
+    } else {
+      stop("Output variable should be either numeric or factor for auto.mode")
+    }
+  }
+
+  assertthat::assert_that("character" %in% class(fun),
+    msg = "Please provide the function as a character vector."
+  )
+
+  out <- names(data)[!names(data) %in% outcome.str] |>
+    purrr::map(\(.var){
+      do.call(
+        regression_model,
+        c(
+          list(data = data[match(c(outcome.str,.var),names(data))]),
+          list(outcome.str=outcome.str),
+          list(args.list=args.list)
+        )
+      )
+    })
+
   return(out)
 }

R/regression_table.R

@@ -1,13 +1,16 @@
 #' Create table of regression model
 #'
-#' @param data regression model
+#' @param x regression model
 #' @param args.list list of arguments passed to 'fun'.
 #' @param fun function to use for table creation. Default is "gtsummary::tbl_regression".
+#' @param ... passed to methods
 #'
 #' @return object of standard class for fun
 #' @export
+#' @name regression_table
 #'
 #' @examples
+#' \dontrun{
 #' gtsummary::trial |>
 #'   regression_model(
 #'     outcome.str = "stage",
@@ -29,14 +32,82 @@
 #'     args.list = list(family = binomial(link = "logit"))
 #'   ) |>
 #'   regression_table()
-regression_table <- function(data, args.list = NULL, fun = "gtsummary::tbl_regression") {
+#' gtsummary::trial |>
+#'   regression_model_uv(
+#'     outcome.str = "trt",
+#'     fun = "stats::glm",
+#'     args.list = list(family = stats::binomial(link = "logit"))
+#'   ) |>
+#'   regression_table()
+#' gtsummary::trial |>
+#'   regression_model_uv(
+#'     outcome.str = "stage",
+#'     args.list = list(family = stats::binomial(link = "logit"))
+#'   ) |>
+#'   regression_table()
+#'
+#' list(
+#'   "Univariable" = regression_model_uv,
+#'   "Multivariable" = regression_model
+#' ) |>
+#'   lapply(\(.fun){
+#'     do.call(
+#'       .fun,
+#'       c(
+#'         list(data = gtsummary::trial),
+#'         list(outcome.str = "stage")
+#'       )
+#'     )
+#'   }) |>
+#'   purrr::map(regression_table) |>
+#'   tbl_merge()
+#'   }
+regression_table <- function(x, ...) {
+  UseMethod("regression_table")
+}
 
-  if (any(c(length(class(data))!=1, class(data)!="lm"))){
+#' @rdname regression_table
-    if (!"exponentiate" %in% names(args.list)){
+#' @export
-      args.list <- c(args.list,list(exponentiate=TRUE))
+regression_table.list <- function(x, ...) {
+  x |>
+    purrr::map(\(.m){
+      regression_table(x = .m, ...) |>
+        gtsummary::add_n()
+    }) |>
+    gtsummary::tbl_stack()
+}
+
+#' @rdname regression_table
+#' @export
+regression_table.webresearch_model <- function(x, ..., args.list = NULL, fun = "gtsummary::tbl_regression") {
+  # Stripping custom class
+  class(x) <- class(x)[class(x) != "webresearch_model"]
+
+  if (any(c(length(class(x)) != 1, class(x) != "lm"))) {
+    if (!"exponentiate" %in% names(args.list)) {
+      args.list <- c(args.list, list(exponentiate = TRUE))
     }
   }
 
-  out <- do.call(getfun(fun), c(list(x = data), args.list))
+  out <- do.call(getfun(fun), c(list(x = x), args.list))
-  out |> gtsummary::add_glance_source_note()
+  out |>
+    gtsummary::add_glance_source_note() # |>
+  # gtsummary::bold_p()
+}
+
+
+#' A substitue to gtsummary::tbl_merge, that will use list names for the tab
+#' spanner names.
+#'
+#' @param data gtsummary list object
+#'
+#' @return gt summary list object
+#' @export
+#'
+tbl_merge <- function(data) {
+  if (is.null(names(data))) {
+    data |> gtsummary::tbl_merge()
+  } else {
+    data |> gtsummary::tbl_merge(tab_spanner = names(data))
+  }
 }

R/shiny_webResearch.R

@@ -14,7 +14,7 @@
 shiny_webResearch <- function(data = NULL, ...) {
   appDir <- system.file("apps", "data_analysis", package = "webResearch")
   if (appDir == "") {
-    stop("Could not find example directory. Try re-installing `webResearch`.", call. = FALSE)
+    stop("Could not find the app directory. Try re-installing `webResearch`.", call. = FALSE)
   }
 
   G <- .GlobalEnv
@@ -22,13 +22,3 @@ shiny_webResearch <- function(data = NULL, ...) {
   a <- shiny::runApp(appDir = appDir, ...)
   return(invisible(a))
 }
-
-
-#' Wrapping nav_spacer to avoid errors on dependencies when packaging
-#'
-#' @return bslib object
-#' @export
-#'
-panel_space <- function() {
-  bslib::nav_spacer()
-}

inst/apps/data_analysis/rsconnect/shinyapps.io/agdamsbo/webResearch.dcf

@@ -5,6 +5,6 @@ account: agdamsbo
 server: shinyapps.io
 hostUrl: https://api.shinyapps.io/v1
 appId: 13276335
-bundleId: 9425248
+bundleId: 9426438
 url: https://agdamsbo.shinyapps.io/webResearch/
 version: 1

inst/apps/data_analysis/server.R

@@ -53,7 +53,7 @@ server <- function(input, output, session) {
     # or all rows if selected, will be shown.
     if (v$input) {
       out <- webResearch_data
-    } else if (v$test=="test") {
+    } else if (v$test == "test") {
       out <- gtsummary::trial
     } else {
       shiny::req(input$file)
@@ -61,6 +61,15 @@ server <- function(input, output, session) {
     }
 
     v$ds <- "present"
+    if (input$factorize == "yes") {
+      out <- out |>
+        (\(.x){
+          suppressWarnings(
+            REDCapCAST::numchar2fct(.x)
+          )
+        })()
+
+    }
     return(out)
   })
 
@@ -69,7 +78,7 @@ server <- function(input, output, session) {
       inputId = "include_vars",
       selected = NULL,
       label = "Covariables to include",
-      choices = colnames(ds())[-match(input$outcome_var, colnames(ds()))],
+      choices = colnames(ds()),
       multiple = TRUE
     )
   })
@@ -89,7 +98,7 @@ server <- function(input, output, session) {
       inputId = "strat_var",
       selected = "none",
       label = "Select variable to stratify baseline",
-      choices = c("none" ,colnames(ds())),
+      choices = c("none", colnames(ds()[base_vars()])),
       multiple = FALSE
     )
   })
@@ -99,21 +108,39 @@ server <- function(input, output, session) {
       inputId = "factor_vars",
       selected = colnames(ds())[sapply(ds(), is.factor)],
       label = "Covariables to format as categorical",
-      choices = colnames(ds())[sapply(ds(), is.character)],
+      choices = colnames(ds()),
       multiple = TRUE
     )
   })
 
-  output$data.input <- shiny::renderTable({
+  base_vars <- shiny::reactive({
-    utils::head(ds(),20)
+    if (is.null(input$include_vars)) {
+      out <- colnames(ds())
+    } else {
+      out <- unique(c(input$include_vars, input$outcome_var))
+    }
+    return(out)
   })
 
-  output$data.classes <- shiny::renderTable({
+  # output$data.input <- shiny::renderTable({
-    shiny::req(input$file)
+  #   utils::head(ds(), 20)
-    data.frame(matrix(sapply(ds(),\(.x){class(.x)[1]}),nrow=1)) |>
+  # })
-      stats::setNames(names(ds()))
+
+  output$data.input <- DT::renderDT({
+    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
@@ -127,28 +154,45 @@ server <- function(input, output, session) {
 
       data <- data |> factorize(vars = input$factor_vars)
 
-      if (is.factor(data[[input$strat_var]])) {
+      # if (is.factor(data[[input$strat_var]])) {
-        by.var <- input$strat_var
+      #   by.var <- input$strat_var
-      } else {
+      # } else {
+      #   by.var <- NULL
+      # }
+
+      if (input$strat_var == "none") {
         by.var <- NULL
-      }
-
-      if (is.null(input$include_vars)) {
-        base_vars <- colnames(data)
       } else {
-        base_vars <- c(input$include_vars, input$outcome_var)
+        by.var <- input$strat_var
       }
 
-      data <- dplyr::select(data, dplyr::all_of(base_vars))
+      data <- data[base_vars()]
 
-      model <- data |>
+      # model <- data |>
-        regression_model(
+      #   regression_model(
-          outcome.str = input$outcome_var,
+      #     outcome.str = input$outcome_var,
-          auto.mode = input$regression_auto == 1,
+      #     auto.mode = input$regression_auto == 1,
-          formula.str = input$regression_formula,
+      #     formula.str = input$regression_formula,
-          fun = input$regression_fun,
+      #     fun = input$regression_fun,
-          args.list = eval(parse(text = paste0("list(", input$regression_args, ")")))
+      #     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, ")"))))
+            )
+          )
+        })
 
 
       v$list <- list(
@@ -161,14 +205,24 @@ server <- function(input, output, session) {
               )
           ) |>
           (\(.x){
-            if (!is.null(by.var)){
+            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 = model |>
+        table2 = models |>
-          regression_table()
+          purrr::map(regression_table) |>
+          tbl_merge()
       )
 
       output$table1 <- gt::render_gt(
@@ -180,7 +234,6 @@ server <- function(input, output, session) {
         v$list$table2 |>
           gtsummary::as_gt()
       )
-
     }
   )
 
@@ -229,5 +282,4 @@ server <- function(input, output, session) {
       print(paste(.x, "deleted"))
     })
   })
-
 }

inst/apps/data_analysis/ui.R

@@ -1,39 +1,16 @@
 library(shiny)
 library(bslib)
 requireNamespace("gt")
-# require(ggplot2)
-# source("https://raw.githubusercontent.com/agdamsbo/cognitive.index.lookup/main/R/index_from_raw.R")
-# source("https://raw.githubusercontent.com/agdamsbo/cognitive.index.lookup/main/R/plot_index.R")
-# source(here::here("R/index_from_raw.R"))
-# source(here::here("R/plot_index.R"))
-
-# ui <- fluidPage(
-
-cards <- list(
-  bslib::card(
-    max_height = "200px",
-    full_screen = TRUE,
-    bslib::card_header("Data overview"),
-    shiny::uiOutput("data.input")
-  ),
-  bslib::card(
-    # max_height = "200px",
-    full_screen = TRUE,
-    bslib::card_header("Baseline characteristics"),
-    gt::gt_output(outputId = "table1")
-  ),
-  bslib::card(
-    full_screen = TRUE,
-    bslib::card_header("Multivariable regression table"),
-    gt::gt_output(outputId = "table2")
-  )
-)
 
 panels <- list(
   bslib::nav_panel(
     title = "Data overview",
-    shiny::uiOutput("data.classes"),
+    # shiny::uiOutput("data.classes"),
-    shiny::uiOutput("data.input")
+    # 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",
@@ -47,25 +24,15 @@ panels <- list(
 
 
 ui <- bslib::page(
-  theme = bslib::bs_theme(bootswatch = "minty",
+  theme = bslib::bs_theme(
-                            base_font = font_google("Inter"),
+    bootswatch = "minty",
-                            code_font = font_google("JetBrains Mono")
+    base_font = font_google("Inter"),
-                          ),
+    code_font = font_google("JetBrains Mono")
-  # theme = bslib::bs_theme(
+  ),
-    # bg = "#101010",
-    # fg = "#FFF",
-  #   primary = "#E69F00",
-  #   secondary = "#0072B2",
-  #   success = "#009E73",
-  #   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."),
-
-    # sidebarPanel(
     sidebar = bslib::sidebar(
       width = 300,
       open = "open",
@@ -92,12 +59,22 @@ ui <- bslib::page(
           )
         ),
         # Does not work??
-      #   shiny::actionButton(inputId = "test_data",
+        #   shiny::actionButton(inputId = "test_data",
-      #                       label = "Load test data", class = "btn-primary")
+        #                       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",
@@ -126,9 +103,23 @@ ui <- bslib::page(
             value = ""
           )
         ),
-        shiny::helpText(em("Please specify relevant columns from your data, and press 'Load data'")),
+        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",
@@ -149,15 +140,27 @@ ui <- bslib::page(
           selected = "no",
           inline = TRUE,
           choices = list(
-            "No" = "no",
+            "Yes" = "yes",
-            "Yes" = "yes"
+            "No" = "no"
           )
         ),
         shiny::conditionalPanel(
           condition = "input.specify_factors=='yes'",
           shiny::uiOutput("factor_vars")
         ),
-        shiny::actionButton("load", "Analyse", class = "btn-primary"),
+        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(),

man/panel_space.Rd

@@ -1,14 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/app.R
-\name{panel_space}
-\alias{panel_space}
-\title{Wrapping nav_spacer to avoid errors on dependencies when packaging}
-\usage{
-panel_space()
-}
-\value{
-bslib object
-}
-\description{
-Wrapping nav_spacer to avoid errors on dependencies when packaging
-}

man/regression_model.Rd

@@ -2,7 +2,7 @@
 % Please edit documentation in R/regression_model.R
 \name{regression_model}
 \alias{regression_model}
-\title{Print a flexible baseline characteristics table}
+\title{Create a regression model programatically}
 \usage{
 regression_model(
   data,
@@ -11,7 +11,8 @@ regression_model(
   formula.str = NULL,
   args.list = NULL,
   fun = NULL,
-  vars = NULL
+  vars = NULL,
+  ...
 )
 }
 \arguments{
@@ -28,12 +29,14 @@ regression_model(
 \item{fun}{Name of function as character vector or function to use for model creation.}
 
 \item{vars}{character vector of variables to include}
+
+\item{...}{ignored for now}
 }
 \value{
 object of standard class for fun
 }
 \description{
-Print a flexible baseline characteristics table
+Create a regression model programatically
 }
 \examples{
 gtsummary::trial |>

man/regression_model_uv.Rd

@@ -0,0 +1,51 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/regression_model.R
+\name{regression_model_uv}
+\alias{regression_model_uv}
+\title{Create a regression model programatically}
+\usage{
+regression_model_uv(
+  data,
+  outcome.str,
+  args.list = NULL,
+  fun = NULL,
+  vars = NULL,
+  ...
+)
+}
+\arguments{
+\item{data}{data set}
+
+\item{outcome.str}{Name of outcome variable. Character vector.}
+
+\item{args.list}{List of arguments passed to 'fun' with 'do.call'.}
+
+\item{fun}{Name of function as character vector or function to use for model creation.}
+
+\item{vars}{character vector of variables to include}
+
+\item{...}{ignored for now}
+}
+\value{
+object of standard class for fun
+}
+\description{
+Create a regression model programatically
+}
+\examples{
+\dontrun{
+gtsummary::trial |>
+  regression_model_uv(outcome.str = "age")
+gtsummary::trial |>
+  regression_model_uv(
+    outcome.str = "age",
+    fun = "stats::lm",
+    args.list = NULL
+  )
+gtsummary::trial |> regression_model_uv(
+  outcome.str = "trt",
+  fun = "stats::glm",
+  args.list = list(family = stats::binomial(link = "logit"))
+)
+}
+}

man/regression_table.Rd

@@ -2,12 +2,20 @@
 % Please edit documentation in R/regression_table.R
 \name{regression_table}
 \alias{regression_table}
+\alias{regression_table.list}
+\alias{regression_table.webresearch_model}
 \title{Create table of regression model}
 \usage{
-regression_table(data, args.list = NULL, fun = "gtsummary::tbl_regression")
+regression_table(x, ...)
+
+\method{regression_table}{list}(x, ...)
+
+\method{regression_table}{webresearch_model}(x, ..., args.list = NULL, fun = "gtsummary::tbl_regression")
 }
 \arguments{
-\item{data}{regression model}
+\item{x}{regression model}
+
+\item{...}{passed to methods}
 
 \item{args.list}{list of arguments passed to 'fun'.}
 
@@ -20,6 +28,7 @@ object of standard class for fun
 Create table of regression model
 }
 \examples{
+\dontrun{
 gtsummary::trial |>
   regression_model(
     outcome.str = "stage",
@@ -41,4 +50,34 @@ gtsummary::trial |>
     args.list = list(family = binomial(link = "logit"))
   ) |>
   regression_table()
+gtsummary::trial |>
+  regression_model_uv(
+    outcome.str = "trt",
+    fun = "stats::glm",
+    args.list = list(family = stats::binomial(link = "logit"))
+  ) |>
+  regression_table()
+gtsummary::trial |>
+  regression_model_uv(
+    outcome.str = "stage",
+    args.list = list(family = stats::binomial(link = "logit"))
+  ) |>
+  regression_table()
+
+list(
+  "Univariable" = regression_model_uv,
+  "Multivariable" = regression_model
+) |>
+  lapply(\(.fun){
+    do.call(
+      .fun,
+      c(
+        list(data = gtsummary::trial),
+        list(outcome.str = "stage")
+      )
+    )
+  }) |>
+  purrr::map(regression_table) |>
+  tbl_merge()
+  }
 }

man/shiny_webResearch.Rd

@@ -1,5 +1,5 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/app.R
+% Please edit documentation in R/shiny_webResearch.R
 \name{shiny_webResearch}
 \alias{shiny_webResearch}
 \title{Test version of the shiny_cast function to launch the app with a data set in

man/tbl_merge.Rd

@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/regression_table.R
+\name{tbl_merge}
+\alias{tbl_merge}
+\title{A substitue to gtsummary::tbl_merge, that will use list names for the tab
+spanner names.}
+\usage{
+tbl_merge(data)
+}
+\arguments{
+\item{data}{gtsummary list object}
+}
+\value{
+gt summary list object
+}
+\description{
+A substitue to gtsummary::tbl_merge, that will use list names for the tab
+spanner names.
+}

renv.lock

@@ -9,6 +9,23 @@
     ]
   },
   "Packages": {
+    "DT": {
+      "Package": "DT",
+      "Version": "0.33",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "crosstalk",
+        "htmltools",
+        "htmlwidgets",
+        "httpuv",
+        "jquerylib",
+        "jsonlite",
+        "magrittr",
+        "promises"
+      ],
+      "Hash": "64ff3427f559ce3f2597a4fe13255cb6"
+    },
     "MASS": {
       "Package": "MASS",
       "Version": "7.3-61",
@@ -169,6 +186,22 @@
       ],
       "Hash": "543776ae6848fde2f48ff3816d0628bc"
     },
+    "bayestestR": {
+      "Package": "bayestestR",
+      "Version": "0.15.0",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R",
+        "datawizard",
+        "graphics",
+        "insight",
+        "methods",
+        "stats",
+        "utils"
+      ],
+      "Hash": "d7c05ccb9d60d87dbbe8b4042c385f01"
+    },
     "bigD": {
       "Package": "bigD",
       "Version": "0.3.0",
@@ -301,6 +334,23 @@
       ],
       "Hash": "2147e8448f4eb87197520fc1710855c7"
     },
+    "cardx": {
+      "Package": "cardx",
+      "Version": "0.2.1",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R",
+        "cards",
+        "cli",
+        "dplyr",
+        "glue",
+        "lifecycle",
+        "rlang",
+        "tidyr"
+      ],
+      "Hash": "e5458dd65b0602136b16aed802d3bd50"
+    },
     "cellranger": {
       "Package": "cellranger",
       "Version": "1.1.0",
@@ -389,6 +439,19 @@
       ],
       "Hash": "859d96e65ef198fd43e82b9628d593ef"
     },
+    "crosstalk": {
+      "Package": "crosstalk",
+      "Version": "1.2.1",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R6",
+        "htmltools",
+        "jsonlite",
+        "lazyeval"
+      ],
+      "Hash": "ab12c7b080a57475248a30f4db6298c0"
+    },
     "curl": {
       "Package": "curl",
       "Version": "6.0.1",
@@ -399,6 +462,19 @@
       ],
       "Hash": "e8ba62486230951fcd2b881c5be23f96"
     },
+    "datawizard": {
+      "Package": "datawizard",
+      "Version": "0.13.0",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R",
+        "insight",
+        "stats",
+        "utils"
+      ],
+      "Hash": "303aeace6f3554ce2d62e5d1df6fcd6e"
+    },
     "digest": {
       "Package": "digest",
       "Version": "0.6.37",
@@ -706,6 +782,19 @@
       ],
       "Hash": "ac107251d9d9fd72f0ca8049988f1d7f"
     },
+    "insight": {
+      "Package": "insight",
+      "Version": "1.0.0",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R",
+        "methods",
+        "stats",
+        "utils"
+      ],
+      "Hash": "bee0c3abb5eea6c4170ea2a7c334893f"
+    },
     "jquerylib": {
       "Package": "jquerylib",
       "Version": "0.1.4",
@@ -812,6 +901,16 @@
       ],
       "Hash": "a3e051d405326b8b0012377434c62b37"
     },
+    "lazyeval": {
+      "Package": "lazyeval",
+      "Version": "0.2.2",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R"
+      ],
+      "Hash": "d908914ae53b04d4c0c0fd72ecc35370"
+    },
     "lifecycle": {
       "Package": "lifecycle",
       "Version": "1.0.4",
@@ -931,6 +1030,23 @@
       ],
       "Hash": "55ddd2d4a1959535f18393478b0c14a6"
     },
+    "parameters": {
+      "Package": "parameters",
+      "Version": "0.23.0",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R",
+        "bayestestR",
+        "datawizard",
+        "graphics",
+        "insight",
+        "methods",
+        "stats",
+        "utils"
+      ],
+      "Hash": "518970426f8042a2b27c3415da881674"
+    },
     "pillar": {
       "Package": "pillar",
       "Version": "1.9.0",