tdd-workflow

R 的测试驱动开发工作流

此技能可确保所有 R 代码开发都遵循 TDD 原则，并使用 testthat 实现全面的测试覆盖率。

何时启用

• 编写新函数或功能
• 修复 Bug 或问题
• 重构现有代码
• 添加新模型类型
• 创建数据处理管道
• 构建 Shiny 组件

开始使用

为你的包初始化测试基础设施：

# Set up testthat (Edition 3)
usethis::use_testthat(3)

# Create a test file for an existing source file
usethis::use_test("function_name")

# Or create test and source file together
usethis::use_r("function_name")
usethis::use_test("function_name")

核心原则

1. 先写测试，再写代码

始终先编写测试，再实现代码使测试通过。

2. 覆盖率要求

• 最低覆盖率为 80%（单元测试 + 集成测试）
• 统计计算的覆盖率为 100%
• 数据验证的覆盖率为 100%
• 覆盖所有边界情况
• 测试错误场景

3. 测试类型

测试遵循三级层次结构：文件 → 测试 → 断言

单元测试

针对单个函数和实用工具：

test_that("rescale01 normalizes to [0, 1] range", {
  expect_equal(rescale01(c(0, 5, 10)), c(0, 0.5, 1))
  expect_equal(rescale01(c(-10, 0, 10)), c(0, 0.5, 1))
})

test_that("rescale01 handles edge cases", {
  expect_equal(rescale01(c(5, 5, 5)), c(NaN, NaN, NaN))
  expect_equal(rescale01(numeric(0)), numeric(0))
  expect_equal(rescale01(c(0, NA, 10)), c(0, NA, 1))
})

集成测试

针对函数交互和工作流：

test_that("data pipeline produces expected output", {
  raw_data <- read_fixture("sample_input.csv")

  result <- raw_data |>
    clean_data() |>
    transform_features() |>
    summarize_results()

  expect_s3_class(result, "tbl_df")
  expect_named(result, c("group", "mean", "sd", "n"))
  expect_true(all(result$n > 0))
})

快照测试

用于难以明确指定的复杂输出：

test_that("model summary format is stable", {
  model <- fit_model(test_data)
  expect_snapshot(print(summary(model)))
})

test_that("error messages are informative", {
  expect_snapshot(
    validate_input(invalid_data),
    error = TRUE
  )
})

快照工作流：

# Review snapshot changes
testthat::snapshot_review("test_name")

# Accept snapshot changes
testthat::snapshot_accept("test_name")

快照存储在 tests/testthat/_snaps/ 目录中。

BDD 替代方案（可选）

对于行为驱动开发，可使用 describe() 和 it()：

describe("matrix()", {
  it("can be multiplied by a scalar", {
    m1 <- matrix(1:4, 2, 2)
    m2 <- m1 * 2
    expect_equal(matrix(c(2, 4, 6, 8), 2, 2), m2)
  })

  it("can be transposed", {
    m <- matrix(1:4, 2, 2)
    expect_equal(t(m), matrix(c(1, 3, 2, 4), 2, 2))
  })
})

主要区别：“describe() 用于验证你实现了正确的功能，test_that() 用于确保你正确地实现了功能。”

测试设计原则

自给自足的测试

每个测试都应包含所有设置、执行和清理代码。测试必须彼此独立，并且可以单独运行，不依赖环境状态或先前的测试执行。

# GOOD: Self-contained
test_that("function works with specific data", {
  data <- tibble(x = 1:10, y = rnorm(10))  # Setup
  result <- my_function(data)               # Execute
  expect_equal(nrow(result), 10)            # Assert
})

# BAD: Depends on external state
# setup_data <- tibble(...)  # Created outside test
test_that("function works", {
  result <- my_function(setup_data)  # Relies on external data
  expect_equal(nrow(result), 10)
})

宁可重复，也不要抽象

测试中允许重复——与其将设置代码抽取到其他位置，不如重复编写。清晰度比避免重复更重要。

