Nothing
# test tidy, augment, glance methods for mjoint object (joineRML package)
context("Tidiers")
library(joineRML)
# Data
data(heart.valve, package = "joineRML")
hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi) & heart.valve$num <= 50, ]
# Model fits
fit1 <- suppressMessages(joineRML::mjoint(
formLongFixed = list("grad" = log.grad ~ time),
formLongRandom = list("grad" = ~ 1 | num),
formSurv = survival::Surv(fuyrs, status) ~ age,
data = hvd,
timeVar = "time"
))
fit2 <- suppressMessages(joineRML::mjoint(
formLongFixed = list(
"grad" = log.grad ~ time,
"lvmi" = log.lvmi ~ time
),
formLongRandom = list(
"grad" = ~ 1 | num,
"lvmi" = ~ 1 | num
),
formSurv = Surv(fuyrs, status) ~ age,
data = hvd,
timeVar = "time"
))
# Bootstrapped SEs
set.seed(092345798)
bSE1 <- suppressMessages(bootSE(fit1, nboot = 3, safe.boot = TRUE, progress = FALSE))
bSE2 <- suppressMessages(bootSE(fit2, nboot = 3, safe.boot = TRUE, progress = FALSE))
test_that("tidy works on mjoint models with a single longitudinal process", {
td <- tidy(fit1)
expect_equal(nrow(td), 2)
td <- tidy(fit1, component = "survival")
expect_equal(nrow(td), 2)
td <- tidy(fit1, component = "longitudinal")
expect_equal(nrow(td), 2)
td <- tidy(fit1, component = "survival", bootSE = bSE1)
expect_equal(nrow(td), 2)
td <- tidy(fit1, component = "longitudinal", bootSE = bSE1)
expect_equal(nrow(td), 2)
td <- tidy(fit1, component = "survival")
expect_equal(td$term, c("age", "gamma_1"))
td <- tidy(fit1, component = "longitudinal")
expect_equal(td$term, c("(Intercept)_1", "time_1"))
})
test_that("tidy works on mjoint models with more than one longitudinal process", {
td <- tidy(fit2)
expect_equal(nrow(td), 3)
td <- tidy(fit2, component = "survival")
expect_equal(nrow(td), 3)
td <- tidy(fit2, component = "longitudinal")
expect_equal(nrow(td), 4)
td <- tidy(fit2, component = "survival", bootSE = bSE2)
expect_equal(nrow(td), 3)
td <- tidy(fit2, component = "longitudinal", bootSE = bSE2)
expect_equal(nrow(td), 4)
td <- tidy(fit2, component = "survival")
expect_equal(td$term, c("age", "gamma_1", "gamma_2"))
td <- tidy(fit2, component = "longitudinal")
expect_equal(td$term, c("(Intercept)_1", "time_1", "(Intercept)_2", "time_2"))
})
test_that("augment works on mjoint models with a single longitudinal process", {
augdf <- augment(fit1)
expect_equal(nrow(augdf), nrow(hvd))
expect_equal(ncol(augdf), ncol(hvd) + 4)
expect_equal(names(augdf), c(names(hvd), ".fitted_grad_0", ".fitted_grad_1", ".resid_grad_0", ".resid_grad_1"))
})
test_that("augment works on mjoint models with more than one longitudinal process", {
augdf <- augment(fit2)
expect_equal(nrow(augdf), nrow(hvd))
expect_equal(ncol(augdf), ncol(hvd) + 8)
expect_equal(names(augdf), c(names(hvd), ".fitted_grad_0", ".fitted_lvmi_0", ".fitted_grad_1", ".fitted_lvmi_1", ".resid_grad_0", ".resid_lvmi_0", ".resid_grad_1", ".resid_lvmi_1"))
})
test_that("augment returns the same output whether we pass 'data' or not", {
expect_equal(object = names(augment(fit1)), expected = names(augment(fit1, data = list(hvd))))
expect_equal(object = dim(augment(fit1)), expected = dim(augment(fit1, data = list(hvd))))
expect_equal(object = names(augment(fit2)), expected = names(augment(fit2, data = list(hvd))))
expect_equal(object = dim(augment(fit2)), expected = dim(augment(fit2, data = list(hvd))))
})
test_that("glance works on mjoint models with a single longitudinal process", {
glnc <- glance(fit1)
expect_equal(nrow(glnc), 1)
expect_equal(ncol(glnc), 4)
expect_equal(names(glnc), c("sigma2_1", "AIC", "BIC", "logLik"))
})
test_that("glance works on mjoint models with more than one longitudinal process", {
glnc <- glance(fit2)
expect_equal(nrow(glnc), 1)
expect_equal(ncol(glnc), 5)
expect_equal(names(glnc), c("sigma2_1", "sigma2_2", "AIC", "BIC", "logLik"))
})
test_that("tidy fails if passing a bootSE object that is not a bootSE object", {
expect_error(tidy(fit1, bootSE = list()))
expect_error(tidy(fit2, bootSE = list()))
})
test_that("tidy returns confidence intervals if required", {
expect_true(all(c("conf.low", "conf.high") %in% names(tidy(fit1, conf.int = TRUE))))
expect_true(all(c("conf.low", "conf.high") %in% names(tidy(fit1, conf.int = TRUE, bootSE = bSE1))))
expect_true(all(c("conf.low", "conf.high") %in% names(tidy(fit2, conf.int = TRUE))))
expect_true(all(c("conf.low", "conf.high") %in% names(tidy(fit2, conf.int = TRUE, bootSE = bSE2))))
})
test_that("augment fails if cannot extract data from x", {
fit1_broken <- fit1
fit1_broken$data <- NULL
expect_error(augment(fit1_broken))
nd <- list(fit1$data[[1]], fit1$data[[1]][sample(x = seq(nrow(fit1$data[[1]])), size = nrow(fit1$data[[1]])), ])
expect_error(augment(fit1_broken))
fit2_broken <- fit2
fit2_broken$data <- NULL
expect_error(augment(fit2_broken))
nd <- list(fit2$data[[1]], fit2$data[[1]][sample(x = seq(nrow(fit2$data[[1]])), size = nrow(fit2$data[[1]])), ])
expect_error(augment(fit2_broken))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.