tests/testthat/test-test-vim.R

In cwolock/survML: Tools for Flexible Survival Analysis Using Machine Learning

set.seed(1)
y <- rexp(100, 1)
delta <- rbinom(100, size = 1, prob = 0.5)
X <- data.frame(rnorm(100), rnorm(100))
landmark_times <- quantile(y, probs = c(0.25, 0.5, 0.75))
approx_times <- sort(c(unique(y), landmark_times))

################################
### no crossfit, no sample split
################################
f_hat <- list(f_hat = matrix(runif(300), nrow = 100, ncol = length(landmark_times)))
fs_hat <- list(fs_hat = matrix(runif(300), nrow = 100, ncol = length(landmark_times)))
S_hat <- list(S_hat = matrix(rep(seq(1, 0.1, length.out = length(approx_times)), 100),
                             nrow = 100,
                             ncol = length(approx_times),
                             byrow = TRUE))
G_hat <- list(G_hat = matrix(rep(seq(1, 0.1, length.out = length(approx_times)), 100),
                             nrow = 100,
                             ncol = length(approx_times),
                             byrow = TRUE))
folds <- rep(1, 100)
ss_folds <- rep(1, 100)

# accuracy
output <- vim_accuracy(time = y,
                       event = delta,
                       approx_times = approx_times,
                       landmark_times = landmark_times,
                       f_hat = f_hat,
                       fs_hat = fs_hat,
                       S_hat = S_hat,
                       G_hat = G_hat,
                       cf_folds = folds,
                       ss_folds = ss_folds,
                       sample_split = FALSE)
test_that("vim_accuracy(). no xfit, no sample split", {
  expect_equal(dim(output)[1], 3)
  expect_equal(dim(output)[2], 9)
  expect_equal(names(output), c("landmark_time", "est", "var_est", "cil", "ciu",
                                "cil_1sided", "p", "large_predictiveness", "small_predictiveness"))
  expect_equal(sum(is.na(output)), 3)
})

# AUC
output <- vim_AUC(time = y,
                  event = delta,
                  approx_times = approx_times,
                  landmark_times = landmark_times,
                  f_hat = f_hat,
                  fs_hat = fs_hat,
                  S_hat = S_hat,
                  G_hat = G_hat,
                  cf_folds = folds,
                  ss_folds = ss_folds,
                  sample_split = FALSE)
test_that("vim_AUC(). no xfit, no sample split", {
  expect_equal(dim(output)[1], 3)
  expect_equal(dim(output)[2], 9)
  expect_equal(names(output), c("landmark_time", "est", "var_est", "cil", "ciu",
                                "cil_1sided", "p", "large_predictiveness", "small_predictiveness"))
  expect_equal(sum(is.na(output)), 3)
})

# Brier score
output <- vim_brier(time = y,
                    event = delta,
                    approx_times = approx_times,
                    landmark_times = landmark_times,
                    f_hat = f_hat,
                    fs_hat = fs_hat,
                    S_hat = S_hat,
                    G_hat = G_hat,
                    cf_folds = folds,
                    ss_folds = ss_folds,
                    sample_split = FALSE)
test_that("vim_brier(). no xfit, no sample split", {
  expect_equal(dim(output)[1], 3)
  expect_equal(dim(output)[2], 9)
  expect_equal(names(output), c("landmark_time", "est", "var_est", "cil", "ciu",
                                "cil_1sided", "p", "large_predictiveness", "small_predictiveness"))
  expect_equal(sum(is.na(output)), 3)
})

# R-squared
output <- vim_rsquared(time = y,
                       event = delta,
                       approx_times = approx_times,
                       landmark_times = landmark_times,
                       f_hat = f_hat,
                       fs_hat = fs_hat,
                       S_hat = S_hat,
                       G_hat = G_hat,
                       cf_folds = folds,
                       ss_folds = ss_folds,
                       sample_split = FALSE)
test_that("vim_rsquared(). no xfit, no sample split", {
  expect_equal(dim(output)[1], 3)
  expect_equal(dim(output)[2], 9)
  expect_equal(names(output), c("landmark_time", "est", "var_est", "cil", "ciu",
                                "cil_1sided", "p", "large_predictiveness", "small_predictiveness"))
  expect_equal(sum(is.na(output)), 3)
})