# GOOD: Duplicated but clear
test_that("clean_data handles missing values", {
  data <- tibble(x = c(1, NA, 3), y = c(4, 5, 6))
  result <- clean_data(data)
  expect_equal(nrow(result), 2)
})

test_that("clean_data handles invalid values", {
  data <- tibble(x = c(1, -999, 3), y = c(4, 5, 6))
  result <- clean_data(data, invalid = -999)
  expect_equal(nrow(result), 2)
})

# ACCEPTABLE: Each test is self-contained and readable

为失败做好准备

编写测试时应假设它们会失败，需要调试。让逻辑明确且易于理解。在全新的 R 会话中独立运行测试。

使用 devtools::load_all()

开发期间，优先使用 devtools::load_all()，而不是 library()。它可以：

• 暴露未导出的函数以供测试
• 自动加载 testthat
• 避免在测试中进行不必要的 library() 调用
• 无需安装即可模拟加载包

testthat 第 3 版

第 3 版改进了快照测试、通过 waldo 提供更清晰的差异显示、统一了条件处理、支持并行执行，并兼容用于模拟的字节编译代码。

已弃用的模式 → 现代替代方案

# DEPRECATED: context() calls
context("Data validation")  # Remove - filename serves this purpose

# DEPRECATED: expect_equivalent()
expect_equivalent(x, y)
# MODERN:
expect_equal(x, y, ignore_attr = TRUE)

# DEPRECATED: with_mock()
with_mock(external_call = function() "mocked", {
  result <- my_function()
})
# MODERN:
local_mocked_bindings(
  external_call = function() "mocked"
)
result <- my_function()

# DEPRECATED: expect_is()
expect_is(x, "data.frame")
# MODERN:
expect_s3_class(x, "data.frame")

初始化第 3 版

在 DESCRIPTION 中，确保：

Config/testthat/edition: 3

或使用以下方式初始化：

usethis::use_testthat(3)

常用断言参考

相等性与同一性

expect_equal(x, y)              # With numeric tolerance
expect_equal(x, y, tolerance = 0.001)
expect_equal(x, y, ignore_attr = TRUE)
expect_identical(x, y)          # Exact match required
expect_all_equal(x)             # Every element equal (v3.3.0+)

条件

expect_error(code)
expect_error(code, "pattern")
expect_error(code, class = "validation_error")
expect_warning(code)
expect_no_warning(code)
expect_message(code)
expect_no_message(code)

集合与集

expect_setequal(x, y)          # Same elements, any order
expect_contains(set, element)  # Subset relationship (v3.2.0+)
expect_in(element, set)        # Membership check (v3.2.0+)
expect_disjoint(set1, set2)    # No overlap (v3.3.0+)
expect_named(x, c("a", "b"))   # Named vector/list

类型与结构

expect_type(x, "double")
expect_s3_class(x, "data.frame")
expect_s4_class(x, "S4Class")
expect_r6_class(x, "R6Class")
expect_shape(matrix, c(2, 3))  # Matrix/array dimensions (v3.3.0+)
expect_length(x, 10)

逻辑值

expect_true(x)
expect_false(x)
expect_all_true(x)             # Every element TRUE (v3.3.0+)
expect_all_false(x)            # Every element FALSE (v3.3.0+)

其他实用断言

expect_null(x)
expect_invisible(result)
expect_output(print(x), "pattern")
expect_snapshot(complex_output)

文件组织

测试目录结构与包结构保持一致：

tests/
├── testthat/
│   ├── test-validation.R      # Tests for R/validation.R
│   ├── test-processing.R      # Tests for R/processing.R
│   ├── test-models.R          # Tests for R/models.R
│   ├── test-output.R          # Tests for R/output.R
│   ├── helper-fixtures.R      # Shared functions (sourced before tests)
│   ├── setup-database.R       # Setup code (runs during R CMD check)
│   ├── helper-expectations.R  # Custom expectations
│   └── fixtures/              # Static test data files
│       ├── sample_input.csv
│       └── expected_output.rds
└── testthat.R                 # Test runner

