Updating for multinomial models

Author: ddsjoberg

DESCRIPTION

@@ -59,7 +59,7 @@ Imports:
 Suggests: 
     aod (>= 1.3.3),
     broom (>= 1.0.5),
-    broom.helpers (>= 1.17.0),
+    broom.helpers (>= 1.20.0),
     broom.mixed (>= 0.2.9),
     car (>= 3.0-11),
     cardx (>= 0.2.4),

NAMESPACE

@@ -73,7 +73,6 @@ S3method(tbl_regression,lmerMod)
 S3method(tbl_regression,mipo)
 S3method(tbl_regression,mira)
 S3method(tbl_regression,model_fit)
-S3method(tbl_regression,multinom)
 S3method(tbl_regression,stanreg)
 S3method(tbl_regression,survreg)
 S3method(tbl_regression,workflow)

R/tbl_regression.R

@@ -223,6 +223,9 @@ tbl_regression.default <- function(x,
     get_theme_element("tbl_regression-fn:addnl-fn-to-run", default = identity) |>
     do.call(list(res))
 
+  # running function for multimodel models (and similar) for grouped results ---
+  res <- .regression_grouped_results(res)
+
   # return results -------------------------------------------------------------
   res <- res |>
     modify_table_styling(
@@ -233,3 +236,45 @@ tbl_regression.default <- function(x,
   res$call_list <- list(tbl_regression = match.call())
   res
 }
+
+.regression_grouped_results <- function(x) {
+  # if grouped model, then adjusting output accordingly
+  if ("group_by" %in% names(x$table_body)) {
+    # rename the grouping column
+    x$table_body <-
+      x$table_body |>
+      dplyr::rename(groupname_col = "group_by") |>
+      dplyr::relocate("groupname_col", .before = "label")
+
+    # assign header label
+    x <- x |>
+      modify_table_styling(
+        columns = "groupname_col",
+        hide = FALSE,
+        label = .grouped_data_header(x$inputs$x),
+        align = "left"
+      )
+
+    # warning about multinomial models
+    cli::cli_inform(
+      c("i" = "Multinomial models and other grouped models have a different
+               underlying structure than the models gtsummary was designed for.",
+        "*" = "Functions designed to work with {.fun tbl_regression} objects may yield unexpected results.")
+    )
+  }
+
+  # return regression tbl
+  x
+}
+
+.grouped_data_header <- function(x) {
+  UseMethod(".grouped_data_header")
+}
+
+.grouped_data_header.default <- function(x) {
+  "**Group**"
+}
+
+.grouped_data_header.default <- function(x) {
+  "**Outcome**"
+}

R/tbl_regression_methods.R

@@ -49,11 +49,6 @@ tbl_regression.survreg <- function(x, tidy_fun = function(x, ...) broom::tidy(x,
 tbl_regression.mira <- function(x, tidy_fun = pool_and_tidy_mice, ...) {
   tbl <- tbl_regression.default(x = x, tidy_fun = tidy_fun, ...)
 
-  # adding outcome levels to multinomial models
-  if (inherits(x$analyses[[1]], "multinom")) {
-    tbl <- .multinom_modifations(tbl)
-  }
-
   tbl
 }
 
@@ -113,35 +108,3 @@ tbl_regression.crr <- function(x, ...) {
   tbl_regression.default(x = x, ...)
 }
 
-#' @export
-#' @rdname tbl_regression_methods
-tbl_regression.multinom <- function(x, ...) {
-  result <- tbl_regression.default(x = x, ...)
-
-  # grouping by outcome, and printing warning message
-  .multinom_modifations(result)
-}
-
-.multinom_modifations <- function(x) {
-  # adding a grouped header for the outcome levels
-  x$table_body <-
-    x$table_body |>
-    mutate(groupname_col = .data$y.level, .before = 1L)
-
-  x <- modify_table_styling(
-      x = x,
-      columns = all_of("groupname_col"),
-      hide = FALSE,
-      label = "**Outcome**",
-      align = "left"
-    )
-
-  # warning about multinomial models
-  cli::cli_inform(
-    c("i" = "Multinomial models have a different underlying structure than the
-             models gtsummary was designed for.",
-      "*" = "Functions designed to work with {.fun tbl_regression} objects may yield unexpected results.")
-  )
-
-  x
-}

man/tbl_regression_methods.Rd

@@ -105,6 +105,20 @@
         **Characteristic** **Beta**  **95% CI**
       1                 hp    -0.03 -0.06, 0.00
 
+---
+
+    Code
+      as.data.frame(tbl_regression(lme4::lmer(mpg ~ hp + (1 | cyl), mtcars), tidy = broom.mixed::tidy,
+      group_by = "effect", group_label = c(fixed = "Fixed Effects", ran_pars = "Random Effects")))
+    Message
+      i Multinomial models and other grouped models have a different underlying structure than the models gtsummary was designed for.
+      * Functions designed to work with `tbl_regression()` objects may yield unexpected results.
+    Output
+           **Outcome**       **Characteristic** **Beta**  **95% CI**
+      1  Fixed Effects                       hp    -0.03 -0.06, 0.00
+      2 Random Effects      cyl.sd__(Intercept)      4.0        <NA>
+      3           <NA> Residual.sd__Observation      3.1        <NA>
+
 # tbl_regression.gam()
 
     Code
@@ -151,7 +165,7 @@
       final  value 29.311125 
       converged
     Message
-      i Multinomial models have a different underlying structure than the models gtsummary was designed for.
+      i Multinomial models and other grouped models have a different underlying structure than the models gtsummary was designed for.
       * Functions designed to work with `tbl_regression()` objects may yield unexpected results.
     Output
         **Outcome** **Characteristic** **log(OR)**  **95% CI** **p-value**

tests/testthat/_snaps/tbl_regression_methods.md

@@ -66,6 +66,17 @@ test_that("tbl_regression.lmerMod()", {
       tbl_regression() |>
       as.data.frame()
   )
+
+  expect_snapshot(
+    lme4::lmer(mpg ~ hp + (1 | cyl), mtcars) |>
+      tbl_regression(
+        tidy = broom.mixed::tidy,
+        group_by = "effect",
+        group_label = c(fixed = "Fixed Effects",
+                        ran_pars = "Random Effects")
+      ) |>
+      as.data.frame()
+  )
 })
 
 test_that("tbl_regression.gam()", {