tests/testthat/test-survival.R

In RobinCar2: ROBust INference for Covariate Adjustment in Randomized Clinical Trials

test_that("h_log_hr_est_via_score works as expected", {
  result <- h_log_hr_est_via_score(
    h_lr_score_no_strata_no_cov,
    df = surv_data,
    treatment = "sex",
    time = "time",
    status = "status"
  )
  expect_snapshot_value(result, tolerance = 1e-4, style = "deparse")
})

test_that("h_log_hr_est_via_score extends the search interval as needed", {
  result <- h_log_hr_est_via_score(
    h_lr_score_no_strata_no_cov,
    interval = c(-0.2, 0.2),
    df = surv_data,
    treatment = "sex",
    time = "time",
    status = "status"
  )
  expect_true(result$theta > 0.2)
  expect_snapshot_value(result, tolerance = 1e-4, style = "deparse")
})

test_that("h_lr_test_via_score works as expected", {
  result <- h_lr_test_via_score(
    h_lr_score_no_strata_no_cov,
    df = surv_data,
    treatment = "sex",
    time = "time",
    status = "status"
  )
  expect_snapshot_value(result, tolerance = 1e-4, style = "deparse")
})

test_that("robin_surv_comparison works as expected without covariate adjustment", {
  input <- h_prep_survival_input(
    formula = survival::Surv(time, status) ~ 1,
    data = surv_data,
    treatment = sex ~ 1
  )
  result <- robin_surv_comparison(
    score_fun = h_lr_score_no_strata_no_cov,
    vars = input,
    data = input$data,
    exp_level = 2,
    control_level = 1,
    treatment = input$treatment,
    time = input$time,
    status = input$status
  )
  expect_snapshot_value(result, tolerance = 1e-4, style = "deparse")
})

test_that("robin_surv_no_strata_no_cov works as expected", {
  input <- h_prep_survival_input(
    formula = survival::Surv(time, status) ~ 1,
    data = surv_data,
    treatment = sex ~ 1
  )
  result <- robin_surv_no_strata_no_cov(
    vars = input,
    data = input$data,
    exp_level = 1,
    control_level = 2
  )
  expect_snapshot_value(result, tolerance = 1e-4, style = "deparse")
})

test_that("robin_surv_no_strata_no_cov gives the same results as RobinCar functions", {
  input <- h_prep_survival_input(
    formula = survival::Surv(time, status) ~ 1,
    data = surv_data,
    treatment = ecog ~ 1
  )
  input$data <- na.omit(input$data)
  result <- robin_surv_no_strata_no_cov(
    vars = input,
    data = input$data,
    exp_level = 2,
    control_level = 1
  )
  # These values are extracted from RobinCar (version 1.0.0) results, see
  # `tests-raw/test-survival.R`.
  robincar_result <- list(
    test_stat = -0.6188324,
    test_sigma_l2 = 0.1782103,
    estimate = -0.1131005,
    se = 0.1830198
  )
  expect_equal(result$test_stat, robincar_result$test_stat, tolerance = 1e-5)
  expect_equal(result$test_sigma_l2, robincar_result$test_sigma_l2, tolerance = 1e-4)
  expect_equal(result$estimate, robincar_result$estimate, tolerance = 1e-4)
  expect_equal(result$se, robincar_result$se, tolerance = 1e-4)
})

test_that("robin_surv_strata works as expected", {
  input <- h_prep_survival_input(
    formula = survival::Surv(time, status) ~ 1,
    data = surv_data,
    treatment = sex ~ strata
  )
  result <- robin_surv_strata(
    vars = input,
    data = input$data,
    exp_level = 1,
    control_level = 2
  )
  expect_snapshot_value(result, tolerance = 1e-4, style = "deparse")
})

test_that("robin_surv_strata gives the same results as RobinCar functions", {
  input <- h_prep_survival_input(
    formula = survival::Surv(time, status) ~ 1,
    data = surv_data,
    treatment = ecog ~ sex
  )
  input$data <- na.omit(input$data)
  result <- robin_surv_strata(
    vars = input,
    data = input$data,
    exp_level = 2,
    control_level = 1
  )
  # These values are extracted from RobinCar (version 1.0.0) results, see
  # `tests-raw/test-survival.R`.
  robincar_result <- list(
    test_stat = -0.6171326,
    test_sigma_l2 = 0.1749327,
    estimate = -0.1138251,
    se = 0.1847554
  )
  expect_equal(result$test_stat, robincar_result$test_stat, tolerance = 1e-5)
  expect_equal(result$test_sigma_l2, robincar_result$test_sigma_l2, tolerance = 1e-4)
  expect_equal(result$estimate, robincar_result$estimate, tolerance = 1e-3)
  expect_equal(result$se, robincar_result$se, tolerance = 1e-3)
})