# RMST MSE
output <- vim_survival_time_mse(time = y,
                                event = delta,
                                approx_times = approx_times,
                                restriction_time = landmark_times[3],
                                f_hat = lapply(f_hat, function(x) x[,1]),
                                fs_hat = lapply(fs_hat, function(x) x[,1]),
                                S_hat = S_hat,
                                G_hat = G_hat,
                                cf_folds = folds,
                                ss_folds = ss_folds,
                                sample_split = FALSE)
test_that("vim_rmst_mse(). no xfit, no sample split", {
  expect_equal(dim(output)[1], 1)
  expect_equal(dim(output)[2], 9)
  expect_equal(names(output), c("restriction_time", "est", "var_est", "cil", "ciu",
                                "cil_1sided", "p", "large_predictiveness", "small_predictiveness"))
  expect_equal(sum(is.na(output)), 1)
})

# C-index
output <- vim_cindex(time = y,
                     event = delta,
                     approx_times = approx_times,
                     restriction_time = landmark_times[3],
                     f_hat = lapply(f_hat, function(x) x[,1]),
                     fs_hat = lapply(fs_hat, function(x) x[,1]),
                     S_hat = S_hat,
                     G_hat = G_hat,
                     cf_folds = folds,
                     ss_folds = ss_folds,
                     sample_split = FALSE)
test_that("vim_cindex(). no xfit, no sample split", {
  expect_equal(dim(output)[1], 1)
  expect_equal(dim(output)[2], 9)
  expect_equal(names(output), c("restriction_time", "est", "var_est", "cil", "ciu",
                                "cil_1sided", "p", "large_predictiveness", "small_predictiveness"))
  expect_equal(sum(is.na(output)), 1)
})


#############################
### no crossfit, sample split
#############################
f_hat <- list(f_hat_1 = matrix(runif(150), nrow = 50, ncol = length(landmark_times)),
              f_hat_2 = matrix(runif(150), nrow = 50, ncol = length(landmark_times)))
fs_hat <- list(fs_hat_1 = matrix(runif(150), nrow = 50, ncol = length(landmark_times)),
               fs_hat_2 = matrix(runif(150), nrow = 50, ncol = length(landmark_times)))
S_hat <- list(S_hat_1 = matrix(rep(seq(1, 0.1, length.out = length(approx_times)), 50),
                               nrow = 50,
                               ncol = length(approx_times),
                               byrow = TRUE),
              S_hat_2 = matrix(rep(seq(1, 0.1, length.out = length(approx_times)), 50),
                               nrow = 50,
                               ncol = length(approx_times),
                               byrow = TRUE))
G_hat <- list(G_hat_1 = matrix(rep(seq(1, 0.1, length.out = length(approx_times)), 50),
                               nrow = 50,
                               ncol = length(approx_times),
                               byrow = TRUE),
              G_hat_2 = matrix(rep(seq(1, 0.1, length.out = length(approx_times)), 50),
                               nrow = 50,
                               ncol = length(approx_times),
                               byrow = TRUE))
folds <- c(rep(1, 50), rep(2, 50))
ss_folds <- c(rep(1, 50), rep(0, 50))

# accuracy
output <- vim_accuracy(time = y,
                       event = delta,
                       approx_times = approx_times,
                       landmark_times = landmark_times,
                       f_hat = f_hat,
                       fs_hat = fs_hat,
                       S_hat = S_hat,
                       G_hat = G_hat,
                       cf_folds = folds,
                       ss_folds = ss_folds,
                       sample_split = TRUE)
test_that("vim_accuracy(). no xfit, sample split", {
  expect_equal(dim(output)[1], 3)
  expect_equal(dim(output)[2], 9)
  expect_equal(names(output), c("landmark_time", "est", "var_est", "cil", "ciu",
                                "cil_1sided", "p", "large_predictiveness", "small_predictiveness"))
  expect_equal(sum(is.na(output)), 0)
})

