tests/testthat/test-competing.R

In rifttable: Results Tables to Bridge the Rift Between Epidemiologists and Their Data

data(cancer, package = "survival")

cancer <- cancer |>
  tibble::as_tibble() |>
  dplyr::filter(ph.ecog < 3) |>
  dplyr::mutate(
    # The exposure (here, 'sex') must be categorical (a factor)
    sex = factor(
      sex,
      levels = 1:2,
      labels = c(
        "Male",
        "Female"
      )
    ),
    time = time / 365.25, # transform to years
    status = factor(
      ph.ecog,
      levels = 0:2,
      labels = c("Censor", "Event of interest", "Other event")
    )
  )

test_that(
  desc = "Competing event models work",
  code = {
    object <- tibble::tribble(
      ~label,                                  ~type,
      "**Absolute estimates**",                "",
      "*Counts and sums*",                     "",
      "  Observations, *N*",                   "total",
      "  Events, *n*",                         "events",
      "  Events/observations",                 "events/total",
      "  Events/person-years",                 "events/time",
      "*Follow-up*",                           "",
      "  Person-years",                        "time",
      "  Maximum follow-up, years",            "maxfu",
      "  Median follow-up, years",             "medfu",
      "  Median follow-up (IQR), years",       "medfu (iqr)",
      "*Rates*",                               "",
      "  Rate per 1000 person-years",          "rate",
      "  Rate per 1000 person-years (95% CI)", "rate (ci)",
      "  Events/py (rate per 1000 py)",        "events/time (rate)",
      "*Risks*",                               "",
     # "  1-year survival",                     "surv",
    #  "  1-year survival (95% CI)",            "surv (ci)",
      "  1-year risk/cumulative incidence",    "cuminc",
      "  1-year risk (95% CI)",                "cuminc (ci)",
    #  "  Median survival, years",              "medsurv",
    #  "  Median survival (95 CI), years",      "medsurv (ci)",
      "",                                      "",
      "**Comparative estimates**",             "",
    #  "  1-year survival difference",          "survdiff",
      "  1-year risk difference",              "cumincdiff",
     # "  1-year survival ratio",               "survratio",
      "  1-year risk ratio",                   "cumincratio",
      "  Hazard ratio (95% CI)",               "hr"
    ) |>
      dplyr::mutate(
        time = "time",
        event = "status@Event of interest",
        exposure = "sex",
        arguments = list(list(timepoint = 1))
      ) |>
      rifttable(
        data = cancer,
        overall = TRUE
      )

    expected <- tibble::tribble(
      ~Summary,                               ~Overall,              ~Male,                 ~Female,
      "**Absolute estimates**",               "",                    "",                    "",
      "*Counts and sums*",                    "",                    "",                    "",
      "  Observations, *N*",                  "226",                 "136",                 "90",
      "  Events, *n*",                        "113",                 "71",                  "42",
      "  Events/observations",                "113/226",             "71/136",              "42/90",
      "  Events/person-years",                "113/190",             "71/106",              "42/84",
      "*Follow-up*",                          "",                    "",                    "",
      "  Person-years",                       "190",                 "106",                 "84",
      "  Maximum follow-up, years",           "2.80",                "2.80",                "2.64",
      "  Median follow-up, years",            "1.06",                "1.08",                "1.05",
      "  Median follow-up (IQR), years",      "1.06 (0.65, 1.94)",   "1.08 (0.62, 1.94)",   "1.05 (0.65, 1.93)",
      "*Rates*",                              "",                    "",                    "",
      "  Rate per 1000 person-years",         "594.7",               "666.7",               "502.9",
      "  Rate per 1000 person-years (95% CI)","594.7 (494.5, 715.1)","666.7 (528.3, 841.3)","502.9 (371.6, 680.4)",
      "  Events/py (rate per 1000 py)",       "113/190 (594.7)",     "71/106 (666.7)",      "42/84 (502.9)",
      "*Risks*",                              "",                    "",                    "",
      "  1-year risk/cumulative incidence",   "0.39",                "0.45",                "0.31",
      "  1-year risk (95% CI)",               "0.39 (0.33, 0.47)",   "0.45 (0.36, 0.54)",   "0.31 (0.22, 0.43)",
      "",                                     "",                    "",                    "",
      "**Comparative estimates**",            "",                    "",                    "",
      "  1-year risk difference",             "",                    "0 (reference)",       "-0.14 (-0.27, 0.01)",
      "  1-year risk ratio",                  "",                    "1 (reference)",       "0.69 (0.47, 1.03)",
      "  Hazard ratio (95% CI)",              "",                    "1 (reference)",       "0.73 (0.50, 1.07)"
    )

    expect_equal(
      object = object,
      expected = expected
    )
  }
)