test_that("robin_surv_cov works as expected", {
  input <- h_prep_survival_input(
    formula = survival::Surv(time, status) ~ age,
    data = surv_data,
    treatment = sex ~ 1
  )
  result <- robin_surv_cov(
    vars = input,
    data = input$data,
    exp_level = 1,
    control_level = 2
  )
  expect_snapshot_value(result, tolerance = 1e-4, style = "deparse")
})

test_that("robin_surv_cov gives the same results as RobinCar functions", {
  input <- h_prep_survival_input(
    formula = survival::Surv(time, status) ~ age,
    data = surv_data,
    treatment = ecog ~ 1
  )
  input$data <- na.omit(input$data)
  result <- robin_surv_cov(
    vars = input,
    data = input$data,
    exp_level = 2,
    control_level = 1,
    hr_se_plugin_adjusted = FALSE # To get the exact match with RobinCar.
  )
  # These values are extracted from RobinCar (version 1.0.0) results, see
  # `tests-raw/test-survival.R`.
  robincar_result <- list(
    test_stat = -0.4309439,
    test_sigma_l2 = 0.175718,
    estimate = -0.07914235,
    se = 0.181807
  )
  expect_equal(result$test_stat, robincar_result$test_stat, tolerance = 1e-5)
  expect_equal(result$test_sigma_l2, robincar_result$test_sigma_l2, tolerance = 1e-4)
  expect_equal(result$estimate, robincar_result$estimate, tolerance = 1e-3)
  expect_equal(result$se, robincar_result$se, tolerance = 1e-3)
})

test_that("robin_surv_strata_cov works as expected", {
  input <- h_prep_survival_input(
    formula = survival::Surv(time, status) ~ age,
    data = surv_data,
    treatment = ecog ~ sex
  )
  result <- robin_surv_strata_cov(
    vars = input,
    data = input$data,
    exp_level = 2,
    control_level = 1
  )
  expect_snapshot_value(result, tolerance = 1e-4, style = "deparse")
})

test_that("robin_surv_strata_cov gives the same results as RobinCar functions", {
  input <- h_prep_survival_input(
    formula = survival::Surv(time, status) ~ age,
    data = surv_data,
    treatment = ecog ~ sex
  )
  input$data <- na.omit(input$data)
  result <- robin_surv_strata_cov(
    vars = input,
    data = input$data,
    exp_level = 2,
    control_level = 1,
    hr_se_plugin_adjusted = FALSE # To get the exact match with RobinCar.
  )
  # These values are extracted from RobinCar (version 1.0.0) results, see
  # `tests-raw/test-survival.R`.
  robincar_result <- list(
    test_stat = -0.4612828,
    test_sigma_l2 = 0.1734316,
    estimate = -0.08566379,
    se = 0.1840128
  )
  expect_equal(result$test_stat, robincar_result$test_stat, tolerance = 1e-5)
  expect_equal(result$test_sigma_l2, robincar_result$test_sigma_l2, tolerance = 1e-4)
  expect_equal(result$estimate, robincar_result$estimate, tolerance = 1e-3)
  expect_equal(result$se, robincar_result$se, tolerance = 1e-3)
})

test_that("h_log_hr_coef_mat works as expected", {
  x <- list(
    estimate = 0.5,
    se = 1,
    pair = structure(
      list(2L, 1L),
      levels = c("A", "B")
    )
  )
  result <- h_log_hr_coef_mat(x)
  expect_snapshot_value(result, tolerance = 1e-4, style = "deparse")
})

test_that("h_log_hr_coef_mat works as expected for multiple comparisons", {
  x <- list(
    estimate = c(0.5, 0.7, 0.9),
    se = c(1, 2, 3),
    pair = structure(
      list(c(2L, 1L, 3L), c(1L, 3L, 2L)),
      levels = c("A", "B", "C")
    )
  )
  result <- h_log_hr_coef_mat(x)
  expect_snapshot_value(result, tolerance = 1e-4, style = "serialize")
})

test_that("h_test_mat works as expected", {
  x <- list(
    test_stat = c(0.5, 0.7),
    p_value = c(0.05, 0.01),
    pair = structure(
      list(c(2L, 1L), c(1L, 2L)),
      levels = c("A", "B")
    )
  )
  result <- h_test_mat(x)
  expect_snapshot_value(result, tolerance = 1e-4, style = "deparse")
})

