Adding support for mice models

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: broom.helpers
 Title: Helpers for Model Coefficients Tibbles
-Version: 1.0.0.9000
+Version: 1.0.0.9001
 Authors@R: 
     c(person(given = "Joseph",
              family = "Larmarange",
@@ -12,11 +12,10 @@ Authors@R:
              role = "aut",
              email = "danield.sjoberg@gmail.com",
              comment = c(ORCID = "0000-0003-0862-2018")))
-Description: Provides suite of
-    functions to work with regression model 'broom::tidy()' tibbles.  The
-    suite includes functions to group regression model terms by variable,
-    insert reference and header rows for categorical variables, add
-    variable labels, and more.
+Description: Provides suite of functions to work with regression
+    model 'broom::tidy()' tibbles.  The suite includes functions to group
+    regression model terms by variable, insert reference and header rows
+    for categorical variables, add variable labels, and more.
 License: GPL-3
 URL: https://larmarange.github.io/broom.helpers/
 BugReports: https://github.com/larmarange/broom.helpers/issues
@@ -44,12 +43,14 @@ Suggests:
     lavaan,
     lme4,
     MASS,
+    mice,
     nnet,
     ordinal,
     rmarkdown,
     survey,
     survival,
-    testthat
+    testthat,
+    spelling
 VignetteBuilder: 
     knitr
 RdMacros: 
@@ -58,3 +59,4 @@ Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.1.1
+Language: en-US

NAMESPACE

@@ -11,6 +11,8 @@ S3method(model_get_coefficients_type,glmerMod)
 S3method(model_get_coefficients_type,multinom)
 S3method(model_get_coefficients_type,polr)
 S3method(model_get_contrasts,default)
+S3method(model_get_model,default)
+S3method(model_get_model,mira)
 S3method(model_get_model_frame,coxph)
 S3method(model_get_model_frame,default)
 S3method(model_get_model_frame,survreg)
@@ -29,6 +31,7 @@ S3method(model_list_variables,lavaan)
 export("%>%")
 export(model_get_coefficients_type)
 export(model_get_contrasts)
+export(model_get_model)
 export(model_get_model_frame)
 export(model_get_model_matrix)
 export(model_get_xlevels)

NEWS.md

@@ -1,5 +1,8 @@
 # broom.helpers (development version)
 
+* Added support for multiple imputation models from the {mice} 
+  package. The model passed must be the un-pooled models, and the 
+  pooling step included in `tidy_fun=`. 
 * New function `tidy_select_variables()` to keep/drop
   selected variables in the output (#45)
 * New functions `tidy_add_coefficients_type()` and 

R/model_get_model.R

@@ -0,0 +1,23 @@
+#' Get the model from model objects
+#'
+#' Most model objects are proper R model objects. There are, however, some
+#' model objects that store the proper object internally (e.g. mice models).
+#' This function extracts that model object in those cases.
+#'
+#' @param model a model object
+#' @export
+#' @family model_helpers
+#' @examples
+#' lm(hp ~ mpg + factor(cyl), mtcars) %>%
+#'   model_get_model()
+model_get_model <- function(model) {
+  UseMethod("model_get_model")
+}
+
+#' @export
+#' @rdname model_get_model
+model_get_model.default <- function(model) model
+
+#' @export
+#' @rdname model_get_model
+model_get_model.mira <- function(model) model$analyses[[1]]

R/tidy_and_attach.R

@@ -27,7 +27,7 @@
 #' @export
 tidy_attach_model <- function(x, model, .attributes = NULL) {
   x <- .order_tidy_columns(x)
-  attr(x, "model") <- model
+  attr(x, "model") <- model_get_model(model)
   for (a in names(.attributes)) {
     if (!is.null(.attributes[[a]]))
       attr(x, a) <- .attributes[[a]]

inst/WORDLIST

@@ -0,0 +1,11 @@
+Codecov
+DOI
+exponentiate
+Helmert
+labelled
+Lifecycle
+tibble
+tibbles
+Tibbles
+un
+xlevels

tests/spelling.R

@@ -0,0 +1,3 @@
+if(requireNamespace('spelling', quietly = TRUE))
+  spelling::spell_check_test(vignettes = TRUE, error = FALSE,
+                             skip_on_cran = TRUE)

tests/testthat/test-tidy_plus_plus.R

@@ -51,3 +51,22 @@ test_that("tidy_plus_plus() and functionnal programming", {
       )
   )
 })
+
+
+test_that("tidy_plus_plus() with mice objects", {
+  # impute missing values
+  imputed_trial <-
+    suppressWarnings(mice::mice(gtsummary::trial, maxit = 2, m = 2))
+  # build regression model
+  mod <- with(imputed_trial, lm(age ~ marker + grade))
+
+  # testing pre-pooled results
+  expect_error(
+    tidy_plus_plus(
+      mod,
+      exponentiate = FALSE,
+      tidy_fun = function(x, ...) mice::pool(x) %>% mice::tidy(...)
+    ),
+    NA
+  )
+})