tests/testthat/test-fitting.R

In sahirbhatnagar/casebase: Fitting Flexible Smooth-in-Time Hazards and Risk Functions via Logistic and Multinomial Regression

context("Fitting")
set.seed(12345)

# CRAN skip atlas check fix
testthat::skip_if(grepl(pattern = "atlas", sessionInfo()$BLAS,
                        ignore.case = TRUE))


n <- 100
alp <- 0.05
lambda_t0 <- 1
lambda_t1 <- 3

times <- c(rexp(n = n, rate = lambda_t0),
           rexp(n = n, rate = lambda_t1))
censor <- rexp(n = 2 * n, rate = -log(alp))

times_c <- pmin(times, censor)
event_c <- 1 * (times < censor)

DF <- data.frame("ftime" = times_c,
                 "event" = event_c,
                 "Z" = c(rep(0, n),
                         rep(1, n)))
DT <- data.table("ftime" = times_c,
                 "event" = event_c,
                 "Z" = c(rep(0, n),
                         rep(1, n)))

test_that("no error in fitting with data.frame and data.table", {
    fitDF <- try(fitSmoothHazard(event ~ Z, data = DF, time = "ftime"),
                silent = TRUE)
    fitDT <- try(fitSmoothHazard(event ~ Z, data = DT, time = "ftime"),
                 silent = TRUE)

    expect_false(inherits(fitDF, "try-error"))
    expect_false(inherits(fitDT, "try-error"))
})

test_that("allow dot notation in formula", {
    try(model <- fitSmoothHazard(DeadOfPrCa ~ ., data = ERSPC,
                                 time = "Follow.Up.Time", ratio = 100),
        silent = TRUE)

    expect_false(inherits(model, "try-error"))
})

test_that("sampling first and then fitting", {
    data_cb <- sampleCaseBase(ERSPC, time = "Follow.Up.Time",
                              ratio = 10, event = "DeadOfPrCa")
    try(model <- fitSmoothHazard(DeadOfPrCa ~ ., data = data_cb),
        silent = TRUE)

    expect_false(inherits(model, "try-error"))
})

# Summary method
test_that("no error in summary method for gam", {
    fitDF <- try(fitSmoothHazard(event ~ Z, data = DF, time = "ftime"),
                 silent = TRUE)
    fitDT <- try(fitSmoothHazard(event ~ Z, data = DT, time = "ftime"),
                 silent = TRUE)

    sumDF <- try(summary(fitDF),
                 silent = TRUE)
    sumDT <- try(summary(fitDT),
                 silent = TRUE)

    expect_false(inherits(sumDF, "try-error"))
    expect_false(inherits(sumDT, "try-error"))
})

#####################
# Formula parsing----
form <- formula(event ~ exposure + time)
form_bs <- formula(event ~ exposure + bs(time))
form_log <- formula(event ~ exposure + log(time))
form_int <- formula(event ~ exposure * time)
form_nested <- formula(cens ~ horTh * nsx(log(time), df = 3) + age * time)

form_bs_extra <- formula(event ~ exposure + bs(time, df = 3))
form_bs_named <- formula(event ~ exposure + bs(x = time))

test_that("detecting non-linear functions of time", {
    expect_false(detect_nonlinear_time(form, "time"))
    expect_true(detect_nonlinear_time(form_bs, "time"))
    expect_true(detect_nonlinear_time(form_log, "time"))
    expect_false(detect_nonlinear_time(form_int, "time"))
    expect_true(detect_nonlinear_time(form_nested, "time"))

    expect_true(detect_nonlinear_time(form_bs_extra, "time"))
    expect_true(detect_nonlinear_time(form_bs_named, "time"))
})

wrong <- formula(event ~ exposure + time + wrongtime)
wrong_bs <- formula(event ~ exposure + time + bs(wrongtime))
wrong_log <- formula(event ~ exposure + time + log(wrongtime))
wrong_int <- formula(event ~ exposure * wrongtime + time)

wrong2 <- formula(event ~ exposure + time + timewrong)
wrong2_bs <- formula(event ~ exposure + time + bs(timewrong))
wrong2_log <- formula(event ~ exposure + time + log(timewrong))
wrong2_int <- formula(event ~ exposure * timewrong + time)

test_that("Making sure we don't pick up anything that looks like time", {
    expect_false(detect_nonlinear_time(wrong, "time"))
    expect_false(detect_nonlinear_time(wrong_bs, "time"))
    expect_false(detect_nonlinear_time(wrong_log, "time"))
    expect_false(detect_nonlinear_time(wrong_int, "time"))
    expect_false(detect_nonlinear_time(wrong2, "time"))
    expect_false(detect_nonlinear_time(wrong2_bs, "time"))
    expect_false(detect_nonlinear_time(wrong2_log, "time"))
    expect_false(detect_nonlinear_time(wrong2_int, "time"))
})

test_that("detecting interactions with time", {
    expect_false(detect_interaction(form))
    expect_false(detect_interaction(form_bs))
    expect_false(detect_interaction(form_log))
    expect_true(detect_interaction(form_int))
})