library(joineR)
context("Competing risks")
test_that("competing risks models", {
# load data + fit model
data(epileptic)
epileptic$interaction <- with(epileptic, time * (treat == "LTG"))
longitudinal <- epileptic[, c(1:3, 13)]
survival <- UniqueVariables(epileptic, c(4, 6), "id")
baseline <- UniqueVariables(epileptic, "treat", "id")
data <- jointdata(longitudinal = longitudinal,
survival = survival,
baseline = baseline,
id.col = "id",
time.col = "time")
fit <- joint(data = data, long.formula = dose ~ time + treat + interaction,
surv.formula = Surv(with.time, with.status2) ~ treat,
longsep = TRUE, survsep = TRUE,
gpt = 3)
# tests
expect_is(fit, "joint")
expect_true(fit$convergence)
expect_equal(unlist(fit$coefficients$fixed$longitudinal),
c(1.9730161778, 0.0003545542, -0.1380857344, 0.0006185851),
tol = 1e-03, check.attributes = FALSE)
expect_equal(unlist(fit$coefficients$fixed$survival1),
0.02721022,
tol = 1e-03, check.attributes = FALSE)
expect_equal(unlist(fit$coefficients$fixed$survival2),
-0.6601709,
tol = 1e-03, check.attributes = FALSE)
expect_equal(unlist(fit$coefficients$latent),
c(0.5894194, -0.9258503),
tol = 1e-03, check.attributes = FALSE)
expect_output(str(fit$sigma.u), "random.effects")
expect_equal(dim(fit$sigma.u), c(2, 2))
expect_output(str(fit$data), "List of 6")
})
test_that("bootstrap SEs with competing risks", {
# load data + fit model
data(epileptic)
epileptic$interaction <- with(epileptic, time * (treat == "LTG"))
longitudinal <- epileptic[, c(1:3, 13)]
survival <- UniqueVariables(epileptic, c(4, 6), "id")
baseline <- UniqueVariables(epileptic, "treat", "id")
data <- jointdata(longitudinal = longitudinal,
survival = survival,
baseline = baseline,
id.col = "id",
time.col = "time")
fit <- joint(data = data, long.formula = dose ~ time + treat + interaction,
surv.formula = Surv(with.time, with.status2) ~ treat,
longsep = FALSE, survsep = FALSE,
gpt = 3)
fit.boot <- jointSE(fit, n.boot = 2)
# tests
expect_output(str(fit.boot), "data.frame")
expect_equal(dim(fit.boot), c(11, 6))
})
test_that("ordering of subjects with competing risks", {
# load data + fit model (original data)
data(epileptic)
epileptic$interaction <- with(epileptic, time * (treat == "LTG"))
longitudinal <- epileptic[, c(1:3, 13)]
survival <- UniqueVariables(epileptic, c(4, 6), "id")
baseline <- UniqueVariables(epileptic, "treat", "id")
data <- jointdata(longitudinal = longitudinal,
survival = survival,
baseline = baseline,
id.col = "id",
time.col = "time")
fit <- joint(data = data, long.formula = dose ~ time + treat + interaction,
surv.formula = Surv(with.time, with.status2) ~ treat,
longsep = FALSE, survsep = FALSE,
gpt = 3)
# load data + fit model (unordered data)
longitudinal2 <- longitudinal[sample(nrow(longitudinal)), ]
survival2 <- survival[sample(nrow(survival)), ]
baseline2 <- baseline[sample(nrow(baseline)), ]
data2 <- jointdata(longitudinal = longitudinal2,
survival = survival2,
baseline = baseline2,
id.col = "id",
time.col = "time")
fit2 <- joint(data = data2, long.formula = dose ~ time + treat + interaction,
surv.formula = Surv(with.time, with.status2) ~ treat,
longsep = FALSE, survsep = FALSE,
gpt = 3)
# tests
expect_equal(summary(data), summary(data2))
expect_equal(fit$coefficients, fit2$coefficients)
expect_equal(fit$sigma.z, fit2$sigma.z)
expect_equal(fit$sigma.u, fit2$sigma.u)
expect_equal(fit$haz.a, fit2$haz.a)
expect_equal(fit$haz.b, fit2$haz.b)
})
test_that("competing risks model with covariates", {
# load data + fit model
data(epileptic)
longitudinal <- epileptic[, c(1:3)]
survival <- UniqueVariables(epileptic, c(4, 6), "id")
baseline <- UniqueVariables(epileptic, c("age", "gender"), "id")
data <- jointdata(longitudinal = longitudinal,
survival = survival,
baseline = baseline,
id.col = "id",
time.col = "time")
fit_covar <- joint(data = data,
long.formula = dose ~ time,
surv.formula = Surv(with.time, with.status2) ~ gender + age,
longsep = FALSE, survsep = FALSE,
gpt = 3)
# tests
expect_is(fit_covar, "joint")
expect_true(fit_covar$convergence)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.