tests/testthat/test-sensitivity_analysis_SurvSurv.R

In Surrogate: Evaluation of Surrogate Endpoints in Clinical Trials

test_that("sensitivity_analysis_SurvSurv_copula() works on a single core with Clayton copula", {
  data("Ovarian")
  # For simplicity, data is not recoded to semi-competing risks format, but the
  # data are left in the composite event format.
  data = data.frame(
    Ovarian$Pfs,
    Ovarian$Surv,
    Ovarian$Treat,
    Ovarian$PfsInd,
    Ovarian$SurvInd
  )
  ovarian_fitted =
      fit_model_SurvSurv(data = data,
                         copula_family = "clayton",
                         n_knots = 1)
  # Illustration with small number of replications and low precision
  set.seed(1)
  sens_results = sensitivity_analysis_SurvSurv_copula(
    ovarian_fitted,
    composite = TRUE,
    cond_ind = TRUE,
    n_sim = 5,
    n_prec = 500,
    minfo_prec = 2e3
  )
  output_vector = c(sens_results$ICA[1],
                    sens_results$c23[3])
  check_vector = c(0.98262113, 1.37491794289595)
  expect_equal(output_vector, check_vector)
})

test_that("sensitivity_analysis_SurvSurv_copula() works on 2 cores with Clayton copula", {
  data("Ovarian")
  # For simplicity, data is not recoded to semi-competing risks format, but the
  # data are left in the composite event format.
  data = data.frame(
    Ovarian$Pfs,
    Ovarian$Surv,
    Ovarian$Treat,
    Ovarian$PfsInd,
    Ovarian$SurvInd
  )
  ovarian_fitted =
    fit_model_SurvSurv(data = data,
                       copula_family = "clayton",
                       n_knots = 1)
  # Illustration with small number of replications and low precision
  set.seed(1)
  sens_results = sensitivity_analysis_SurvSurv_copula(
    ovarian_fitted,
    composite = TRUE,
    cond_ind = TRUE,
    n_sim = 5,
    n_prec = 500,
    minfo_prec = 2e3,
    ncores = 2
  )
  output_vector = c(sens_results$ICA[1],
                    sens_results$c23[3])
  check_vector = c(0.98262113, 1.37491794289595)
  expect_equal(output_vector, check_vector)
})

test_that("sensitivity_analysis_SurvSurv_copula() works on a single core with Gaussian copula", {
  data("Ovarian")
  # For simplicity, data is not recoded to semi-competing risks format, but the
  # data are left in the composite event format.
  data = data.frame(
    Ovarian$Pfs,
    Ovarian$Surv,
    Ovarian$Treat,
    Ovarian$PfsInd,
    Ovarian$SurvInd
  )
  ovarian_fitted =
    fit_model_SurvSurv(data = data,
                       copula_family = "gaussian",
                       n_knots = 1)
  # Illustration with small number of replications and low precision
  set.seed(1)
  sens_results = sensitivity_analysis_SurvSurv_copula(
    ovarian_fitted,
    composite = TRUE,
    cond_ind = TRUE,
    n_sim = 5,
    n_prec = 500,
    minfo_prec = 2e3
  )
  output_vector = c(sens_results$ICA[1],
                    sens_results$c23[3])
  check_vector = c(0.94952722, 0.15243575)
  expect_equal(output_vector, check_vector)
})

test_that("sensitivity_analysis_SurvSurv_copula() works on a single core with Frank copula", {
  data("Ovarian")
  # For simplicity, data is not recoded to semi-competing risks format, but the
  # data are left in the composite event format.
  set.seed(1)
  data = data.frame(
    Ovarian$Pfs,
    Ovarian$Surv + rchisq(n = nrow(Ovarian), df = 1),
    Ovarian$Treat,
    Ovarian$PfsInd,
    Ovarian$SurvInd
  )
  ovarian_fitted =
    fit_model_SurvSurv(data = data,
                       copula_family = "frank",
                       n_knots = 1)
  # Illustration with small number of replications and low precision
  set.seed(1)
  sens_results = sensitivity_analysis_SurvSurv_copula(
    ovarian_fitted,
    composite = TRUE,
    cond_ind = TRUE,
    n_sim = 1,
    n_prec = 2e3,
    minfo_prec = 2e3
  )
  output_vector = c(sens_results$ICA[1],
                    sens_results$c23[1])
  check_vector = c(0.7498051, -3.1713961)
  expect_equal(output_vector, check_vector, tolerance = 1e-5)
})