# AUC
output <- vim_AUC(time = y,
                  event = delta,
                  approx_times = approx_times,
                  landmark_times = landmark_times,
                  f_hat = f_hat,
                  fs_hat = fs_hat,
                  S_hat = S_hat,
                  G_hat = G_hat,
                  cf_folds = folds,
                  ss_folds = ss_folds,
                  sample_split = TRUE)
test_that("vim_AUC(). no xfit, sample split", {
  expect_equal(dim(output)[1], 3)
  expect_equal(dim(output)[2], 9)
  expect_equal(names(output), c("landmark_time", "est", "var_est", "cil", "ciu",
                                "cil_1sided", "p", "large_predictiveness", "small_predictiveness"))
  expect_equal(sum(is.na(output)), 0)
})

# Brier score
output <- vim_brier(time = y,
                    event = delta,
                    approx_times = approx_times,
                    landmark_times = landmark_times,
                    f_hat = f_hat,
                    fs_hat = fs_hat,
                    S_hat = S_hat,
                    G_hat = G_hat,
                    cf_folds = folds,
                    ss_folds = ss_folds,
                    sample_split = TRUE)
test_that("vim_brier(). no xfit, sample split", {
  expect_equal(dim(output)[1], 3)
  expect_equal(dim(output)[2], 9)
  expect_equal(names(output), c("landmark_time", "est", "var_est", "cil", "ciu",
                                "cil_1sided", "p", "large_predictiveness", "small_predictiveness"))
  expect_equal(sum(is.na(output)), 0)
})

# R-squared
output <- vim_rsquared(time = y,
                       event = delta,
                       approx_times = approx_times,
                       landmark_times = landmark_times,
                       f_hat = f_hat,
                       fs_hat = fs_hat,
                       S_hat = S_hat,
                       G_hat = G_hat,
                       cf_folds = folds,
                       ss_folds = ss_folds,
                       sample_split = TRUE)
test_that("vim_rsquared(). no xfit, sample split", {
  expect_equal(dim(output)[1], 3)
  expect_equal(dim(output)[2], 9)
  expect_equal(names(output), c("landmark_time", "est", "var_est", "cil", "ciu",
                                "cil_1sided", "p", "large_predictiveness", "small_predictiveness"))
  expect_equal(sum(is.na(output)), 0)
})

# RMST MSE
output <- vim_survival_time_mse(time = y,
                                event = delta,
                                approx_times = approx_times,
                                restriction_time = landmark_times[3],
                                f_hat = lapply(f_hat, function(x) x[,1]),
                                fs_hat = lapply(fs_hat, function(x) x[,1]),
                                S_hat = S_hat,
                                G_hat = G_hat,
                                cf_folds = folds,
                                ss_folds = ss_folds,
                                sample_split = TRUE)
test_that("vim_rmst_mse(). no xfit, sample split", {
  expect_equal(dim(output)[1], 1)
  expect_equal(dim(output)[2], 9)
  expect_equal(names(output), c("restriction_time", "est", "var_est", "cil", "ciu",
                                "cil_1sided", "p", "large_predictiveness", "small_predictiveness"))
  expect_equal(sum(is.na(output)), 0)
})

# C-index
output <- vim_cindex(time = y,
                     event = delta,
                     approx_times = approx_times,
                     restriction_time = landmark_times[3],
                     f_hat = lapply(f_hat, function(x) x[,1]),
                     fs_hat = lapply(fs_hat, function(x) x[,1]),
                     S_hat = S_hat,
                     G_hat = G_hat,
                     cf_folds = folds,
                     ss_folds = ss_folds,
                     sample_split = TRUE)
test_that("vim_cindex(). no xfit, sample split", {
  expect_equal(dim(output)[1], 1)
  expect_equal(dim(output)[2], 9)
  expect_equal(names(output), c("restriction_time", "est", "var_est", "cil", "ciu",
                                "cil_1sided", "p", "large_predictiveness", "small_predictiveness"))
  expect_equal(sum(is.na(output)), 0)
})