test_that(
  desc = "Survival is not calculated for competing events",
  code = {
    expect_error(
      object = tibble::tibble(
        type = "surv (ci)",
        time = "time",
        event = "status@Event of interest",
        exposure = "sex"
      ) |>
        rifttable(
          data = cancer,
          overall = TRUE
        ),
      regexp = "Survival \\(type = 'surv'\\) is not estimated with competing risks"
    )

    expect_warning(
      object = tibble::tibble(
        type = "medsurv",
        time = "time",
        event = "status@Event of interest",
        exposure = "sex"
      ) |>
        rifttable(data = cancer),
      regexp = "Note the presence of competing events"
    )

    expect_error(
      object = tibble::tribble(
        ~label,                                  ~type,
        "1-year survival difference",          "survdiff",
        "1-year survival ratio",               "survratio"
      ) |>
        dplyr::mutate(
          time = "time",
          event = "status@Event of interest",
          exposure = "sex",
          arguments = list(list(timepoint = 1))
        ) |>
        rifttable(
          data = cancer,
          overall = TRUE
        ),
      regexp = "may not be meaningful with competing events"
    )
  }
)

test_that(
  desc = "Missing time horizon is caught",
  code = {
    expect_error(
      object = tibble::tibble(
        type = "survdiff",
        time = "time",
        event = "status@Event of interest",
        exposure = "sex"
      ) |>
        rifttable(
          data = cancer,
          overall = TRUE
        ),
      regexp = "Must provide a time horizon for survival analysis of type"
    )
  }
)

test_that(
  desc = "Wrong event types are caught",
  code = {
    expect_error(
      object = tibble::tibble(
        type = "survdiff",
        time = "time",
        event = "status@Nonsense",
        exposure = "sex"
      ) |>
        rifttable(
          data = cancer,
          overall = TRUE
        ),
      regexp = "event variable 'status', the specified event type 'Nonsense' is not available"
    )
  }
)

test_that(
  desc = "Non-competing events setting is identified",
  code = {
    expect_error(
      object = tibble::tibble(
        type = "survdiff",
        time = "time",
        event = "sex@Male",
        exposure = "status"
      ) |>
        rifttable(
          data = cancer,
          overall = TRUE
        ),
      regexp = "event variable does not appear to have more than two levels"
    )
  }
)

test_that(
  desc = "Missing event type is found",
  code = {
    expect_error(
      object = tibble::tibble(
        type = "survdiff",
        time = "time",
        event = "status",
        exposure = "sex"
      ) |>
        rifttable(
          data = cancer |>
            dplyr::filter(!is.na(ph.ecog)),
          overall = TRUE
        ),
      regexp = "competing events may be encoded, but no specific event type"
    )
  }
)

test_that(
  desc = "Wrong event variable class is found",
  code = {
    expect_error(
      object = tibble::tibble(
        type = "survdiff",
        time = "time",
        event = "pat.karno@50",
        exposure = "sex"
      ) |>
        rifttable(
          data = cancer |>
            dplyr::filter(!is.na(pat.karno)),
          overall = TRUE
        ),
      regexp = "to presumably encode competing events must be a factor"
    )
  }
)