文件类型

• test-*.R - 实际测试文件（与源文件配对）
• helper-*.R - 共享实用函数，在测试运行前载入
• setup-*.R - 仅在 R CMD check 期间运行的设置代码
• fixtures/ - 静态测试数据，通过 test_path("fixtures/file") 访问

访问测试夹具：

test_path("fixtures", "sample_data.csv")

TDD 工作流步骤

步骤 1：定义预期行为

记录函数应执行的操作：

# Function: calculate_ci
# Purpose: Calculate bootstrap confidence intervals
# Inputs:
#   - data: numeric vector
#   - conf_level: confidence level (default 0.95)
#   - n_boot: number of bootstrap samples (default 1000)
# Outputs:
#   - Named numeric vector with lower and upper bounds
# Edge cases:
#   - Handle NA values
#   - Error on non-numeric input
#   - Error on empty input

步骤 2：编写失败的测试

# tests/testthat/test-calculate_ci.R
library(testthat)

test_that("calculate_ci returns correct structure", {
  set.seed(123)
  result <- calculate_ci(1:100)

  expect_type(result, "double")
  expect_named(result, c("lower", "upper"))
  expect_true(result["lower"] < result["upper"])
})

test_that("calculate_ci respects confidence level", {
  set.seed(123)
  ci_95 <- calculate_ci(1:100, conf_level = 0.95)
  ci_99 <- calculate_ci(1:100, conf_level = 0.99)

  # 99% CI should be wider
  expect_true(ci_99["upper"] - ci_99["lower"] > ci_95["upper"] - ci_95["lower"])
})

test_that("calculate_ci handles NA values", {
  set.seed(123)
  result <- calculate_ci(c(1:100, NA, NA))

  expect_false(any(is.na(result)))
})

test_that("calculate_ci validates inputs", {
  expect_error(calculate_ci("not numeric"), class = "validation_error")
  expect_error(calculate_ci(numeric(0)), class = "validation_error")
  expect_error(calculate_ci(1:10, conf_level = 1.5), class = "validation_error")
})

步骤 3：运行测试（测试应失败）

devtools::test()
# ✖ calculate_ci returns correct structure
# ✖ calculate_ci respects confidence level
# ✖ calculate_ci handles NA values
# ✖ calculate_ci validates inputs

步骤 4：实现最少量的代码

# R/calculate_ci.R

#' Calculate Bootstrap Confidence Interval
#'
#' @param x Numeric vector
#' @param conf_level Confidence level (default 0.95)
#' @param n_boot Number of bootstrap samples (default 1000)
#' @return Named numeric vector with lower and upper bounds
#' @export
calculate_ci <- function(x, conf_level = 0.95, n_boot = 1000) {
  # Validate inputs
  if (!is.numeric(x)) {
    cli::cli_abort("{.arg x} must be numeric", class = "validation_error")
  }
  if (length(x) == 0) {
    cli::cli_abort("{.arg x} cannot be empty", class = "validation_error")
  }
  if (conf_level <= 0 || conf_level >= 1) {
    cli::cli_abort("{.arg conf_level} must be between 0 and 1", class = "validation_error")
  }

  # Remove NA values
  x <- x[!is.na(x)]

  # Bootstrap
  boot_means <- replicate(n_boot, mean(sample(x, replace = TRUE)))

  # Calculate quantiles
  alpha <- 1 - conf_level
  c(
    lower = unname(quantile(boot_means, alpha / 2)),
    upper = unname(quantile(boot_means, 1 - alpha / 2))
  )
}

步骤 5：再次运行测试

devtools::test()
# ✔ calculate_ci returns correct structure
# ✔ calculate_ci respects confidence level
# ✔ calculate_ci handles NA values
# ✔ calculate_ci validates inputs

步骤 6：重构

在保持测试通过的同时进行改进：