test_that("h_events_table works as expected with strata", {
  vars <- list(
    treatment = "sex",
    time = "time",
    status = "status",
    strata = "strata"
  )
  result <- h_events_table(surv_data, vars)
  expected <- data.frame(
    strata = structure(c(1L, 1L, 2L, 2L, 3L, 3L, 4L), levels = c("0", "1", "2", "3"), class = "factor"),
    sex = structure(c(1L, 2L, 1L, 2L, 1L, 2L, 2L), levels = c("Female", "Male"), class = "factor"),
    Patients = c(27L, 36L, 42L, 71L, 21L, 29L, 1L),
    Events = c(9L, 28L, 28L, 54L, 16L, 28L, 1L)
  )
  expect_identical(result, expected)
})

test_that("h_events_table works as expected without strata", {
  vars <- list(
    treatment = "sex",
    time = "time",
    status = "status",
    strata = NULL
  )
  result <- h_events_table(surv_data, vars)
  expected <- data.frame(
    sex = structure(1:2, levels = c("Female", "Male"), class = "factor"),
    Patients = c(90L, 138L),
    Events = c(53L, 112L)
  )
  expect_identical(result, expected)
})

test_that("robin_surv works as expected without strata or covariates", {
  result <- robin_surv(
    Surv(time, status) ~ 1,
    data = surv_data,
    treatment = ecog ~ 1
  )
  expect_s3_class(result, "surv_effect")
  expect_snapshot_value(result$log_hr_coef_mat, tolerance = 1e-4, style = "deparse")
  expect_snapshot_value(result$test_mat, tolerance = 1e-4, style = "serialize")
  expect_snapshot_value(result$events_table, tolerance = 1e-4, style = "serialize")
})

test_that("robin_surv gives the same results as RobinCar functions without strata or covariates", {
  result <- robin_surv(
    Surv(time, status) ~ 1,
    data = na.omit(surv_data),
    treatment = ecog ~ 1
  )
  # These values are extracted from RobinCar (version 1.0.0) results, see
  # `tests-raw/test-survival.R`.
  robincar_result <- list(
    test_stat = -0.6188324,
    test_sigma_l2 = 0.1782103,
    test_p_val = 0.5360268,
    estimate = -0.1131005,
    se = 0.1830198
  )
  expect_equal(result$test_mat[, "Test Stat."], robincar_result$test_stat, tolerance = 1e-5)
  expect_equal(result$test_mat[, "Pr(>|z|)"], robincar_result$test_p_val, tolerance = 1e-5)
  expect_equal(result$log_hr_coef_mat[, "Estimate"], robincar_result$estimate, tolerance = 1e-4)
  expect_equal(result$log_hr_coef_mat[, "Std.Err"], robincar_result$se, tolerance = 1e-4)
})

test_that("robin_surv works as expected with strata", {
  result <- robin_surv(
    Surv(time, status) ~ 1,
    data = surv_data,
    treatment = sex ~ strata
  )
  expect_s3_class(result, "surv_effect")
  expect_snapshot_value(result$log_hr_coef_mat, tolerance = 1e-4, style = "deparse")
  expect_snapshot_value(result$test_mat, tolerance = 1e-4, style = "serialize")
  expect_snapshot_value(result$events_table, tolerance = 1e-4, style = "serialize")
})

test_that("robin_surv gives the same results as RobinCar functions with strata", {
  result <- robin_surv(
    Surv(time, status) ~ 1,
    data = na.omit(surv_data),
    treatment = ecog ~ sex
  )
  # These values are extracted from RobinCar (version 1.0.0) results, see
  # `tests-raw/test-survival.R`.
  robincar_result <- list(
    test_stat = -0.6171326,
    test_sigma_l2 = 0.1749327,
    test_p_val = 0.5371473,
    estimate = -0.1138251,
    se = 0.1847554
  )
  expect_equal(result$test_mat[, "Test Stat."], robincar_result$test_stat, tolerance = 1e-5)
  expect_equal(result$test_mat[, "Pr(>|z|)"], robincar_result$test_p_val, tolerance = 1e-5)
  expect_equal(result$log_hr_coef_mat[, "Estimate"], robincar_result$estimate, tolerance = 1e-3)
  expect_equal(result$log_hr_coef_mat[, "Std.Err"], robincar_result$se, tolerance = 1e-3)
})

test_that("robin_surv works as expected with covariates", {
  result <- robin_surv(
    Surv(time, status) ~ age,
    data = surv_data,
    treatment = ecog ~ 1
  )
  expect_s3_class(result, "surv_effect")
  expect_snapshot_value(result$log_hr_coef_mat, tolerance = 1e-4, style = "deparse")
  expect_snapshot_value(result$test_mat, tolerance = 1e-4, style = "serialize")
  expect_snapshot_value(result$events_table, tolerance = 1e-4, style = "serialize")
})

