Testing with testthat

Lesson 10 — R Programming

Lesson 10 of 12 Intermediate ~90 min

Learning objectives

Set up testthat and understand the file layout it expects
Write tests using the full expectation vocabulary
Test errors, warnings and messages
Use fixtures and helpers to avoid repeating setup
Use snapshot tests for output whose exact form matters
Measure coverage and know what coverage does not tell you

Why test derivations

In clinical programming, the traditional answer to “is this code correct?” is independent double programming: two people write the derivation separately and compare outputs. That catches specification misreadings but has two gaps — it is expensive, and it verifies one dataset on one day.

Unit tests are complementary, not a replacement. They verify the logic against known inputs, every time anything changes, in seconds. Double programming verifies the interpretation. A mature process uses both, with tests carrying the regression burden so the double-programming effort can focus on the specification.

Setup

usethis::use_testthat()      # creates tests/testthat/ and tests/testthat.R
usethis::use_test("derive")  # creates tests/testthat/test-derive.R

Layout:

mypackage/
├── R/
│   └── derive.R
└── tests/
    ├── testthat.R              # runner, do not edit
    └── testthat/
        ├── helper-data.R       # sourced before every test file
        ├── setup.R             # run once before the suite
        └── test-derive.R

Convention: R/derive.R is tested by tests/testthat/test-derive.R. usethis::use_test() called with a source file open creates the matching test file automatically.

Writing a test

test_that("study day is calculated with no day zero", {
  trtsdt <- as.Date("2026-03-15")

  expect_equal(study_day(as.Date("2026-03-15"), trtsdt),  1)
  expect_equal(study_day(as.Date("2026-03-16"), trtsdt),  2)
  expect_equal(study_day(as.Date("2026-03-14"), trtsdt), -1)
  expect_equal(study_day(as.Date("2026-03-01"), trtsdt), -14)
})

A test_that() block has a description that reads as a sentence stating the behaviour, and one or more expectations. When it fails, the description is what you see — so write it as an assertion about behaviour, not a label:

Good: "partial dates impute to the first of the month"
Bad: "test impute function"

Expectations

# Equality
expect_equal(x, y)                  # tolerant of floating-point noise
expect_equal(x, y, tolerance = 1e-8)
expect_identical(x, y)              # exact, including type
expect_true(x); expect_false(x)
expect_null(x)
expect_na(x)                        # testthat 3e

# Type and shape
expect_type(x, "double")
expect_s3_class(x, "data.frame")
expect_s4_class(x, "Matrix")
expect_length(x, 5)
expect_named(x, c("a", "b"))
expect_named(df, c("USUBJID", "AVAL"), ignore.order = TRUE)

# Numeric comparisons
expect_gt(x, 0); expect_gte(x, 0)
expect_lt(x, 100); expect_lte(x, 100)

# Strings
expect_match(x, "^STUDY-\\d{3}")
expect_no_match(x, "TEST")

# Sets
expect_setequal(x, c("A", "B", "C"))
expect_contains(x, "A")
expect_in("A", x)

# Conditions
expect_error(f(), "must be numeric")
expect_error(f(), class = "study_missing_var_error")
expect_warning(f(), "duplicate")
expect_message(f(), "Imported")
expect_no_error(f())
expect_no_warning(f())

# Snapshots
expect_snapshot(print(x))
expect_snapshot_value(x)

expect_equal() vs expect_identical()

expect_equal(1L, 1)        # passes — 1L and 1 are numerically equal
expect_identical(1L, 1)    # fails  — integer is not double

Use expect_equal() for numeric results (floating point makes exact equality unreliable) and expect_identical() when the type itself is part of the contract — for example, that a derivation returns a character "Y"/"N" flag rather than a logical.

Testing data frames

test_that("derive_change adds CHG without changing row count", {
  input <- tibble::tribble(
    ~USUBJID, ~PARAMCD, ~AVISITN, ~AVAL, ~BASE,
    "001",    "ALT",     0,        30,    30,
    "001",    "ALT",     4,        35,    30,
    "002",    "ALT",     0,        28,    28,
    "002",    "ALT",     4,        NA,    28
  )

  out <- derive_change(input)

  expect_equal(nrow(out), nrow(input))
  expect_true("CHG" %in% names(out))
  expect_equal(out$CHG, c(0, 5, 0, NA_real_))
  expect_type(out$CHG, "double")
})

tribble() is the right constructor for test data: the layout on screen matches the table, so a reviewer can check the expected values by eye.

Test the edge cases deliberately:

test_that("derive_change handles empty input", {
  empty <- tibble::tibble(
    USUBJID = character(), PARAMCD = character(),
    AVAL = double(), BASE = double()
  )
  out <- derive_change(empty)
  expect_equal(nrow(out), 0)
  expect_true("CHG" %in% names(out))
})

