tests/testthat/test-time2.R

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

data(cancer, package = "survival")

cancer <- cancer |>
  tibble::as_tibble() |>
  dplyr::mutate(
    # The exposure (here, 'sex') must be categorical (a factor)
    sex = factor(
      sex,
      levels = 1:2,
      labels = c(
        "Male",
        "Female"
      )
    ),
    time2 = time / 365.25, # transform to years
    time = 0.1,
    status = status - 1
  ) |>
  dplyr::filter(time2 > time)

testthat::test_that(
  desc = "time2 works",
  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",
        time2 = "time2",
        event = "status",
        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*",                  "217",                  "128",                   "89",
      "  Events, *n*",                        "154",                  "102",                   "52",
      "  Events/observations",                "154/217",              "102/128",               "52/89",
      "  Events/person-years",                "154/168",              "102/94",                "52/75",
      "*Follow-up*",                          "",                     "",                      "",
      "  Person-years",                       "168",                  "94",                    "75",
      "  Maximum follow-up, years",           "2.70",                 "2.70",                  "2.54",
      "  Median follow-up, years",            "1.61",                 "2.30",                  "1.45",
      "  Median follow-up (IQR), years",      "1.61 (0.82, 2.64)",    "2.30 (1.11, 2.77)",     "1.45 (0.76, 2.25)",
      "*Rates*",                              "",                     "",                      "",
      "  Rate per 1000 person-years",         "914.8",                "1088.1",                "697.0",
      "  Rate per 1000 person-years (95% CI)","914.8 (781.1, 1071.3)","1088.1 (896.2, 1321.2)","697.0 (531.1, 914.6)",
      "  Events/py (rate per 1000 py)",       "154/168 (914.8)",      "102/94 (1088.1)",       "52/75 (697.0)",
      "*Risks*",                              "",                     "",                      "",
      "  1-year survival",                    "0.43",                 "0.36",                  "0.53",
      "  1-year survival (95% CI)",           "0.43 (0.36, 0.51)",    "0.36 (0.28, 0.46)",     "0.53 (0.43, 0.66)",
      "  1-year risk/cumulative incidence",   "0.57",                 "0.64",                  "0.47",
      "  1-year risk (95% CI)",               "0.57 (0.49, 0.64)",    "0.64 (0.54, 0.72)",     "0.47 (0.34, 0.57)",
      "  Median survival, years",             "0.93",                 "0.78",                  "1.17",
      "  Median survival (95 CI), years",     "0.93 (0.80, 1.02)",    "0.78 (0.63, 0.97)",     "1.17 (0.95, 1.51)",
      "",                                     "",                     "",                      "",
      "**Comparative estimates**",            "",                     "",                      "",
      "  1-year survival difference",         "",                     "0 (reference)",         "0.17 (0.02, 0.32)",
      "  1-year risk difference",             "",                     "0 (reference)",         "-0.17 (-0.32, -0.02)",
      "  1-year survival ratio",              "",                     "1 (reference)",         "1.47 (1.05, 2.05)",
      "  1-year risk ratio",                  "",                     "1 (reference)",         "0.73 (0.56, 1.04)",
      "  Hazard ratio (95% CI)",              "",                     "1 (reference)",         "0.63 (0.45, 0.87)"
    )

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

testthat::test_that(
  desc = "catch time2 containing NA",
  code = {
    expect_warning(
      object = rifttable(
        design = tibble::tibble(
          type = "rate",
          time = "time",
          time2 = "time2",
          event = "status"
        ),
        data = cancer |>
          dplyr::mutate(
            time2 = dplyr::if_else(
              dplyr::row_number() < 5,
              true = NA_real_,
              false = time2
            )
          )
      ),
      regexp = "'time2' contains missing values"
    )
  }
)

testthat::test_that(
  desc = "catch time2 of wrong type",
  code = {
    expect_error(
      object = rifttable(
        design = tibble::tibble(
          type = "rate",
          time = "time",
          time2 = "sex",
          event = "status"
        ),
        data = cancer
      ),
      regexp = "time2 variable 'sex' must be continuous"
    )
  }
)

testthat::test_that(
  desc = "catch wrong time2 variable",
  code = {
    expect_error(
      object = rifttable(
        design = tibble::tibble(
          type = "rate",
          time = "time",
          time2 = "aaa",
          event = "status"
        ),
        data = cancer
      ),
      regexp = "time2 variable 'aaa' is not valid"
    )
  }
)


testthat::test_that(
  desc = "squareadd risk difference works",
  code = {
    result <- survdiff_ci(
      formula = survival::Surv(
        time = time,
        event = status
      ) ~
        sex,
      data = cancer,
      time = 365.25,
      approach = "squareadd"
    )

    expect_equal(
      object = result$term,
      expected = "Female"
    )
    expect_equal(
      object = result$estimate,
      expected = 0.21260534
    )
    expect_equal(
      object = result$conf.low,
      expected = 0.0887429
    )
    expect_equal(
      object = result$conf.high,
      expected = 0.33646778
    )
  }
)


testthat::test_that(
  desc = "Invalid ID variable is found",
  code = {
    expect_error(
      object = rifttable(
        design = tibble::tibble(
          type = "surv",
          time = "time",
          event = "status",
          exposure = "sex",
        ),
        data = cancer,
        id = "nonsense"
      ),
      regexp = "is not an ID variable that is valid"
    )
  }
)

testthat::test_that(
  desc = "ID variable gets used",
  code = {
    expect_equal(
      object = rifttable(
        design = tibble::tibble(
          type = "surv (ci)",
          time = "time",
          time2 = "time2",
          event = "status",
          arguments = list(list(timepoint = 1))
        ),
        data = cancer |>
          dplyr::mutate(
            idvar = rep(
              1:50,
              length.out = nrow(cancer)
            )
          ),
        id = "idvar"
      ),
      expected = tibble::tibble(
        Summary = "surv (ci)",
        Overall = "0.43 (0.37, 0.50)"
      )
    )
  }
)

testthat::test_that(
  desc = "old options are not used",
  code = {
    expect_error(
      object = rifttable(
        design = tibble::tibble(
          type = "hr",
          time = "time",
          event = "status",
          exposure = "sex",
          arguments = list(list(weights = "aaa"))
        ),
        data = cancer
      ),
      regexp = "Breaking change in rifttable"
    )
  }
)

testthat::test_that(
  desc = "Cox model does not return results without exposure",
  code = {
    expect_equal(
      object = rifttable(
        design = tibble::tibble(
          type = "hr",
          time = "time",
          event = "status",
        ),
        data = cancer
      ),
      expected = tibble::tibble(
        Summary = "hr",
        Overall = ""
      )
    )
  }
)


testthat::test_that(
  desc = "Cox model does not return results with one exposure group",
  code = {
    expect_equal(
      object = rifttable(
        design = tibble::tibble(
          type = "hr",
          time = "time",
          event = "status",
          exposure = "sex"
        ),
        data = cancer |>
          dplyr::filter(sex == "Male")
      ),
      expected = tibble::tibble(
        sex = "hr",
        Male = ""
      )
    )
  }
)