tests/testthat/test-input-checks.R

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

test_that(
  desc = "Basic inputs are present",
  code = {
    expect_error(
      object = rifttable(
        design = 1,
        data = tibble::tibble()
      ),
      regexp = "No 'design' data frame"
    )

    expect_error(
      object = rifttable(
        design = tibble::tibble(),
        data = 1
      ),
      regexp = "No 'data' data frame"
    )

    expect_error(
      object = rifttable(
        design = tibble::tibble(),
        data = tibble::tibble()
      ),
      regexp = "The data set is empty"
    )

    design <- tibble::tibble()
    attr(x = design, which = "rt_data") <- tibble::tibble(a = 1)
    expect_error(
      object = rifttable(
        design = design
      ),
      regexp = "The 'design' data frame must contain a 'type' column"
    )
  }
)

test_that(
  desc = "Invalid design variables get caught",
  code = {
    data(breastcancer, package = "risks")

    design <- tibble::tibble(
      stratum = c("Stage I", "Stage II")
    ) |>
      dplyr::mutate(
        type = "risk",
        exposure = "receptor",
        outcome = "death",
        effect_modifier = "stage"
      )

    expect_warning(
      object = rifttable(
        design = design,
        data = breastcancer |>
          dplyr::filter(stage != "Stage I")
      ),
      regexp = "Stratum 'Stage I' is empty"
    )

    expect_error(
      object = rifttable(
        design = design |>
          dplyr::mutate(outcome = "d"),
        data = breastcancer
      ),
      regexp = "Outcome variable 'd' is not valid"
    )

    expect_error(
      object = rifttable(
        design = design |>
          dplyr::mutate(weights = "w"),
        data = breastcancer
      ),
      regexp = "Variable is not valid"
    )

    expect_error(
      object = rifttable(
        design = design |>
          dplyr::mutate(weights = "stage"),
        data = breastcancer
      ),
      regexp = "'stage': Variable is not numeric"
    )

    expect_warning(
      object = rifttable(
        design = design |>
          dplyr::mutate(exposure = "row"),
        data = breastcancer |>
          dplyr::mutate(row = dplyr::row_number())
      ),
      regexp = "Exposure variable 'row' is not categorical"
    )

    expect_error(
      object = rifttable(
        design = design |>
          dplyr::mutate(type = "nonsense"),
        data = breastcancer
      ),
      regexp = "An estimator type = 'nonsense' is not implemented by default"
    )

    expect_error(
      object = rifttable(
        design = design |>
          dplyr::mutate(type = "regress_binary"),
        data = breastcancer
      ),
      regexp = "Invalid estimator type = 'regress_binary'."
    )
  }
)

testthat::test_that(
  desc = "catch time containing NA",
  code = {
    expect_warning(
      object = rifttable(
        design = tibble::tibble(
          type = "rate",
          time = "death",
          event = "death"
        ),
        data = breastcancer |>
          dplyr::mutate(
            death = dplyr::if_else(
              dplyr::row_number() < 5,
              true = NA_real_,
              false = death
            )
          )
      ),
      regexp = "'death' and/or the time variable 'death' contain missing values"
    )
  }
)


testthat::test_that(
  desc = "catch time of wrong type",
  code = {
    data(cancer, package = "survival")
    expect_error(
      object = rifttable(
        design = tibble::tibble(
          type = "rate",
          time = "stage",
          event = "death"
        ),
        data = breastcancer
      ),
      regexp = "Time variable 'stage' must be continuous"
    )
  }
)

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


test_that(
  desc = "Rounding digits are valid",
  code = {
    expect_error(
      object = rifttable(
        design = tibble::tibble(
          type = "total",
          digits = 11
        ),
        data = tibble::tibble(x = 1)
      ),
      regexp = "must be an integer number from 0 to 10"
    )
    expect_error(
      object = rifttable(
        design = tibble::tibble(
          type = "total",
          digits = "a"
        ),
        data = tibble::tibble(x = 1)
      ),
      regexp = "must be numeric. 'a' is not numeric."
    )
  }
)

testthat::test_that(
  desc = "event variable is valid",
  code = {
    data(breastcancer, package = "risks")
    expect_error(
      object = rifttable(
        design = tibble::tibble(
          type = "rate",
          time = "death",
          event = "aaa"
        ),
        data = cancer
      ),
      regexp = "Event variable 'aaa' is not valid for the dataset"
    )
  }
)

testthat::test_that(
  desc = "time and event variable are present if needed",
  code = {
    data(breastcancer, package = "risks")
    expect_error(
      object = rifttable(
        design = tibble::tibble(
          type = "rate",
          time = "death",
        ),
        data = cancer
      ),
      regexp = " The 'design' must contain 'event' and 'time' variables"
    )
    expect_error(
      object = rifttable(
        design = tibble::tibble(
          type = "rate",
          event = "death",
        ),
        data = cancer
      ),
      regexp = " The 'design' must contain 'event' and 'time' variables"
    )
  }
)

testthat::test_that(
  desc = "extra arguments get checked",
  code = {
    data(breastcancer, package = "risks")
    expect_error(
      object = rifttable(
        design = tibble::tibble(
          type = "cuminc",
          time = "death",
          event = "death",
          arguments = list(list(timepoint = "a"))
        ),
        data = breastcancer
      ),
      regexp = "A timepoint argument was supplied, but timepoint = 'a' is not numeric."
    )
    expect_error(
      object = rifttable(
        design = tibble::tibble(
          type = "rr",
          exposure = "receptor",
          outcome = "death",
          arguments = list(list(approach = "a"))
        ),
        data = breastcancer
      ),
      regexp = "approach = 'a' is not among the accepted choices, which include: auto"
    )
  }
)

testthat::test_that(
  desc = "ratio digits decrease errors are found",
  code = {
    data(breastcancer, package = "risks")
    expect_error(
      object = rifttable(
        design = tibble::tibble(
          type = "rr",
          exposure = "receptor",
          outcome = "death",
          ratio_digits_decrease = c(a = 1)
        ),
        data = breastcancer
      ),
      regexp = "Names of 'ratio_digits_decrease' for rounding, if provided, must be convertible into numbers"
    )
    expect_error(
      object = rifttable(
        design = tibble::tibble(
          type = "rr",
          exposure = "receptor",
          outcome = "death",
          ratio_digits_decrease = c(`-1` = "a")
        ),
        data = breastcancer
      ),
      regexp = "Values of 'ratio_digits_decrease' for rounding, if provided, must be numeric"
    )
  }
)

testthat::test_that(
  desc = "scoreci midpoint",
  code = {
    expect_contains(
      object = names(
        scoreci(
          success = 5,
          total = 10,
          return_midpoint = TRUE
        )
      ),
      expected = "midpoint"
    )
  }
)