#####################
### main VIM function
#####################
output <- vim(type = "AUC",
              time = y,
              event = delta,
              X = X,
              landmark_times = landmark_times,
              large_feature_vector = 1:2,
              small_feature_vector = 1,
              conditional_surv_generator_control = list(SL.library = c("SL.mean", "SL.glm"),
                                                        bin_size = 0.1,
                                                        V = 2),
              large_oracle_generator_control = list(SL.library = c("SL.mean", "SL.glm"),
                                                    V = 2),
              small_oracle_generator_control = list(SL.library = c("SL.mean", "SL.glm"),
                                                    V = 2),
              cf_fold_num = 2,
              sample_split = TRUE,
              scale_est = TRUE)
saved_conditional_surv_preds <- output$conditional_surv_preds
saved_large_oracle_preds <- output$large_oracle_preds
saved_small_oracle_preds <- output$small_oracle_preds
saved_folds <- output$folds
saved_approx_times <- output$approx_times
test_that("vim(). AUC, xfit, sample split", {
  expect_equal(dim(output$result)[1], 3)
  expect_equal(dim(output$result)[2], 12)
  expect_equal(names(output$result), c("landmark_time", "est", "var_est", "cil", "ciu",
                                       "cil_1sided", "p", "large_predictiveness", "small_predictiveness",
                                       "vim", "large_feature_vector", "small_feature_vector"))
  expect_equal(sum(is.na(output$result)), 0)
  expect_equal(names(output$folds), c("cf_folds", "ss_folds"))
  expect_equal(length(output$folds$cf_folds), 100)
  expect_equal(length(output$folds$ss_folds), 100)
  expect_equal(sort(unique(output$folds$cf_folds)), c(1,2,3,4))
  expect_equal(sort(unique(output$folds$ss_folds)), c(0,1))
  expect_equal(output$approx_times, sort(unique(c(quantile(y[delta == 1 & y <= max(landmark_times)],
                                                           probs = seq(0, 1, by = 0.01)),
                                                  landmark_times))))
  expect_equal(names(output$conditional_surv_preds), c("S_hat", "S_hat_train", "G_hat", "G_hat_train"))
  expect_equal(dim(output$conditional_surv_preds$S_hat[[1]]), c(25, length(output$approx_times)))
  expect_equal(dim(output$conditional_surv_preds$S_hat_train[[1]]), c(75, length(output$approx_times)))
  expect_equal(dim(output$conditional_surv_preds$G_hat[[1]]), c(25, length(output$approx_times)))
  expect_equal(dim(output$conditional_surv_preds$G_hat_train[[1]]), c(75, length(output$approx_times)))
  expect_equal(names(output$large_oracle_preds), c("f_hat", "f_hat_train"))
  expect_equal(dim(output$large_oracle_preds$f_hat[[1]]), c(25, length(landmark_times)))
  expect_equal(dim(output$large_oracle_preds$f_hat_train[[1]]), c(75, length(landmark_times)))
  expect_equal(names(output$small_oracle_preds), c("f_hat", "f_hat_train"))
  expect_equal(dim(output$small_oracle_preds$f_hat[[1]]), c(25, length(landmark_times)))
  expect_equal(dim(output$small_oracle_preds$f_hat_train[[1]]), c(75, length(landmark_times)))
})

output <- vim(type = "accuracy",
              time = y,
              event = delta,
              X = X,
              landmark_times = landmark_times,
              large_feature_vector = 1:2,
              small_feature_vector = 1,
              conditional_surv_preds = saved_conditional_surv_preds,
              large_oracle_preds = saved_large_oracle_preds,
              small_oracle_preds = saved_small_oracle_preds,
              cf_folds = saved_folds$cf_folds,
              ss_folds = saved_folds$ss_folds,
              approx_times = saved_approx_times,
              sample_split = TRUE,
              scale_est = TRUE)
