diff --git a/NAMESPACE b/NAMESPACE index 7db274736..dcaaa1ba4 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/find_parameters_other.R b/R/find_parameters_other.R index 219443d98..bf7af80d1 100644 --- a/R/find_parameters_other.R +++ b/R/find_parameters_other.R @@ -243,3 +243,16 @@ find_parameters.deltaMethod <- function(x, flatten = FALSE, ...) { out } } + + +#' @export +find_parameters.coxph <- function(x, verbose = TRUE, ...) { + cf <- stats::coef(summary(x)) + out <- list(conditional = rownames(cf)) + + if (flatten) { + unique(unlist(out, use.names = FALSE)) + } else { + out + } +} diff --git a/R/get_parameters_others.R b/R/get_parameters_others.R index 40d64e7f7..538b395df 100644 --- a/R/get_parameters_others.R +++ b/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) +} diff --git a/tests/testthat/test-coxph-panel.R b/tests/testthat/test-coxph-panel.R new file mode 100644 index 000000000..15ec0408a --- /dev/null +++ b/tests/testthat/test-coxph-panel.R @@ -0,0 +1,163 @@ +skip_if_not_installed("survival") +skip_if_not_installed("withr") + +mod <- survival::coxph( + Surv(time, status) ~ ph.ecog + tt(age), + data = lung, + tt = function(x, t, ...) pspline(x + t / 365.25) +) + +test_that("model_info", { + expect_true(model_info(m1)$is_logit) + expect_false(model_info(m1)$is_linear) +}) + +test_that("find_predictors", { + expect_identical(find_predictors(m1), list(conditional = c("sex", "age", "ph.ecog"))) + expect_null(find_predictors(m1, effects = "random")) +}) + +test_that("find_response", { + expect_identical(find_response(m1), "Surv(time, status)") + expect_identical(find_response(m1, combine = FALSE), c("time", "status")) +}) + +test_that("link_inverse", { + expect_equal(link_inverse(m1)(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(m1), "data.frame") + expect_identical(dim(get_data(m1)), c(166L, 10L)) +}) + + +withr::with_environment( + new.env(), + test_that("get_data: regression test for previous bug", { + dat_regression_test <- data.frame( + time = c(4, 3, 1, 1, 2, 2, 3), + status = c(1, 1, 1, 0, 1, 1, 0), + x = c(0, 2, 1, 1, 1, 0, 0), + sex = c(0, 0, 0, 0, 1, 1, 1) + ) + mod <- survival::coxph(Surv(time, status) ~ x + strata(sex), + data = dat_regression_test, + ties = "breslow" + ) + expect_equal(get_data(mod), dat_regression_test, ignore_attr = TRUE) + }) +) + + +withr::with_environment( + new.env(), + test_that("get_data: regression test for data stored as list", { + dat_regression_test <- list( + time = c(4, 3, 1, 1, 2, 2, 3), + status = c(1, 1, 1, 0, 1, 1, 0), + x = c(0, 2, 1, 1, 1, 0, 0), + sex = c(0, 0, 0, 0, 1, 1, 1) + ) + mod <- survival::coxph(Surv(time, status) ~ x + strata(sex), + data = dat_regression_test, + ties = "breslow" + ) + expect_equal(get_data(mod), as.data.frame(dat_regression_test), ignore_attr = TRUE) + }) +) + + +test_that("find_formula", { + expect_length(find_formula(m1), 1) + expect_equal( + find_formula(m1), + list(conditional = as.formula( + "Surv(time, status) ~ sex + age + ph.ecog" + )), + ignore_attr = TRUE + ) +}) + +test_that("find_variables", { + expect_identical(find_variables(m1), list( + response = c("time", "status"), + conditional = c("sex", "age", "ph.ecog") + )) + expect_identical( + find_variables(m1, flatten = TRUE), + c("time", "status", "sex", "age", "ph.ecog") + ) +}) + +test_that("n_obs", { + expect_identical(n_obs(m1), 226L) +}) + +test_that("linkfun", { + expect_false(is.null(link_function(m1))) +}) + +test_that("is_multivariate", { + expect_false(is_multivariate(m1)) +}) + +test_that("find_parameters", { + expect_identical( + find_parameters(m1), + list( + conditional = c("sexfemale", "age", "ph.ecogok", "ph.ecoglimited") + ) + ) + expect_identical(nrow(get_parameters(m1)), 4L) + expect_identical( + get_parameters(m1)$Parameter, + c("sexfemale", "age", "ph.ecogok", "ph.ecoglimited") + ) +}) + +test_that("find_terms", { + expect_identical( + find_terms(m1), + list( + response = "Surv(time, status)", + conditional = c("sex", "age", "ph.ecog") + ) + ) +}) + +test_that("find_statistic", { + expect_identical(find_statistic(m1), "z-statistic") +}) + +test_that("JM", { + data("aids", package = "JM") + m <- survival::coxph(Surv(start, stop, event) ~ CD4, data = aids) + d <- get_data(m) + expect_identical(dim(d), c(1405L, 4L)) + expect_named(d, c("start", "stop", "event", "CD4")) + expect_identical(find_variables(m), list(response = c("start", "stop", "event"), conditional = "CD4")) +}) + +test_that("get_statistic", { + skip_if_not_installed("survival") + bladder1 <- bladder[bladder$enum < 5, ] + mod <- survival::coxph( + Surv(stop, event) ~ (rx + size + number) * strata(enum), + cluster = id, bladder1, robust = TRUE + ) + z1 <- get_statistic(mod)$Statistic + z2 <- coef(summary(mod))[, "z"] + expect_equal(z1, z2, ignore_attr = TRUE) + + lung <- survival::lung + mod <- survival::coxph( + formula = Surv(time, status) ~ age + sex + survival::frailty(inst), + data = lung + ) + z1 <- get_statistic(mod)$Statistic + z2 <- coef(summary(mod))[, "Chisq"] + expect_equal(z1, z2, ignore_attr = TRUE) +})