test_that("robin_surv gives the same results as RobinCar functions with covariates", {
  result <- robin_surv(
    Surv(time, status) ~ age,
    data = na.omit(surv_data),
    treatment = ecog ~ 1
  )
  # These values are extracted from RobinCar (version 1.0.0) results, see
  # `tests-raw/test-survival.R`.
  robincar_result <- list(
    test_stat = -0.4309439,
    test_sigma_l2 = 0.175718,
    test_p_val = 0.6665092,
    estimate = -0.07914235,
    se = 0.181807
  )
  expect_equal(result$test_mat[, "Test Stat."], robincar_result$test_stat, tolerance = 1e-5)
  expect_equal(result$test_mat[, "Pr(>|z|)"], robincar_result$test_p_val, tolerance = 1e-5)
  expect_equal(result$log_hr_coef_mat[, "Estimate"], robincar_result$estimate, tolerance = 1e-3)
  expect_equal(result$log_hr_coef_mat[, "Std.Err"], robincar_result$se, tolerance = 1e-3)
})

test_that("robin_surv works as expected with strata and covariates", {
  result <- robin_surv(
    Surv(time, status) ~ age + ph.karno,
    data = surv_data,
    treatment = ecog ~ sex
  )
  expect_s3_class(result, "surv_effect")
  expect_snapshot_value(result$log_hr_coef_mat, tolerance = 1e-4, style = "deparse")
  expect_snapshot_value(result$test_mat, tolerance = 1e-4, style = "serialize")
  expect_snapshot_value(result$events_table, tolerance = 1e-4, style = "serialize")
})

test_that("robin_surv gives the same results as RobinCar functions with strata and covariates", {
  result <- robin_surv(
    Surv(time, status) ~ age,
    data = na.omit(surv_data),
    treatment = ecog ~ sex
  )
  # These values are extracted from RobinCar (version 1.0.0) results, see
  # `tests-raw/test-survival.R`.
  robincar_result <- list(
    test_stat = -0.4612828,
    test_sigma_l2 = 0.1734316,
    test_p_val = 0.6445957,
    estimate = -0.08566379,
    se = 0.1840128
  )
  expect_equal(result$test_mat[, "Test Stat."], robincar_result$test_stat, tolerance = 1e-5)
  expect_equal(result$test_mat[, "Pr(>|z|)"], robincar_result$test_p_val, tolerance = 1e-5)
  expect_equal(result$log_hr_coef_mat[, "Estimate"], robincar_result$estimate, tolerance = 1e-3)
  expect_equal(result$log_hr_coef_mat[, "Std.Err"], robincar_result$se, tolerance = 1e-3)
})

test_that("robin_surv also works with multiple pairwise comparisons", {
  result <- robin_surv(
    Surv(time, status) ~ 1,
    data = surv_data,
    treatment = strata ~ 1
  )
  expect_s3_class(result, "surv_effect")
  comparisons <- c("1 v.s. 0", "2 v.s. 0", "3 v.s. 0", "2 v.s. 1", "3 v.s. 1", "3 v.s. 2")
  expect_matrix(result$log_hr_coef_mat, ncol = 4, nrow = 6)
  expect_names(rownames(result$log_hr_coef_mat), identical.to = comparisons)
  expect_matrix(result$test_mat, ncol = 2, nrow = 6)
  expect_names(rownames(result$test_mat), identical.to = comparisons)
})

test_that("robin_surv allows the user to optionally define the comparisons of interest", {
  result <- robin_surv(
    Surv(time, status) ~ 1,
    data = surv_data,
    treatment = strata ~ 1,
    comparisons = list(c(1, 2), c(3, 3))
  )
  expect_s3_class(result, "surv_effect")
  comparisons <- c("0 v.s. 2", "1 v.s. 2")
  expect_matrix(result$log_hr_coef_mat, ncol = 4, nrow = 2)
  expect_names(rownames(result$log_hr_coef_mat), identical.to = comparisons)
  expect_matrix(result$test_mat, ncol = 2, nrow = 2)
  expect_names(rownames(result$test_mat), identical.to = comparisons)
})

test_that("robin_surv allows to use unadjusted standard error", {
  result <- robin_surv(
    Surv(time, status) ~ age,
    data = surv_data,
    treatment = ecog ~ 1,
    hr_se_plugin_adjusted = FALSE
  )
  result_adjusted <- robin_surv(
    Surv(time, status) ~ age,
    data = surv_data,
    treatment = ecog ~ 1,
    hr_se_plugin_adjusted = TRUE
  )
  # Only the standard error should differ.
  expect_true(result$se != result_adjusted$se)
  expect_true(result$estimate == result_adjusted$estimate)
  expect_true(result$test_stat == result_adjusted$test_stat)
  expect_true(result$p_value == result_adjusted$p_value)
})