# Extract validation to helper
validate_ci_inputs <- function(x, conf_level) {
  if (!is.numeric(x)) {
    cli::cli_abort("{.arg x} must be numeric", class = "validation_error")
  }
  if (length(x) == 0) {
    cli::cli_abort("{.arg x} cannot be empty", class = "validation_error")
  }
  if (conf_level <= 0 || conf_level >= 1) {
    cli::cli_abort("{.arg conf_level} must be between 0 and 1", class = "validation_error")
  }
}

calculate_ci <- function(x, conf_level = 0.95, n_boot = 1000) {
  validate_ci_inputs(x, conf_level)

  x <- x[!is.na(x)]
  boot_means <- replicate(n_boot, mean(sample(x, replace = TRUE)))

  alpha <- 1 - conf_level
  c(
    lower = unname(quantile(boot_means, alpha / 2)),
    upper = unname(quantile(boot_means, 1 - alpha / 2))
  )
}

步骤 7：验证覆盖率

covr::package_coverage()
# calculate_ci.R: 100%

测试模式

测试数据转换

test_that("clean_data removes invalid rows", {
  input <- tibble(
    id = 1:4,
    value = c(1, NA, 3, -999)
  )

  result <- clean_data(input, invalid_value = -999)

  expect_equal(nrow(result), 2)
  expect_equal(result$id, c(1, 3))
  expect_false(anyNA(result$value))
})

测试统计函数

test_that("weighted_mean matches manual calculation", {
  x <- c(1, 2, 3)
  w <- c(1, 2, 1)

  result <- weighted_mean(x, w)
  expected <- sum(x * w) / sum(w)  # (1 + 4 + 3) / 4 = 2

  expect_equal(result, expected)
})

使用测试夹具进行测试

# helper-fixtures.R
read_fixture <- function(name) {
  path <- testthat::test_path("fixtures", name)
  readr::read_csv(path, show_col_types = FALSE)
}

# test-pipeline.R
test_that("pipeline handles real data", {
  input <- read_fixture("sample_data.csv")
  result <- process_pipeline(input)

  expect_snapshot(result)
})

模拟外部依赖

test_that("fetch_data handles API errors", {
  # Mock the API call
  local_mocked_bindings(
    httr2_request = function(...) {
      stop("API unavailable")
    }
  )

  expect_error(
    fetch_data("endpoint"),
    "API unavailable"
  )
})

使用 withr 进行清理

使用 withr 函数管理临时状态，并自动恢复：

test_that("function respects options", {
  # Temporarily set options
  withr::local_options(list(digits = 2))

  result <- format_number(3.14159)
  expect_equal(result, "3.14")
})

test_that("function writes to temp file", {
  # Create temp file that's automatically cleaned up
  tmp <- withr::local_tempfile(lines = c("line 1", "line 2"))

  result <- process_file(tmp)
  expect_equal(result$n_lines, 2)
})

test_that("function uses custom environment variable", {
  # Temporarily set env var
  withr::local_envvar(MY_VAR = "test_value")

  result <- get_config()
  expect_equal(result$my_var, "test_value")
})

测试数据策略

根据测试需求选择合适的方法：

1. 构造函数

使用辅助函数按需创建数据：

# helper-data.R
make_sample_data <- function(n = 100) {
  tibble(
    id = 1:n,
    group = sample(c("A", "B"), n, replace = TRUE),
    value = rnorm(n)
  )
}

# test-analysis.R
test_that("analysis handles grouped data", {
  data <- make_sample_data(n = 50)
  result <- analyze_groups(data)
  expect_s3_class(result, "tbl_df")
})

2. 带清理功能的本地函数

使用 withr 处理副作用：

test_that("function reads CSV correctly", {
  # Create temp file with cleanup
  tmp <- withr::local_tempfile(fileext = ".csv")
  write.csv(mtcars, tmp, row.names = FALSE)

  result <- read_and_process(tmp)
  expect_equal(nrow(result), 32)
})

3. 静态夹具

将数据文件存放在 fixtures/ 目录中：

# Store in: tests/testthat/fixtures/sample_data.csv

