如何优化R中重复调查模拟的内存与运行速度？

安全阿岳

2026-7-10

大规模调查模拟的R语言优化方案

问题背景

需要在R中执行大规模调查模拟：

涉及257个街道（sub-district），每个街道下含若干村庄，各村已知特定病症人群占比
需遍历5种村庄抽样数（n_village: 5/10/20/30/50）、5种单村抽样人数（n_person: 10/15/20/25/30）的参数组合，每个组合重复1000次模拟，总计生成6,425,000个结果
模拟步骤：随机抽取村庄→单村抽人统计患病数→计算区域病症占比估计值及置信区间
当前困境：使用mapply或嵌套tibble+pmap时，出现内存不足、性能严重下降；后续还需用binom.test计算置信区间，并用lme4做多水平模型分析

优化方案

一、避免保存所有中间值的策略

核心逻辑：只保留最终需要的统计结果（区域患病率估计、置信区间等），完全跳过抽样村庄/人员的明细存储，从根源减少内存占用。

1. 向量化模拟+即时计算汇总统计

放弃嵌套tibble存储抽样村庄的明细数据，直接在抽样后计算汇总统计量，避免冗余数据堆积。

示例代码：

library(tidyverse)
library(furrr) # 并行计算工具，可选

# 初始化并行（根据CPU核心数调整workers，留1个核心给系统）
plan(multisession, workers = parallel::detectCores() - 1)

# 预处理抽样框架：按街道分组，仅保留各村患病率向量（节省内存）
sampling_frame <- sampling_frame_df %>%
  ungroup() %>%
  select(shapeName_3, site.prev) %>%
  nest_by(shapeName_3) %>%
  mutate(data = list(pull(data, site.prev))) # 将嵌套tibble转为向量

# 定义单街道的模拟函数：输入患病率向量、抽样参数，直接返回汇总结果
simulate_single_subdistrict <- function(site_prevs, n_village, n_person) {
  n_avail_villages <- length(site_prevs)
  # 抽取指定数量的村庄（若可用村庄不足则取全部）
  sampled_prevs <- sample(site_prevs, size = min(n_village, n_avail_villages), replace = FALSE)
  # 计算每个抽中村庄的患病人数
  n_pos_per_village <- rbinom(length(sampled_prevs), size = n_person, prob = sampled_prevs)
  # 计算区域汇总统计
  total_pos <- sum(n_pos_per_village)
  total_people <- length(sampled_prevs) * n_person
  p_hat <- total_pos / total_people
  # 计算置信区间
  ci_result <- binom.test(total_pos, total_people)$conf.int
  # 返回仅需的结果字段
  tibble(
    p_hat = p_hat,
    ci_lower = ci_result[1],
    ci_upper = ci_result[2],
    total_pos = total_pos,
    total_people = total_people
  )
}

# 生成全量模拟参数组合（关联对应街道的患病率数据）
sim_params <- expand_grid(
  shapeName_3 = unique(sampling_frame$shapeName_3),
  n_village = c(5,10,20,30,50),
  n_person = c(10,15,20,25,30),
  sim_id = 1:1000
) %>%
  left_join(sampling_frame, by = "shapeName_3")

# 并行执行模拟，直接得到汇总结果（无中间明细）
sim_results <- sim_params %>%
  mutate(result = future_pmap(
    .l = list(site_prevs = data, n_village = n_village, n_person = n_person),
    .f = simulate_single_subdistrict
  )) %>%
  unnest(result) %>%
  select(-data) # 移除患病率向量，释放内存

2. 分块处理+增量写入文件

若数据量过大无法一次性计算，可按街道或参数组合分块处理，每完成一块就写入文件，不将全量数据留在内存中。

示例代码：

# 按街道分块遍历
all_subdistricts <- unique(sampling_frame$shapeName_3)

for (sd in all_subdistricts) {
  # 提取当前街道的参数和患病率数据
  current_params <- sim_params %>% filter(shapeName_3 == sd)
  current_prevs <- sampling_frame %>% filter(shapeName_3 == sd) %>% pull(data) %>% first()
  
  # 执行模拟并生成结果
  current_results <- current_params %>%
    mutate(result = pmap(
      .l = list(n_village = n_village, n_person = n_person),
      .f = function(n_village, n_person) {
        simulate_single_subdistrict(current_prevs, n_village, n_person)
      }
    )) %>%
    unnest(result) %>%
    select(-data)
  
  # 增量写入文件（这里用CSV，也可替换为fst/qs）
  if (sd == all_subdistricts[1]) {
    write_csv(current_results, "simulation_results.csv")
  } else {
    write_csv(current_results, "simulation_results.csv", append = TRUE)
  }
}

二、RDS文件读写提速建议

替换为更高效的文件格式：

fst包：读写速度远快于RDS，支持随机访问，可平衡压缩率与速度：

library(fst)
# 写入（compress取值0-100，值越大压缩率越高，速度稍慢）
write_fst(sim_results, "sim_results.fst", compress = 50)
# 读取
sim_results <- read_fst("sim_results.fst")

qs包：压缩率比RDS更高，读写速度更快，适合超大规模数据：

library(qs)
qsave(sim_results, "sim_results.qs")
sim_results <- qread("sim_results.qs")

优化RDS自身参数：
- 若磁盘空间充足，写入时关闭压缩以换取速度：
```
saveRDS(sim_results, "sim_results.rds", compress = FALSE)
```
- 大文件分块读写：避免一次性读取全量数据，按需加载分块内容。

三、其他性能优化细节

移除rowwise()：rowwise()会大幅降低代码运行效率，改用向量化操作或map()系列函数替代。
优先使用向量而非tibble：中间数据尽量用向量存储（如村庄患病率），减少嵌套tibble带来的内存开销。
预分配内存：若使用循环，提前预分配结果容器（如tibble或向量），避免动态扩容的性能损耗。

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

如何优化R中重复调查模拟的内存与运行速度？

问题背景 #

优化方案 #

一、避免保存所有中间值的策略 #