test_that("derive_change errors when BASE is missing", {
  bad <- tibble::tibble(USUBJID = "001", AVAL = 30)
  expect_error(derive_change(bad), "BASE must be present")
})

The empty-input test is the one people skip and the one that fails in production, when a study has no records for a domain.

Helpers and fixtures

Files named helper-*.R in tests/testthat/ are sourced before every test file. Put shared test data and constructors there:

# tests/testthat/helper-data.R

make_adsl <- function(n = 3, ...) {
  base <- tibble::tibble(
    USUBJID = sprintf("STUDY-001-%04d", seq_len(n)),
    TRT01P  = rep(c("Placebo", "Drug A"), length.out = n),
    AGE     = seq(40, by = 5, length.out = n),
    SEX     = rep(c("M", "F"), length.out = n),
    SAFFL   = "Y"
  )
  dplyr::mutate(base, ...)
}

test_that("safety population excludes untreated subjects", {
  adsl <- make_adsl(4, SAFFL = c("Y", "Y", "N", "Y"))
  out  <- filter_safety(adsl)
  expect_equal(nrow(out), 3)
})

A constructor with ... overrides lets each test state only what it cares about, which makes the intent of the test obvious.

setup.R runs once before the whole suite and is the right place for expensive setup:

# tests/testthat/setup.R
withr::local_options(list(digits = 7), .local_envir = teardown_env())
test_db <- create_test_database()
withr::defer(cleanup_database(test_db), teardown_env())

Use withr for anything that changes global state — options, environment variables, working directory, locale — so it is restored automatically:

test_that("dates parse in a non-English locale", {
  withr::local_locale(c(LC_TIME = "de_DE.UTF-8"))
  expect_equal(parse_sas_date("15MAR2026"), as.Date("2026-03-15"))
})

Snapshot tests

For output where the exact form matters — printed tables, error messages, generated RTF — comparing to a hand-written expectation is tedious and brittle. Snapshots record the output on first run and compare thereafter.

test_that("summary table has the expected layout", {
  expect_snapshot(
    make_demographics_table(make_adsl(20))
  )
})

First run creates tests/testthat/_snaps/table.md. Subsequent runs compare. When output changes:

testthat::snapshot_review()   # interactive diff, accept or reject
testthat::snapshot_accept()   # accept all changes

The snapshot file is committed, so a code review shows exactly how the output changed. This is extremely useful for TLF programs, where “did this refactor change any number in the table?” is the question that matters.

Snapshots and error messages

test_that("validate_adsl gives a helpful error", {
  expect_snapshot(validate_adsl(tibble::tibble(x = 1)), error = TRUE)
})

This records the full formatted error message. If someone later degrades the error text, the snapshot fails — which keeps error quality from eroding.

Running tests

devtools::test()                    # whole suite
devtools::test(filter = "derive")   # files matching a pattern
testthat::test_file("tests/testthat/test-derive.R")

# In RStudio
# Ctrl/Cmd + Shift + T

Output:

==> devtools::test()

i Testing mystudy
v | F W S  OK | Context
v |         12 | derive
x | 1       8  | impute
--------------------------------------------------------------------------------
Failure (test-impute.R:23:3): partial year dates impute to 1 January
impute_start("2026") not equal to as.Date("2026-01-01").
1/1 mismatches
[1] "2026-06-15" - "2026-01-01" == 165 days
--------------------------------------------------------------------------------

[ FAIL 1 | WARN 0 | SKIP 0 | PASS 20 ]

Coverage

covr::report()                       # interactive HTML, line-by-line
covr::package_coverage()
#> mystudy Coverage: 87.42%
#> R/impute.R:  71.43%
#> R/derive.R:  94.12%

Coverage tells you which lines ran, not whether the assertions were meaningful. 100% coverage with expect_true(TRUE) everywhere is worthless. Use it to find untested code — the red lines in the report are the honest signal.

For derivation code in a regulated setting, aim high (>90%) and make the uncovered lines a deliberate, documented decision.

What to test

Test this	Do not bother
Business logic and derivations	That `dplyr::filter()` works
Edge cases: empty, all-`NA`, single row	Trivial getters
Boundary values: day 0/1, exactly 65	Print methods with no logic
Error conditions and their messages	Randomly generated data without a seed
Type and shape of returned objects	Anything requiring a network by default
Behaviour a specification states	Implementation details you plan to change

The last row of each column is the important one. A test that asserts how something is implemented breaks on every refactor and teaches you nothing; a test that asserts what it does is the reason refactoring is safe.

A worked example

