Add support for coxph-panel (#968)

* Add support for coxph-panel

* fix

* news, desc

* fix

* fix

* lintr

* lintr

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: insight
 Title: Easy Access to Model Information for Various Model Objects
-Version: 0.99.0.13
+Version: 0.99.0.14
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",

NAMESPACE

@@ -217,6 +217,7 @@ S3method(find_parameters,cgam)
 S3method(find_parameters,clm2)
 S3method(find_parameters,clmm2)
 S3method(find_parameters,coxme)
+S3method(find_parameters,coxph)
 S3method(find_parameters,cpglmm)
 S3method(find_parameters,crq)
 S3method(find_parameters,crqs)
@@ -638,6 +639,7 @@ S3method(get_parameters,cgam)
 S3method(get_parameters,clm2)
 S3method(get_parameters,clmm2)
 S3method(get_parameters,coxme)
+S3method(get_parameters,coxph)
 S3method(get_parameters,cpglmm)
 S3method(get_parameters,crq)
 S3method(get_parameters,crqs)

NEWS.md

@@ -41,6 +41,8 @@
 * `format_bf()` with `stars = TRUE` used the `°` symbol for inferiority
   (evidence *against* the comparison).
 
+* Added support for `coxph.panel` models.
+
 * Overhaul of documentation for the package-functions.
 
 ## Bug fix

R/find_parameters_other.R

@@ -243,3 +243,16 @@ find_parameters.deltaMethod <- function(x, flatten = FALSE, ...) {
     out
   }
 }
+
+
+#' @export
+find_parameters.coxph <- function(x, flatten = FALSE, ...) {
+  cf <- stats::coef(summary(x))
+  out <- list(conditional = rownames(cf))
+
+  if (flatten) {
+    unique(unlist(out, use.names = FALSE))
+  } else {
+    out
+  }
+}

R/get_parameters_others.R

@@ -414,3 +414,22 @@ get_parameters.ggcomparisons <- function(x, merge_parameters = FALSE, ...) {
   }
   text_remove_backticks(out)
 }
+
+
+#' @export
+get_parameters.coxph <- function(x, verbose = TRUE, ...) {
+  cf <- stats::coef(summary(x))
+  params <- rownames(cf)
+  if (is.null(params)) {
+    params <- paste(seq_along(cf))
+  }
+
+  params <- data.frame(
+    Parameter = params,
+    Estimate = unname(cf[, 1]),
+    stringsAsFactors = FALSE,
+    row.names = NULL
+  )
+
+  text_remove_backticks(params)
+}

tests/testthat/test-coxph-panel.R

@@ -0,0 +1,100 @@
+skip_if_not_installed("survival")
+skip_if_not_installed("withr")
+
+lung <- survival::lung
+Surv <- survival::Surv
+
+mod <- survival::coxph(
+  Surv(time, status) ~ ph.ecog + tt(age),
+  data = lung,
+  tt = function(x, t, ...) survival::pspline(x + t / 365.25)
+)
+
+test_that("model_info", {
+  expect_true(model_info(mod)$is_logit)
+  expect_false(model_info(mod)$is_linear)
+})
+
+test_that("find_predictors", {
+  expect_identical(find_predictors(mod), list(conditional = c("ph.ecog", "age")))
+  expect_null(find_predictors(mod, effects = "random"))
+})
+
+test_that("find_response", {
+  expect_identical(find_response(mod), "Surv(time, status)")
+  expect_identical(find_response(mod, combine = FALSE), c("time", "status"))
+})
+
+test_that("link_inverse", {
+  expect_equal(link_inverse(mod)(0.2), plogis(0.2), tolerance = 1e-5)
+})
+
+test_that("get_data", {
+  ## NOTE check back every now and then and see if tests still work
+  skip("works interactively")
+  expect_s3_class(get_data(mod), "data.frame")
+  expect_identical(dim(get_data(mod)), c(227L, 4L))
+})
+
+
+test_that("find_formula", {
+  expect_length(find_formula(mod), 1)
+  expect_equal(
+    find_formula(mod),
+    list(conditional = as.formula("Surv(time, status) ~ ph.ecog + tt(age)")),
+    ignore_attr = TRUE
+  )
+})
+
+test_that("find_variables", {
+  expect_identical(find_variables(mod), list(
+    response = c("time", "status"),
+    conditional = c("ph.ecog", "age")
+  ))
+
+  expect_identical(
+    find_variables(mod, flatten = TRUE),
+    c("time", "status", "ph.ecog", "age")
+  )
+})
+
+test_that("n_obs", {
+  expect_identical(n_obs(mod), 227L)
+})
+
+test_that("linkfun", {
+  expect_false(is.null(link_function(mod)))
+})
+
+test_that("is_multivariate", {
+  expect_false(is_multivariate(mod))
+})
+
+withr::with_package(
+  "survival",
+  test_that("find_parameters", {
+    expect_identical(
+      find_parameters(mod),
+      list(conditional = c("ph.ecog", "tt(age), linear", "tt(age), nonlin"))
+    )
+    expect_identical(nrow(get_parameters(mod)), 3L)
+    expect_identical(
+      get_parameters(mod)$Parameter,
+      c("ph.ecog", "tt(age), linear", "tt(age), nonlin")
+    )
+  })
+)
+
+test_that("find_terms", {
+  expect_identical(
+    find_terms(mod),
+    list(
+      response = "Surv(time, status)",
+      conditional = c("ph.ecog", "tt(age)")
+    )
+  )
+})
+
+test_that("find_statistic", {
+  expect_identical(find_statistic(mod), "chi-squared statistic")
+})