test_that("vim(). accuracy, xfit, sample split", {
  expect_equal(dim(output$result)[1], 3)
  expect_equal(dim(output$result)[2], 12)
  expect_equal(names(output$result), c("landmark_time", "est", "var_est", "cil", "ciu",
                                       "cil_1sided", "p", "large_predictiveness", "small_predictiveness",
                                       "vim", "large_feature_vector", "small_feature_vector"))
  expect_equal(sum(is.na(output$result)), 0)
  expect_equal(names(output$folds), c("cf_folds", "ss_folds"))
  expect_equal(length(output$folds$cf_folds), 100)
  expect_equal(length(output$folds$ss_folds), 100)
  expect_equal(sort(unique(output$folds$cf_folds)), c(1,2,3,4))
  expect_equal(sort(unique(output$folds$ss_folds)), c(0,1))
  expect_equal(output$approx_times, sort(unique(c(quantile(y[delta == 1 & y <= max(landmark_times)],
                                                           probs = seq(0, 1, by = 0.01)),
                                                  landmark_times))))
  expect_equal(names(output$conditional_surv_preds), c("S_hat", "S_hat_train", "G_hat", "G_hat_train"))
  expect_equal(dim(output$conditional_surv_preds$S_hat[[1]]), c(25, length(output$approx_times)))
  expect_equal(dim(output$conditional_surv_preds$S_hat_train[[1]]), c(75, length(output$approx_times)))
  expect_equal(dim(output$conditional_surv_preds$G_hat[[1]]), c(25, length(output$approx_times)))
  expect_equal(dim(output$conditional_surv_preds$G_hat_train[[1]]), c(75, length(output$approx_times)))
  expect_equal(names(output$large_oracle_preds), c("f_hat", "f_hat_train"))
  expect_equal(dim(output$large_oracle_preds$f_hat[[1]]), c(25, length(landmark_times)))
  expect_equal(dim(output$large_oracle_preds$f_hat_train[[1]]), c(75, length(landmark_times)))
  expect_equal(names(output$small_oracle_preds), c("f_hat", "f_hat_train"))
  expect_equal(dim(output$small_oracle_preds$f_hat[[1]]), c(25, length(landmark_times)))
  expect_equal(dim(output$small_oracle_preds$f_hat_train[[1]]), c(75, length(landmark_times)))
})

output <- vim(type = "Brier",
              time = y,
              event = delta,
              X = X,
              landmark_times = landmark_times,
              large_feature_vector = 1:2,
              small_feature_vector = 1,
              conditional_surv_preds = saved_conditional_surv_preds,
              large_oracle_preds = saved_large_oracle_preds,
              small_oracle_preds = saved_small_oracle_preds,
              cf_folds = saved_folds$cf_folds,
              ss_folds = saved_folds$ss_folds,
              approx_times = saved_approx_times,
              sample_split = TRUE,
              scale_est = TRUE)
test_that("vim(). Brier, xfit, sample split", {
  expect_equal(dim(output$result)[1], 3)
  expect_equal(dim(output$result)[2], 12)
  expect_equal(names(output$result), c("landmark_time", "est", "var_est", "cil", "ciu",
                                       "cil_1sided", "p", "large_predictiveness", "small_predictiveness",
                                       "vim", "large_feature_vector", "small_feature_vector"))
  expect_equal(sum(is.na(output$result)), 0)
  expect_equal(names(output$folds), c("cf_folds", "ss_folds"))
  expect_equal(length(output$folds$cf_folds), 100)
  expect_equal(length(output$folds$ss_folds), 100)
  expect_equal(sort(unique(output$folds$cf_folds)), c(1,2,3,4))
  expect_equal(sort(unique(output$folds$ss_folds)), c(0,1))
  expect_equal(output$approx_times, sort(unique(c(quantile(y[delta == 1 & y <= max(landmark_times)],
                                                           probs = seq(0, 1, by = 0.01)),
                                                  landmark_times))))
  expect_equal(names(output$conditional_surv_preds), c("S_hat", "S_hat_train", "G_hat", "G_hat_train"))
  expect_equal(dim(output$conditional_surv_preds$S_hat[[1]]), c(25, length(output$approx_times)))
  expect_equal(dim(output$conditional_surv_preds$S_hat_train[[1]]), c(75, length(output$approx_times)))
  expect_equal(dim(output$conditional_surv_preds$G_hat[[1]]), c(25, length(output$approx_times)))
  expect_equal(dim(output$conditional_surv_preds$G_hat_train[[1]]), c(75, length(output$approx_times)))
  expect_equal(names(output$large_oracle_preds), c("f_hat", "f_hat_train"))
  expect_equal(dim(output$large_oracle_preds$f_hat[[1]]), c(25, length(landmark_times)))
  expect_equal(dim(output$large_oracle_preds$f_hat_train[[1]]), c(75, length(landmark_times)))
  expect_equal(names(output$small_oracle_preds), c("f_hat", "f_hat_train"))
  expect_equal(dim(output$small_oracle_preds$f_hat[[1]]), c(25, length(landmark_times)))
  expect_equal(dim(output$small_oracle_preds$f_hat_train[[1]]), c(75, length(landmark_times)))
})