test_that("function handles real data format", {
  path <- test_path("fixtures", "sample_data.csv")
  data <- read_csv(path)
  result <- process_data(data)
  expect_true(all(result$valid))
})

应避免的常见测试错误

错误：测试实现细节

# Don't test internal state
expect_equal(obj$internal_cache, expected_cache)

正确：测试行为

# Test observable behavior
expect_equal(get_result(obj), expected_result)

错误：脆弱的测试

# Breaks on any output change
expect_equal(as.character(result), "Mean: 5.234567890")

正确：灵活的断言

# Robust to formatting changes
expect_equal(result$mean, 5.23, tolerance = 0.01)

错误：相互依赖的测试

test_that("creates data", { global_data <<- create() })
test_that("uses data", { process(global_data) })  # Depends on previous!

正确：独立的测试

test_that("creates and uses data", {
  data <- create()
  result <- process(data)
  expect_true(is_valid(result))
})

错误：为了通过而修改测试

# When a test fails, don't change the test (unless it's wrong)
test_that("function returns 42", {
  expect_equal(my_function(), 42)  # Test fails
})

# DON'T DO THIS:
test_that("function returns 41", {
  expect_equal(my_function(), 41)  # Changed to pass - WRONG!
})

正确：修复实现

# Fix the code to match expected behavior
test_that("function returns 42", {
  expect_equal(my_function(), 42)  # Test fails
})

# Fix my_function() implementation instead

测试失败时

1. 不要修改测试来让它们通过（除非测试本身有误）
2. 修复实现，使其符合预期行为
3. 添加更多测试，以应对失败暴露出的覆盖缺失
4. 仅在更改是有意为之时才更新快照

# Review and accept snapshot changes
testthat::snapshot_review("test_name")
testthat::snapshot_accept("test_name")

覆盖率验证

# Run coverage report
covr::package_coverage()

# Interactive HTML report
covr::report()

# Check specific thresholds
cov <- covr::package_coverage()
pct <- covr::percent_coverage(cov)
if (pct < 80) {
  stop("Coverage below 80%: ", round(pct, 1), "%")
}

# In testthat.R or as a coverage check
covr::package_coverage(
  type = "all",
  line_coverage = 0.80,
  function_coverage = 0.80
)

调试与开发

以不同规模运行测试

# Micro: Interactive development
devtools::load_all()
expect_equal(my_function(1), 1)  # Direct expectation

# Mezzo: Single file
testthat::test_file("tests/testthat/test-validation.R")
# RStudio: Ctrl/Cmd+Shift+T

# Macro: Full suite
devtools::test()
devtools::check()  # Full package validation

测试报告器

# Find slow tests
devtools::test(reporter = "slow")

# Progress reporter (verbose)
devtools::test(reporter = "progress")

# Test execution order independence
devtools::test(shuffle = TRUE)

持续测试

# Watch mode - auto-run on file changes
testthat::auto_test_package()

并行执行（Edition 3）

Edition 3 支持并行执行测试，让多核系统上的测试运行更快。

运行测试

# All tests
devtools::test()

# All tests (keyboard shortcut)
# RStudio: Ctrl/Cmd+Shift+T

# With coverage
covr::package_coverage()

# Specific file
testthat::test_file("tests/testthat/test-validation.R")

# Watch mode
testthat::auto_test_package()

# Verbose output
devtools::test(reporter = "progress")

# Find slow tests
devtools::test(reporter = "slow")

# Test independence
devtools::test(shuffle = TRUE)

# Full package check
devtools::check()

成功指标

• 代码覆盖率达到 80% 以上
• 所有测试均通过
• 没有跳过的测试
• 执行速度快（单元测试耗时 < 30s）
• 测试能在代码投入生产前发现错误
• 支持放心重构
• 测试可按任意顺序独立运行
• 测试名称清晰且具有描述性
• 每个测试验证一个概念

---

请记住：测试不是可选项。它们是安全网，能够支持放心重构、快速开发和生产可靠性。请优先编写测试。