# R/imputation.R
#' Impute a partial ISO 8601 date
#'
#' @param dtc Character vector of ISO 8601 dates, possibly partial.
#' @param direction Either "first" (earliest possible) or "last" (latest).
#' @return A Date vector.
#' @export
impute_dtc <- function(dtc, direction = c("first", "last")) {
  direction <- match.arg(direction)
  d <- substr(dtc, 1, 10)

  is_full  <- grepl("^\\d{4}-\\d{2}-\\d{2}$", d)
  is_month <- grepl("^\\d{4}-\\d{2}$", d)
  is_year  <- grepl("^\\d{4}$", d)

  out <- as.Date(rep(NA_character_, length(d)))
  out[is_full] <- as.Date(d[is_full])

  if (direction == "first") {
    out[is_month] <- as.Date(paste0(d[is_month], "-01"))
    out[is_year]  <- as.Date(paste0(d[is_year], "-01-01"))
  } else {
    out[is_month] <- lubridate::ceiling_date(
      as.Date(paste0(d[is_month], "-01")), "month") - 1
    out[is_year]  <- as.Date(paste0(d[is_year], "-12-31"))
  }
  out
}

# tests/testthat/test-imputation.R

test_that("complete dates are returned unchanged", {
  expect_equal(impute_dtc("2026-03-15"), as.Date("2026-03-15"))
  expect_equal(impute_dtc("2026-03-15", "last"), as.Date("2026-03-15"))
})

test_that("missing day imputes to the first or last of the month", {
  expect_equal(impute_dtc("2026-03", "first"), as.Date("2026-03-01"))
  expect_equal(impute_dtc("2026-03", "last"),  as.Date("2026-03-31"))
})

test_that("month lengths are handled correctly", {
  expect_equal(impute_dtc("2026-02", "last"), as.Date("2026-02-28"))
  expect_equal(impute_dtc("2024-02", "last"), as.Date("2024-02-29"))  # leap year
  expect_equal(impute_dtc("2026-04", "last"), as.Date("2026-04-30"))
})

test_that("missing month and day impute to year boundaries", {
  expect_equal(impute_dtc("2026", "first"), as.Date("2026-01-01"))
  expect_equal(impute_dtc("2026", "last"),  as.Date("2026-12-31"))
})

test_that("missing and malformed values return NA", {
  expect_true(is.na(impute_dtc(NA_character_)))
  expect_true(is.na(impute_dtc("")))
  expect_true(is.na(impute_dtc("not a date")))
  expect_true(is.na(impute_dtc("2026-13-45")))
})

test_that("the function is vectorised and preserves length", {
  x <- c("2026-03-15", "2026-03", "2026", NA)
  out <- impute_dtc(x, "first")
  expect_length(out, 4)
  expect_s3_class(out, "Date")
  expect_equal(out, as.Date(c("2026-03-15", "2026-03-01", "2026-01-01", NA)))
})

test_that("an invalid direction is rejected", {
  expect_error(impute_dtc("2026-03", "middle"), "should be one of")
})

Seven tests, each stating one behaviour. The leap-year test is the one that justifies the whole exercise — it is exactly the case a hand-check on one dataset would miss.

Common mistakes

Mistake	Consequence	Fix
Testing only the happy path	Breaks on real data	Test empty, `NA`, single row
Vague test descriptions	Failures are uninformative	State the behaviour
Tests that depend on each other	Order-dependent failures	Each test self-contained
Random data without `set.seed()`	Flaky suite	Seed it, or use fixed data
Testing implementation details	Breaks on every refactor	Test observable behaviour
Chasing 100% coverage	Meaningless tests	Target the uncovered logic
Changing global state	Later tests fail mysteriously	`withr::local_*()`

Exercise 10.1 — Test a BMI function

Write a complete test file for:

calculate_bmi <- function(weight_kg, height_cm) {
  if (!is.numeric(weight_kg) || !is.numeric(height_cm)) {
    stop("weight_kg and height_cm must be numeric")
  }
  if (any(height_cm <= 0, na.rm = TRUE)) {
    stop("height_cm must be positive")
  }
  weight_kg / (height_cm / 100)^2
}

Show solution

test_that("BMI is calculated correctly for known values", {
  expect_equal(calculate_bmi(70, 175), 22.857143, tolerance = 1e-6)
  expect_equal(calculate_bmi(50, 150), 22.222222, tolerance = 1e-6)
  expect_equal(calculate_bmi(100, 200), 25)
})

test_that("the function is vectorised", {
  out <- calculate_bmi(c(70, 50, 100), c(175, 150, 200))
  expect_length(out, 3)
  expect_equal(out[3], 25)
})

