tests/testthat/test-Cindex.R

In SurvMetrics: Predictive Evaluation Metrics in Survival Analysis

test_that("Cindex", {
  # 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)
  predicted <- c(2, 3, 3, 3, 4, 2, 4, 3)
  expect_type(Cindex(Surv(time, status), predicted), "double")
  expval=0.642857
  names(expval)="C index"
  expect_equal(Cindex(Surv(time, status), predicted), expval)
  expval=1; names(expval)="C index"
  expect_equal(Cindex(Surv(c(1,2), c(1,1)), c(0.5, 0.6)), expval)

  expval=0; names(expval)="C index"
  expect_equal(Cindex(Surv(c(1,2), c(1,1)), c(0.6, 0.5)), expval)

  expval=0.5; names(expval)="C index"
  expect_equal(Cindex(Surv(c(1,2), c(1,1)), c(0.5, 0.5)), expval)

  expval=1; names(expval)="C index"
  expect_equal(Cindex(Surv(c(1,1), c(1,1)), c(0.5, 0.5)), expval)

  expval=0.5; names(expval)="C index"
  expect_equal(Cindex(Surv(c(1,1), c(1,1)), c(0.5, 0.6)), expval)

  expval=0.5; names(expval)="C index"
  expect_equal(Cindex(Surv(c(1,1), c(1,0)), c(0.5, 0.5)), expval)

  expval=1; names(expval)="C index"
  expect_equal(Cindex(Surv(c(1,1), c(1,0)), c(0.5, 0.6)), expval)

  expval=0.5; names(expval)="C index"
  expect_equal(Cindex(Surv(c(1,1), c(1,0)), c(0.6, 0.5)),expval)

  expval=1; names(expval)="C index"
  expect_equal(Cindex(Surv(c(1,2), c(1,0)), c(0.5, 0.6)), expval)

  expval=0.5; names(expval)="C index"
  expect_equal(Cindex(Surv(c(1,2), c(1,0)), c(0.5, 0.5)), expval)

  expval=0; names(expval)="C index"
  expect_equal(Cindex(Surv(c(1,2), c(1,0)), c(0.6, 0.5)), expval)



  expect_error(
    Cindex(Surv(time[-1], status), predicted),
    "Time and status are different lengths"
  )
  expect_error(
    Cindex(Surv(time, status), predicted[-1]),
    "The lengths of time and predicted are not equal"
  )
  time[1] <- NA
  expect_error(
    Cindex(Surv(time, status), predicted),
    "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(Cindex(coxfit, test_data), "double")
  expval=0.829897; names(expval)="C index"
  expect_equal(Cindex(coxfit, test_data), expval)

  # test RSF
  rsffit <- rfsrc(Surv(time, status) ~ ., data = train_data)
  expect_type(Cindex(rsffit, test_data), "double")
  expval=0.765464; names(expval)="C index"
  expect_equal(Cindex(rsffit, test_data), expval)

  # test survreg
  for (dist in c(
    "weibull",
    "exponential",
    "gaussian",
    "logistic",
    "lognormal",
    "loglogistic"
  )) {
    survregfit <- survreg(Surv(time, status) ~ .,
      dist = dist, data = train_data
    )
    expect_type(Cindex(survregfit, test_data), "double")
  }
})