tests/testthat/test_cox.R

In chjackson/fic: Focused Information Criteria for Model Comparison

library(survival)
wide <- coxph(Surv(years, death==1) ~ sex + thick_centred + infilt + epith + ulcer + depth + age, data=melanoma)

inds <- rbind(c(1,1,1,1,1,1,1,1,1,1),
              c(1,1,1,1,1,1,1,1,1,0),
              c(1,1,1,1,1,1,1,0,0,0),
              c(1,1,1,1,1,1,0,0,0,0),
              c(1,1,1,1,1,0,0,0,0,0),
              c(1,1,0,0,0,0,0,0,0,0),
              c(1,0,0,0,0,0,0,0,0,0))
inds0 <- c(1,0,0,0,0,0,0,0,0,0)

newdata <- with(melanoma,
                data.frame(sex = c("female","male"),
                           thick_centred = tapply(thick_centred, sex, mean),
                           infilt=4, epith=1, ulcer=1, depth=2,
                           age = tapply(age, sex, mean)))
X <- newdata_to_X(newdata, wide, intercept=FALSE)

ficall <- fic(wide, inds=inds, inds0=inds0, focus="survival", X=X, t=5)

expect_error(fic(wide, inds=inds, inds0=inds0, focus="survival", X=X, t=-1), "all > 0")
expect_error(fic(wide, inds=inds, inds0=inds0, focus="survival", X=X, t="foo"), "must be numeric")

test_that("Cox FIC results",{
    expect_equal(ficall$FIC[1:8],
                 c(9.56963761576712, 9.62619861138848, 8.60796715809067, 16.3132883942816, 
                   25.4775188260772, 25.2462463739319, 15.136514133193, 9.45357761358747), tol=1e-06)
    expect_equal(ficall$rmse[1:8],
                 c(0.170905480487675, 0.171710775889101, 0.156580994560079, 0.249207826355617, 
0.326815091143021, 0.325084520541464, 0.282320311026908, 0.171966784884666), tol=1e-06)
})

test_that("Built-in focus matches manual focus",{
focus_list <- list(focus = cox_survival,
                   focus_deriv = cox_survival_deriv,
                   focus_dH = cox_survival_dH)
ficall2 <- fic(wide, inds=inds, inds0=inds0, focus=focus_list, X=X, t=5)
expect_equal(ficall, ficall2)
})