output <- vim(type = "R-squared",
              time = y,
              event = delta,
              X = X,
              landmark_times = landmark_times,
              large_feature_vector = 1:2,
              small_feature_vector = 1,
              conditional_surv_preds = saved_conditional_surv_preds,
              large_oracle_preds = saved_large_oracle_preds,
              small_oracle_preds = saved_small_oracle_preds,
              cf_folds = saved_folds$cf_folds,
              ss_folds = saved_folds$ss_folds,
              approx_times = saved_approx_times,
              sample_split = TRUE,
              scale_est = TRUE)
test_that("vim(). R-squared, xfit, sample split", {
  expect_equal(dim(output$result)[1], 3)
  expect_equal(dim(output$result)[2], 12)
  expect_equal(names(output$result), c("landmark_time", "est", "var_est", "cil", "ciu",
                                       "cil_1sided", "p", "large_predictiveness", "small_predictiveness",
                                       "vim", "large_feature_vector", "small_feature_vector"))
  expect_equal(sum(is.na(output$result)), 0)
  expect_equal(names(output$folds), c("cf_folds", "ss_folds"))
  expect_equal(length(output$folds$cf_folds), 100)
  expect_equal(length(output$folds$ss_folds), 100)
  expect_equal(sort(unique(output$folds$cf_folds)), c(1,2,3,4))
  expect_equal(sort(unique(output$folds$ss_folds)), c(0,1))
  expect_equal(output$approx_times, sort(unique(c(quantile(y[delta == 1 & y <= max(landmark_times)],
                                                           probs = seq(0, 1, by = 0.01)),
                                                  landmark_times))))
  expect_equal(names(output$conditional_surv_preds), c("S_hat", "S_hat_train", "G_hat", "G_hat_train"))
  expect_equal(dim(output$conditional_surv_preds$S_hat[[1]]), c(25, length(output$approx_times)))
  expect_equal(dim(output$conditional_surv_preds$S_hat_train[[1]]), c(75, length(output$approx_times)))
  expect_equal(dim(output$conditional_surv_preds$G_hat[[1]]), c(25, length(output$approx_times)))
  expect_equal(dim(output$conditional_surv_preds$G_hat_train[[1]]), c(75, length(output$approx_times)))
  expect_equal(names(output$large_oracle_preds), c("f_hat", "f_hat_train"))
  expect_equal(dim(output$large_oracle_preds$f_hat[[1]]), c(25, length(landmark_times)))
  expect_equal(dim(output$large_oracle_preds$f_hat_train[[1]]), c(75, length(landmark_times)))
  expect_equal(names(output$small_oracle_preds), c("f_hat", "f_hat_train"))
  expect_equal(dim(output$small_oracle_preds$f_hat[[1]]), c(25, length(landmark_times)))
  expect_equal(dim(output$small_oracle_preds$f_hat_train[[1]]), c(75, length(landmark_times)))
})

output <- vim(type = "survival_time_MSE",
              time = y,
              event = delta,
              X = X,
              restriction_time = landmark_times[3],
              large_feature_vector = 1:2,
              small_feature_vector = 1,
              conditional_surv_generator_control = list(SL.library = c("SL.mean", "SL.glm"),
                                                        bin_size = 0.1,
                                                        V = 2),
              large_oracle_generator_control = list(SL.library = c("SL.mean", "SL.glm"),
                                                    V = 2),
              small_oracle_generator_control = list(SL.library = c("SL.mean", "SL.glm"),
                                                    V = 2),
              cf_fold_num = 2,
              sample_split = TRUE,
              scale_est = TRUE)
