Merge pull request #269 from larmarange/issue268

model_get_model_frame.coxph()` has been fixed

NEWS.md

@@ -1,5 +1,10 @@
 # broom.helpers (development version)
 
+**Fixes**
+
+- `model_get_model_frame.coxph()` has been fixed to return a correct model
+  frame a subject identifier is passed to `survival::coxph()` (#268)
+
 # broom.helpers 1.16.0
 
 **New features**

R/model_get_model_frame.R

@@ -34,12 +34,25 @@ model_get_model_frame.default <- function(model) {
 #' @export
 #' @rdname model_get_model_frame
 model_get_model_frame.coxph <- function(model) {
-  tryCatch(
-    stats::model.frame.default(model),
+  # variable labels not available, but accessible through model.frame.default()
+  # however, model.frame.default() does not return (id) and the correct number
+  # of lines
+  res <- tryCatch(
+    stats::model.frame(model),
     error = function(e) {
       NULL
     }
   )
+
+  if (!is.null(res)) {
+    res <- res |>
+      labelled::copy_labels_from(
+        stats::model.frame.default(model),
+        .strict = FALSE
+      )
+  }
+
+  res
 }
 
 #' @export

tests/testthat/test-identify_variables.R

@@ -556,6 +556,7 @@ test_that("model_identify_variables() works with lavaan::lavaan", {
 
 test_that("model_identify_variables() message when failure", {
   skip_if_not_installed("survival")
+  trial <- gtsummary::trial
   df_models <-
     tibble::tibble(grade = c("I", "II", "III")) |>
     dplyr::mutate(

tests/testthat/test-marginal_tidiers.R

@@ -4,7 +4,7 @@ test_that("tidy_margins()", {
 
   mod <- lm(Petal.Length ~ Petal.Width + Species, data = iris)
   expect_error(
-    t <- tidy_margins(mod),
+    suppressWarnings(t <- tidy_margins(mod)),
     NA
   )
   expect_error(

tests/testthat/test-model_get_n.R

@@ -238,7 +238,10 @@ test_that("model_get_n() works with lme4::glmer", {
 test_that("model_get_n() works with survival::coxph", {
   skip_on_cran()
   df <- survival::lung |> dplyr::mutate(sex = factor(sex))
-  mod <- survival::coxph(survival::Surv(time, status) ~ ph.ecog + age + sex, data = df)
+  mod <- survival::coxph(
+    survival::Surv(time, status) ~ ph.ecog + age + sex,
+    data = df
+  )
   expect_error(res <- mod |> model_get_n(), NA)
   expect_equivalent(
     names(res),
@@ -261,6 +264,15 @@ test_that("model_get_n() works with survival::coxph", {
   expect_equivalent(res$n_ind, c(10, 10))
   expect_equivalent(res$n_event, c(7, 7))
   expect_equivalent(res$exposure, c(43, 43))
+
+  # specific case when missing values in the `id`
+  # should not result in a warning
+  mod <- survival::coxph(
+    survival::Surv(ttdeath, death) ~ age + grade,
+    id = response,
+    data = gtsummary::trial
+  )
+  expect_no_warning(mod |> model_get_n())
 })
 
 test_that("model_get_n() works with survival::survreg", {