library(joineRML)
context("Inputs")
test_that("too many datasets throws error", {
# load data + fit model
data(pbc2)
pbc2$log.b <- log(pbc2$serBilir)
f <- function() {
mjoint(
formLongFixed = list("log.bil" = log.b ~ year),
formLongRandom = list("log.bil" = ~ 1 | id),
formSurv = Surv(years, status2) ~ age,
data = list(pbc2, pbc2),
timeVar = "year",
control = list(convCrit = "sas", rav = 0.01),
verbose = FALSE)
}
# test
expect_error(f(), "The number of datasets expected is K = 1")
})
test_that("too few datasets throws error", {
# load data + fit model
data(heart.valve)
hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ]
f <- function() {
mjoint(
formLongFixed = list("grad" = log.grad ~ time + sex + hs,
"lvmi" = log.lvmi ~ time + sex),
formLongRandom = list("grad" = ~ 1 | num,
"lvmi" = ~ time | num),
formSurv = Surv(fuyrs, status) ~ age,
data = list(hvd),
inits = list("gamma" = c(0.11, 1.51, 0.80)),
timeVar = "time",
control = list(convCrit = "sas", rav = 0.01),
verbose = FALSE)
}
# test
expect_error(f(), "The number of datasets expected is K = 2")
})
test_that("timeVar length mismatch throws error", {
# load data + fit model
data(heart.valve)
hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ]
f <- function() {
mjoint(
formLongFixed = list("grad" = log.grad ~ time + sex + hs,
"lvmi" = log.lvmi ~ time + sex),
formLongRandom = list("grad" = ~ 1 | num,
"lvmi" = ~ time | num),
formSurv = Surv(fuyrs, status) ~ age,
data = hvd,
timeVar = c("time", "time", "time"),
control = list(convCrit = "sas", rav = 0.01),
verbose = FALSE)
}
# test
expect_error(f(), "The length of timeVar must equal 2")
})
test_that("misspelled timeVar mismatch throws error", {
# load data + fit model
data(heart.valve)
hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ]
f <- function() {
mjoint(
formLongFixed = list("grad" = log.grad ~ time + sex + hs,
"lvmi" = log.lvmi ~ time + sex),
formLongRandom = list("grad" = ~ 1 | num,
"lvmi" = ~ time | num),
formSurv = Surv(fuyrs, status) ~ age,
data = hvd,
timeVar = "Time",
control = list(convCrit = "sas", rav = 0.01),
verbose = FALSE)
}
# test
expect_error(f(), "undefined columns selected")
})
test_that("unmatched control prarameter throws warning", {
# load data + fit model
data(heart.valve)
hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ]
f <- function() {
mjoint(
formLongFixed = list("grad" = log.grad ~ time + sex + hs,
"lvmi" = log.lvmi ~ time + sex),
formLongRandom = list("grad" = ~ 1 | num,
"lvmi" = ~ time | num),
formSurv = Surv(fuyrs, status) ~ age,
data = hvd,
timeVar = "time",
control = list(convCrit = "abs", tol0 = 0.1, burnin = 3,
mcmaxIter = 4, fake_param = 5),
verbose = FALSE)
}
# test
expect_warning(f(), "Unknown arguments passed to 'control': fake_param")
})
test_that("unmatched inits throws warning", {
# load data + fit model
data(heart.valve)
hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ]
f <- function() {
mjoint(
formLongFixed = list("grad" = log.grad ~ time + sex + hs,
"lvmi" = log.lvmi ~ time + sex),
formLongRandom = list("grad" = ~ 1 | num,
"lvmi" = ~ time | num),
formSurv = Surv(fuyrs, status) ~ age,
inits = list("fake_param" = 5),
data = hvd,
timeVar = "time",
control = list(convCrit = "abs", tol0 = 0.1, burnin = 3,
mcmaxIter = 4, fake_param = 5),
verbose = FALSE)
}
# test
expect_warning(f(), "Unknown initial parameters passed to 'inits': fake_param")
})
test_that("measurement time after event time throws error", {
# load data + fit model
data(heart.valve)
hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ]
hvd[hvd$num == "6", "fuyrs"] <- 0.1
f <- function() {
mjoint(
formLongFixed = list("grad" = log.grad ~ time + sex + hs,
"lvmi" = log.lvmi ~ time + sex),
formLongRandom = list("grad" = ~ 1 | num,
"lvmi" = ~ time | num),
formSurv = Surv(fuyrs, status) ~ age,
data = hvd,
timeVar = "time",
control = list(convCrit = "sas", rav = 0.01, burnin = 5,
mcmaxIter = 10),
verbose = FALSE)
}
# test
expect_error(f(), "Longitudinal measurements should not be recorded after the event time")
})
test_that("measurement time after event time throws error", {
# load data + fit model
data(heart.valve)
hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ]
D <- matrix(1:9, nrow = 3)
f <- function() {
mjoint(
formLongFixed = list("grad" = log.grad ~ time + sex + hs,
"lvmi" = log.lvmi ~ time + sex),
formLongRandom = list("grad" = ~ 1 | num,
"lvmi" = ~ time | num),
formSurv = Surv(fuyrs, status) ~ age,
inits = list("D" = D),
data = hvd,
timeVar = "time",
control = list(convCrit = "sas", rav = 0.01, burnin = 4,
mcmaxIter = 5),
verbose = FALSE)
}
# test
expect_warning(f(), "Initial parameter matrix D is non positive definite: falling back to automated value")
})
test_that("unbalanced data throws warning for survival inits", {
# load data + fit model
data(heart.valve)
# make unbalanced dataset for patients in common
id <- unique(heart.valve$num[!is.na(heart.valve$log.grad)])
hvd1 <- subset(heart.valve[!is.na(heart.valve$log.grad), ], num %in% id)
hvd2 <- subset(heart.valve[!is.na(heart.valve$log.lvmi), ], num %in% id)
f <- function() {mjoint(
formLongFixed = list("grad" = log.grad ~ time + sex + hs,
"lvmi" = log.lvmi ~ time + sex),
formLongRandom = list("grad" = ~ 1 | num,
"lvmi" = ~ time | num),
formSurv = Surv(fuyrs, status) ~ age,
data = list(hvd1, hvd2),
timeVar = "time",
control = list(convCrit = "sas", burnin = 5, mcmaxIter = 10),
verbose = FALSE)
}
# test
expect_message(f(), "Data are unbalanced... using sub-optimal initial parameters for gamma")
})
test_that("argument not correct object class", {
expect_error(vcov.mjoint(1), "Use only with 'mjoint' model objects.")
expect_error(summary.mjoint(1), "Use only with 'mjoint' model objects.")
expect_error(ranef.mjoint(1), "Use only with 'mjoint' model objects.")
expect_error(plotConvergence(1), "Use only with 'mjoint' model objects.")
expect_error(plot.mjoint(1), "Use only with 'mjoint' model objects.")
expect_error(confint.mjoint(1), "Use only with 'mjoint' model objects.")
expect_error(bootSE(1), "Use only with 'mjoint' model objects.")
expect_error(fixef.mjoint(1), "Use only with 'mjoint' model objects.")
expect_error(formula.mjoint(1), "Use only with 'mjoint' model objects.")
expect_error(getVarCov.mjoint(1), "Use only with 'mjoint' model objects.")
expect_error(sigma.mjoint(1), "Use only with 'mjoint' model objects.")
expect_error(logLik.mjoint(1), "Use only with 'mjoint' model objects.")
expect_error(print.mjoint(1), "Use only with 'mjoint' model objects.")
expect_error(baseHaz(1), "Use only with 'mjoint' model objects.")
expect_error(sampleData(1), "Use only with 'mjoint' model objects.")
expect_error(print.dynSurv(1), "Use only with 'dynSurv' objects.")
expect_error(print.dynLong(1), "Use only with 'dynLong' objects.")
expect_error(plot.dynSurv(1), "Use only with 'dynSurv' objects.")
expect_error(plot.dynLong(1), "Use only with 'dynLong' objects.")
expect_error(print.summary.mjoint(1), "Use only with 'summary.mjoint' objects.")
})
test_that("argument not a summary.mjoint object", {
})
test_that("formula with unspecified longitudinal measure throws error", {
# load data + fit model
data(heart.valve)
hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ]
fit <- mjoint(
formLongFixed = list("grad" = log.grad ~ time + sex + hs,
"lvmi" = log.lvmi ~ time + sex),
formLongRandom = list("grad" = ~ 1 | num,
"lvmi" = ~ time | num),
formSurv = Surv(fuyrs, status) ~ age,
data = hvd,
timeVar = "time",
control = list(convCrit = "abs", rav = 0.05, burnin = 5,
mcmaxIter = 7),
verbose = FALSE)
# tests
expect_error(formula(fit, process = "Longitudinal", k = NA),
"Must specify a longitudinal outcome.")
expect_error(formula(fit, process = "Longitudinal", k = 3),
"Incompatible with dimensions of the joint model.")
})
test_that("simulation errors", {
# tests
expect_error(simData(10, model = "fake"), "Unknown model: fake")
expect_error(simData(10, sigma2 = 1, gamma.y = 1, D = 1,
beta = matrix(rep(1, 4), nrow = 1)),
"Error: this function on simulates multivariate data")
expect_error(simData(10, D = matrix(rep(1, 16), 4, 4)),
"Covariance matrix must be positive semi-definite")
D <- diag(4)
D[1, 2] <- 0.1
expect_error(simData(10, D = D),
"Covariance matrix is not symmetric")
})
test_that("mismatched dimensions of inits", {
# load data
data(pbc2)
pbc2$log.b <- log(pbc2$serBilir)
# tests
expect_error(mjoint(
formLongFixed = list("log.bil" = log.b ~ year),
formLongRandom = list("log.bil" = ~ year | id),
formSurv = Surv(years, status2) ~ age,
data = pbc2,
timeVar = "year",
inits = list("sigma2" = c(1, 2))),
"Dimension of sigma2 inits does not match model.")
expect_error(mjoint(
formLongFixed = list("log.bil" = log.b ~ year),
formLongRandom = list("log.bil" = ~ year | id),
formSurv = Surv(years, status2) ~ age,
data = pbc2,
timeVar = "year",
inits = list("gamma" = c(1, 2, 3))),
"Dimension of gamma inits does not match model.")
expect_error(mjoint(
formLongFixed = list("log.bil" = log.b ~ year),
formLongRandom = list("log.bil" = ~ year | id),
formSurv = Surv(years, status2) ~ age,
data = pbc2,
timeVar = "year",
inits = list("D" = diag(1, ncol = 1))),
"Dimension of D inits does not match model.")
expect_error(mjoint(
formLongFixed = list("log.bil" = log.b ~ year),
formLongRandom = list("log.bil" = ~ year | id),
formSurv = Surv(years, status2) ~ age,
data = pbc2,
timeVar = "year",
inits = list("beta" = 1)),
"Dimension of beta inits does not match model.")
})
test_that("same patients measured on all markers", {
# load data + function to fit model
data(heart.valve)
hvd1 <- heart.valve[!is.na(heart.valve$log.grad), ]
hvd2 <- heart.valve[!is.na(heart.valve$log.lvmi), ]
fit <- function() {
mjoint(formLongFixed = list("grad" = log.grad ~ time + sex + hs,
"lvmi" = log.lvmi ~ time + sex),
formLongRandom = list("grad" = ~ 1 | num,
"lvmi" = ~ time | num),
formSurv = Surv(fuyrs, status) ~ age,
data = list(hvd1, hvd2),
inits = list("gamma" = c(0.11, 1.51, 0.80)),
timeVar = "time",
verbose = TRUE)
}
# tests
expect_error(fit(), "Every subject must have at least one measurement per each outcome")
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.