test_that("vim(). survival time MSE, xfit, sample split", {
  expect_equal(dim(output$result)[1], 1)
  expect_equal(dim(output$result)[2], 12)
  expect_equal(names(output$result), c("restriction_time", "est", "var_est", "cil", "ciu",
                                       "cil_1sided", "p", "large_predictiveness", "small_predictiveness",
                                       "vim", "large_feature_vector", "small_feature_vector"))
  expect_equal(sum(is.na(output$result)), 0)
  expect_equal(names(output$folds), c("cf_folds", "ss_folds"))
  expect_equal(length(output$folds$cf_folds), 100)
  expect_equal(length(output$folds$ss_folds), 100)
  expect_equal(sort(unique(output$folds$cf_folds)), c(1,2,3,4))
  expect_equal(sort(unique(output$folds$ss_folds)), c(0,1))
  expect_equal(output$approx_times, sort(unique(c(quantile(y[delta == 1 & y <= landmark_times[3]],
                                                           probs = seq(0, 1, by = 0.01)),
                                                  landmark_times[3]))))
  expect_equal(names(output$conditional_surv_preds), c("S_hat", "S_hat_train", "G_hat", "G_hat_train"))
  expect_equal(dim(output$conditional_surv_preds$S_hat[[1]]), c(25, length(output$approx_times)))
  expect_equal(dim(output$conditional_surv_preds$S_hat_train[[1]]), c(75, length(output$approx_times)))
  expect_equal(dim(output$conditional_surv_preds$G_hat[[1]]), c(25, length(output$approx_times)))
  expect_equal(dim(output$conditional_surv_preds$G_hat_train[[1]]), c(75, length(output$approx_times)))
  expect_equal(names(output$large_oracle_preds), c("f_hat", "f_hat_train"))
  expect_equal(length(output$large_oracle_preds$f_hat[[1]]), 25)
  expect_equal(length(output$large_oracle_preds$f_hat_train[[1]]), 75)
  expect_equal(names(output$small_oracle_preds), c("f_hat", "f_hat_train"))
  expect_equal(length(output$small_oracle_preds$f_hat[[1]]), 25)
  expect_equal(length(output$small_oracle_preds$f_hat_train[[1]]), 75)
})

output <- vim(type = "C-index",
              time = y,
              event = delta,
              X = X,
              restriction_time = landmark_times[3],
              large_feature_vector = 1:2,
              small_feature_vector = 1,
              conditional_surv_generator_control = list(SL.library = c("SL.mean", "SL.glm"),
                                                        bin_size = 0.1,
                                                        V = 2),
              large_oracle_generator_control = list(V = 2,
                                                    params = list(mstop = c(20),
                                                                  nu = c(0.1),
                                                                  sigma = c(0.01),
                                                                  learner = c("glm"))),
              small_oracle_generator_control = list(V = 2,
                                                    params = list(mstop = c(20),
                                                                  nu = c(0.1),
                                                                  sigma = c(0.01),
                                                                  learner = c("glm"))),
              cf_fold_num = 2,
              sample_split = TRUE,
              scale_est = TRUE)
test_that("vim(). C-index, xfit, sample split", {
  expect_equal(dim(output$result)[1], 1)
  expect_equal(dim(output$result)[2], 12)
  expect_equal(names(output$result), c("restriction_time", "est", "var_est", "cil", "ciu",
                                       "cil_1sided", "p", "large_predictiveness", "small_predictiveness",
                                       "vim", "large_feature_vector", "small_feature_vector"))
  expect_equal(sum(is.na(output$result)), 0)
  expect_equal(names(output$folds), c("cf_folds", "ss_folds"))
  expect_equal(length(output$folds$cf_folds), 100)
  expect_equal(length(output$folds$ss_folds), 100)
  expect_equal(sort(unique(output$folds$cf_folds)), c(1,2,3,4))
  expect_equal(sort(unique(output$folds$ss_folds)), c(0,1))
  expect_equal(output$approx_times, sort(unique(c(quantile(y[delta == 1 & y <= landmark_times[3]],
                                                           probs = seq(0, 1, by = 0.01)),
                                                  landmark_times[3]))))
  expect_equal(names(output$conditional_surv_preds), c("S_hat", "S_hat_train", "G_hat", "G_hat_train"))
  expect_equal(dim(output$conditional_surv_preds$S_hat[[1]]), c(25, length(output$approx_times)))
  expect_equal(dim(output$conditional_surv_preds$S_hat_train[[1]]), c(75, length(output$approx_times)))
  expect_equal(dim(output$conditional_surv_preds$G_hat[[1]]), c(25, length(output$approx_times)))
  expect_equal(dim(output$conditional_surv_preds$G_hat_train[[1]]), c(75, length(output$approx_times)))
  expect_equal(names(output$large_oracle_preds), c("f_hat", "f_hat_train"))
  expect_equal(length(output$large_oracle_preds$f_hat[[1]]), 25)
  expect_equal(length(output$large_oracle_preds$f_hat_train[[1]]), 75)
  expect_equal(names(output$small_oracle_preds), c("f_hat", "f_hat_train"))
  expect_equal(length(output$small_oracle_preds$f_hat[[1]]), 25)
  expect_equal(length(output$small_oracle_preds$f_hat_train[[1]]), 75)
})

