R语言中doParallel加速蒙特卡洛PI估算代码反而变慢的问题

以下是导致多核心版本比单核心慢100倍的核心原因及对应解决方案：

• 任务粒度太小：如果把单个蒙特卡洛样本作为独立任务分发，进程间通信（IPC）的开销会完全盖过计算耗时。单核心无需IPC，自然效率更高。解决方法是按核心数拆分总迭代数，让每个worker处理大块样本集，而非单个样本。
• 频繁序列化/反序列化：若每个小任务都返回单个样本的判断结果，序列化和传输这些小数据的累积开销会非常惊人。应该让每个worker批量计算后，只返回最终的命中数总和，而非逐样本结果。
• 总迭代数不足，固定开销占比过高：worker启动、环境加载的固定开销是一次性的，如果总迭代数太小（比如几千级），这些固定开销会占总耗时的绝大部分。必须把迭代数提到千万级甚至更高，才能让计算开销盖过调度成本，体现多核心优势。
• 错误的结果合并方式：如果用rbind或类似操作合并每个worker返回的大量小数据，合并过程的开销会远超计算。正确的做法是让worker返回本地命中数，最终只做简单的数值求和。
• 未合理管理集群资源：如果测试时重复创建集群却未销毁，残留的worker进程会占用CPU资源，导致后续测试资源不足。每次并行任务结束后必须调用stopCluster(cl)关闭集群。

优化后的示例代码 #

library(doParallel)

n_iter <- 1e8  # 足够大的迭代量，摊薄固定开销
n_cores <- detectCores()
cl <- makeCluster(n_cores)
registerDoParallel(cl)

# 每个worker处理独立的大块样本，仅返回命中数
total_hits <- foreach(i = 1:n_cores, .combine = sum) %dopar% {
  set.seed(i)  # 每个worker设置独立随机种子，保证结果可复现
  chunk_size <- n_iter %/% n_cores
  x <- runif(chunk_size)
  y <- runif(chunk_size)
  sum(x^2 + y^2 <= 1)
}

pi_estimate <- 4 * total_hits / n_iter
stopCluster(cl)

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