test_that("missing values propagate rather than error", {
  expect_true(is.na(calculate_bmi(NA_real_, 175)))
  expect_true(is.na(calculate_bmi(70, NA_real_)))
  expect_equal(calculate_bmi(c(70, NA), c(175, 175))[1], 22.857143,
               tolerance = 1e-6)
})

test_that("non-numeric input is rejected", {
  expect_error(calculate_bmi("70", 175), "must be numeric")
  expect_error(calculate_bmi(70, "175"), "must be numeric")
})

test_that("non-positive heights are rejected", {
  expect_error(calculate_bmi(70, 0),   "must be positive")
  expect_error(calculate_bmi(70, -175), "must be positive")
})

test_that("empty input returns empty output", {
  out <- calculate_bmi(numeric(0), numeric(0))
  expect_length(out, 0)
  expect_type(out, "double")
})

test_that("mismatched lengths recycle or error predictably", {
  # length-1 recycles — this is intended
  expect_length(calculate_bmi(70, c(175, 180)), 2)
})

The last test documents an ambiguity rather than resolving it. If silent recycling of a length-3 weight against a length-2 height is undesirable — and it usually is — the function should be changed to check length(weight_kg) == length(height_cm) || length(weight_kg) == 1, and the test updated to expect_error(). Writing the test is what surfaces the design question.

Exercise 10.2 — Test a data frame derivation

Write tests for derive_trtemfl(adae, adsl), which adds a TRTEMFL "Y"/"N" flag: "Y" when the AE start date is on or after treatment start and no later than 30 days after treatment end.

Show solution

# tests/testthat/helper-ae.R
make_ae <- function(astdt) {
  tibble::tibble(
    USUBJID = sprintf("%03d", seq_along(astdt)),
    ASTDT   = as.Date(astdt)
  )
}

make_sl <- function(n, trtsdt = "2026-03-15", trtedt = "2026-06-15") {
  tibble::tibble(
    USUBJID = sprintf("%03d", seq_len(n)),
    TRTSDT  = as.Date(trtsdt),
    TRTEDT  = as.Date(trtedt)
  )
}

test_that("events on or after treatment start are flagged Y", {
  ae <- make_ae(c("2026-03-15", "2026-04-01", "2026-06-15"))
  out <- derive_trtemfl(ae, make_sl(3))
  expect_equal(out$TRTEMFL, c("Y", "Y", "Y"))
})

test_that("events before treatment start are flagged N", {
  ae <- make_ae(c("2026-03-14", "2026-01-01"))
  out <- derive_trtemfl(ae, make_sl(2))
  expect_equal(out$TRTEMFL, c("N", "N"))
})

test_that("the 30-day follow-up window boundary is inclusive", {
  ae <- make_ae(c("2026-07-15", "2026-07-16"))   # TRTEDT + 30, +31
  out <- derive_trtemfl(ae, make_sl(2))
  expect_equal(out$TRTEMFL, c("Y", "N"))
})

test_that("subjects with no treatment start are flagged N", {
  ae  <- make_ae("2026-04-01")
  sl  <- make_sl(1, trtsdt = NA)
  out <- derive_trtemfl(ae, sl)
  expect_equal(out$TRTEMFL, "N")
})

test_that("an ongoing treatment (missing TRTEDT) has no upper bound", {
  ae  <- make_ae("2027-01-01")
  sl  <- make_sl(1, trtedt = NA)
  out <- derive_trtemfl(ae, sl)
  expect_equal(out$TRTEMFL, "Y")
})

test_that("row count and column set are preserved", {
  ae  <- make_ae(c("2026-04-01", "2026-05-01"))
  out <- derive_trtemfl(ae, make_sl(2))
  expect_equal(nrow(out), 2)
  expect_true(all(names(ae) %in% names(out)))
  expect_identical(out$TRTEMFL, c("Y", "Y"))   # character, not logical
})

test_that("an AE for a subject not in ADSL is an error", {
  ae <- make_ae(c("2026-04-01", "2026-04-01"))
  expect_error(derive_trtemfl(ae, make_sl(1)), "not found in ADSL")
})

The boundary test is the most valuable one: “within 30 days” is exactly the kind of requirement where an off-by-one is invisible in a data review and obvious in a test. The final test asserts a design decision — an orphan AE should be a hard error, not a silent "N" — and documents it for the next person.

Note expect_identical() rather than expect_equal() on TRTEMFL: the character type is part of the contract, since a logical would break the downstream CDISC output.

Recap

Unit tests complement double programming: logic verification versus specification verification
Test descriptions state behaviour; failures then read as sentences
Always test empty input, all-NA, and boundary values
helper-*.R for shared fixtures, withr::local_*() for global state
Snapshot tests are ideal for TLF output and error messages
Coverage finds untested code; it does not tell you the tests are good

Next: Package development.