test_that("Brier", { # case 1 Surv object library(survival) time <- c(1, 1, 2, 2, 2, 2, 2, 2) status <- c(0, 1, 1, 0, 1, 1, 0, 1) pre_sp <- c(0.3, 0.2, 0.4, 0.5, 0.9, 0.1, 0.2, 0.7) expect_type(Brier(Surv(time, status), pre_sp), "double") expval1=0.468571 names(expval1)="Brier Score" expect_equal(Brier(Surv(time, status), pre_sp), expval1) expect_error( Brier(Surv(time[-1], status), pre_sp), "Time and status are different lengths" ) expect_error( Brier(Surv(time, status), pre_sp, NA), "Cannot calculate Brier Score at NA" ) expect_error( Brier(Surv(time, status), NA), "The input probability vector cannot have NA" ) expect_error( Brier(Surv(time, status), pre_sp[-1]), "The prediction survival probability and the survival object have different lengths" ) time[1] <- NA expect_error( Brier(Surv(time, status), pre_sp), "The input vector cannot have NA" ) # case2 fit object library(randomForestSRC) library(pec) set.seed(1234) mydata <- kidney[, -1] train_index <- sample(1:nrow(mydata), 0.7 * nrow(mydata)) train_data <- mydata[train_index, ] test_data <- mydata[-train_index, ] # test coxph coxfit <- coxph(Surv(time, status) ~ ., data = train_data, x = TRUE) expect_type(Brier(coxfit, test_data), "double") expval2=0.183243 names(expval2)="Brier Score" expect_equal(Brier(coxfit, test_data), expval2) # test RSF rsffit <- rfsrc(Surv(time, status) ~ ., data = train_data) expect_type(Brier(rsffit, test_data), "double") expval3=0.218108 names(expval3)="Brier Score" expect_equal(Brier(rsffit, test_data), expval3) # test survreg for (dist in c( "weibull", "exponential", "gaussian", "logistic", "lognormal", "loglogistic" )) { survregfit <- survreg(Surv(time, status) ~ ., dist = dist, data = train_data ) expect_type(Brier(survregfit, test_data), "double") } })