output <- vim(type = "C-index",
              time = y,
              event = delta,
              X = X,
              restriction_time = landmark_times[3],
              large_feature_vector = 1:2,
              small_feature_vector = 1,
              conditional_surv_generator_control = list(SL.library = c("SL.mean", "SL.glm"),
                                                        bin_size = 0.1,
                                                        V = 2),
              large_oracle_generator_control = list(V = 2,
                                                    tuning = "CV",
                                                    params = list(mstop = c(20),
                                                                  nu = c(0.1),
                                                                  sigma = c(0.01),
                                                                  learner = c("glm"))),
              small_oracle_generator_control = list(V = 2,
                                                    tuning = "CV",
                                                    params = list(mstop = c(20),
                                                                  nu = c(0.1),
                                                                  sigma = c(0.01),
                                                                  learner = c("glm"))),
              cf_fold_num = 2,
              sample_split = TRUE,
              scale_est = TRUE)
test_that("vim(). C-index with CV, xfit, sample split", {
  expect_equal(dim(output$result)[1], 1)
  expect_equal(dim(output$result)[2], 12)
  expect_equal(names(output$result), c("restriction_time", "est", "var_est", "cil", "ciu",
                                       "cil_1sided", "p", "large_predictiveness", "small_predictiveness",
                                       "vim", "large_feature_vector", "small_feature_vector"))
  expect_equal(sum(is.na(output$result)), 0)
  expect_equal(names(output$folds), c("cf_folds", "ss_folds"))
  expect_equal(length(output$folds$cf_folds), 100)
  expect_equal(length(output$folds$ss_folds), 100)
  expect_equal(sort(unique(output$folds$cf_folds)), c(1,2,3,4))
  expect_equal(sort(unique(output$folds$ss_folds)), c(0,1))
  expect_equal(output$approx_times, sort(unique(c(quantile(y[delta == 1 & y <= landmark_times[3]],
                                                           probs = seq(0, 1, by = 0.01)),
                                                  landmark_times[3]))))
  expect_equal(names(output$conditional_surv_preds), c("S_hat", "S_hat_train", "G_hat", "G_hat_train"))
  expect_equal(dim(output$conditional_surv_preds$S_hat[[1]]), c(25, length(output$approx_times)))
  expect_equal(dim(output$conditional_surv_preds$S_hat_train[[1]]), c(75, length(output$approx_times)))
  expect_equal(dim(output$conditional_surv_preds$G_hat[[1]]), c(25, length(output$approx_times)))
  expect_equal(dim(output$conditional_surv_preds$G_hat_train[[1]]), c(75, length(output$approx_times)))
  expect_equal(names(output$large_oracle_preds), c("f_hat", "f_hat_train"))
  expect_equal(length(output$large_oracle_preds$f_hat[[1]]), 25)
  expect_equal(length(output$large_oracle_preds$f_hat_train[[1]]), 75)
  expect_equal(names(output$small_oracle_preds), c("f_hat", "f_hat_train"))
  expect_equal(length(output$small_oracle_preds$f_hat[[1]]), 25)
  expect_equal(length(output$small_oracle_preds$f_hat_train[[1]]), 75)
})