context("GAMs") set.seed(12345) # CRAN skip atlas check fix testthat::skip_if(grepl(pattern = "atlas", sessionInfo()$BLAS, ignore.case = TRUE)) # Skip tests if mgcv is not installed testthat::skip_if_not_installed("mgcv") # To pass the noLD checks eps <- if (capabilities("long.double")) sqrt(.Machine$double.eps) else 0.1 # Create data---- 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))) extra_vars <- matrix(rnorm(10 * n), ncol = 10) DF_ext <- cbind(DF, as.data.frame(extra_vars)) DT_ext <- cbind(DT, as.data.table(extra_vars)) formula_gam <- formula(paste(c("event ~ s(ftime)", "Z", paste0("V", 1:10)), collapse = " + ")) # Fitting---- test_that("no error in fitting gam", { fitDF <- try(fitSmoothHazard(formula_gam, data = DF_ext, time = "ftime", family = "gam"), silent = TRUE) fitDT <- try(fitSmoothHazard(formula_gam, data = DT_ext, time = "ftime", family = "gam"), silent = TRUE) expect_false(inherits(fitDF, "try-error")) expect_false(inherits(fitDT, "try-error")) }) # Absolute risk---- fitDF_gam <- fitSmoothHazard(event ~ s(ftime) + Z, data = DF, time = "ftime", family = "gam", ratio = 10) fitDT_gam <- fitSmoothHazard(event ~ s(ftime) + Z, data = DT, time = "ftime", family = "gam", ratio = 10) newDT <- data.table("Z" = c(0, 1)) newDF <- data.frame("Z" = c(0, 1)) test_that("no error in abs risk for gam", { riskDF <- try(absoluteRisk(fitDF_gam, time = 0.5, newdata = newDF), silent = TRUE) riskDT <- try(absoluteRisk(fitDT_gam, time = 0.5, newdata = newDT), silent = TRUE) riskDF_mc <- try(absoluteRisk(fitDF_gam, time = 0.5, newdata = newDF, method = "montecarlo"), silent = TRUE) riskDT_mc <- try(absoluteRisk(fitDT_gam, time = 0.5, newdata = newDT, method = "montecarlo"), silent = TRUE) expect_false(inherits(riskDF, "try-error")) expect_false(inherits(riskDT, "try-error")) expect_false(inherits(riskDF_mc, "try-error")) expect_false(inherits(riskDT_mc, "try-error")) }) test_that("should compute risk when time and newdata aren't provided", { absRiskDF_gam <- absoluteRisk(fitDF_gam) absRiskDT_gam <- absoluteRisk(fitDT_gam) expect_true("risk" %in% names(absRiskDF_gam)) expect_true("risk" %in% names(absRiskDT_gam)) }) test_that("output probabilities", { riskDF_gam <- absoluteRisk(fitDF_gam, time = 0.5, newdata = newDF, family = "gam") riskDT_gam <- absoluteRisk(fitDT_gam, time = 0.5, newdata = newDT, family = "gam") expect_true(all(riskDF_gam >= 0 - eps)) expect_true(all(riskDT_gam >= 0 - eps)) expect_true(all(riskDF_gam <= 1 + eps)) expect_true(all(riskDT_gam <= 1 + eps)) }) # Summary method test_that("no error in summary method for gam", { sumDF <- try(summary(fitDF_gam), silent = TRUE) sumDT <- try(summary(fitDT_gam), silent = TRUE) expect_false(inherits(sumDF, "try-error")) expect_false(inherits(sumDT, "try-error")) })