如何在R本地包中装饰并覆盖所有函数以生成输入输出格式字典

我明白你现在的困境——想用testthat测试时自动捕获函数的输入输出格式，但包命名空间的隔离确实会让装饰函数这件事变得棘手。下面是我亲测有效的解决方案，一步步帮你搞定：

核心思路 #

testthat运行时调用的是包命名空间里的函数，而非源文件中的定义，所以我们需要在测试启动时，直接替换命名空间内的函数为装饰后的版本，同时要保存原始函数避免重复装饰。

1. 完善装饰器逻辑 #

首先调整你的装饰器，让它能准确捕获输入参数（包括默认值）和输出的格式。这里我做了增强，支持记录参数类型/结构、输出结构，并写入RDS文件方便后续整理：

write_in_out_formats_decorator <- function(original_fn, func_name) {
  wrapper <- function(...) {
    # 1. 捕获完整输入参数（传入值+默认值）
    passed_args <- match.call(expand.dots = FALSE)$...
    formal_args <- formals(original_fn)
    full_args <- modifyList(formal_args, passed_args)
    
    # 2. 执行原始函数，保留原有行为
    result <- original_fn(...)
    
    # 3. 提取输入输出格式（针对嵌套tibble做优化）
    extract_structure <- function(x) {
      if (inherits(x, "tbl_df")) {
        # 嵌套tibble：记录列名、类型，以及嵌套层的结构
        purrr::map_dfr(x, ~{
          if (inherits(.x, "tbl_df")) {
            tibble::tibble(col = names(.x), type = purrr::map_chr(.x, class))
          } else {
            tibble::tibble(col = deparse(substitute(.x)), type = class(.x))
          }
        })
      } else {
        # 非tibble类型直接记录类
        class(x)
      }
    }
    
    input_structure <- lapply(full_args, extract_structure)
    output_structure <- extract_structure(result)
    
    # 4. 写入文件（用函数名命名，避免冲突）
    output_path <- file.path(tempdir(), paste0("io_", func_name, ".rds"))
    saveRDS(
      list(input = input_structure, output = output_structure),
      file = output_path
    )
    
    # 返回原始结果，不影响测试逻辑
    return(result)
  }
  return(wrapper)
}

2. 在testthat setup中替换命名空间函数 #

在tests/testthat/setup.R中编写以下代码，实现批量装饰并替换命名空间内的函数：

# 替换成你的包名
my_pkg <- "your_package_name"
pkg_namespace <- asNamespace(my_pkg)

# 创建隐藏环境保存原始函数，避免重复装饰
if (!exists(".original_functions", envir = pkg_namespace)) {
  assign(".original_functions", new.env(), envir = pkg_namespace)
}
original_fns <- get(".original_functions", envir = pkg_namespace)

# 获取需要装饰的函数列表：这里取所有导出函数，可根据需求调整
target_functions <- getNamespaceExports(my_pkg)

# 遍历装饰并替换
for (fn_name in target_functions) {
  # 只装饰一次，防止setup重复执行时嵌套装饰
  if (!exists(fn_name, envir = original_fns)) {
    # 从命名空间获取原始函数
    original_fn <- get(fn_name, envir = pkg_namespace)
    # 保存原始函数到隐藏环境
    assign(fn_name, original_fn, envir = original_fns)
    # 装饰函数
    decorated_fn <- write_in_out_formats_decorator(original_fn, fn_name)
    # 替换命名空间中的函数
    assignInNamespace(fn_name, decorated_fn, ns = my_pkg)
  }
}

3. 测试后收集格式字典 #

在tests/testthat/teardown.R中添加代码，将所有记录的输入输出格式合并成一个字典并保存：

my_pkg <- "your_package_name"
# 读取所有记录的RDS文件
io_files <- list.files(tempdir(), pattern = "^io_.*\\.rds$", full.names = TRUE)
io_dictionary <- lapply(io_files, readRDS)
# 用函数名作为字典的键
names(io_dictionary) <- gsub("^io_(.*)\\.rds$", "\\1", basename(io_files))

# 保存最终字典到包根目录（可自定义路径）
saveRDS(io_dictionary, file = file.path("..", "..", "function_io_dictionary.rds"))

关键注意事项 #

• 避免重复装饰：通过隐藏环境保存原始函数，确保每个函数只被装饰一次，防止测试多次运行时嵌套装饰。
• 保留原始行为：装饰器仅在函数执行前后添加记录逻辑，完全保留原始函数的功能和副作用。
• 自定义格式提取：你可以根据需求修改extract_structure函数，比如添加更多嵌套层级的信息，或者转换成markdown表格格式直接写入文档。
• 性能影响：装饰器会增加测试的运行时间，建议只在需要生成格式字典时启用，日常测试可以注释掉setup中的装饰逻辑。

内容的提问来源于stack exchange，提问作者vwrobel