R语言Stan模拟函数如何免全局赋值保留可复用条件对象

原来依赖<<-把sim_out写入全局环境的实现，会存在全局空间变量污染、跨调用状态不可控、变量名冲突的风险，可通过以下两种不依赖全局环境的方案实现原有逻辑，完全规避取消全局赋值后出现对象不存在的报错：

方案1：闭包（函数工厂）实现私有状态存储 #

通过创建带独立私有环境的函数实例，把原本要存在全局的sim_out存储在函数的封闭父环境中，所有状态完全被限制在函数作用域内，不会暴露到全局空间，且能完全兼容原有的调用习惯。
实现代码如下：

# 构造带私有状态的函数工厂
sim_data_factory <- function() {
  # 该对象为工厂函数的私有环境变量，仅在闭包内部可访问
  cached_sim_out <- NULL
  
  # 返回的实际运行函数
  function(nSim, nSubj) {
    set.seed(nSim)
    X <- as.matrix(data.frame(
      Var1 = sample(c(0,1), nSubj, replace = TRUE), 
      Var2 = sample(c(0,1), nSubj, replace = TRUE),
      Var3 = scale(rnorm(nSubj, mean = 50, sd = 2), center = TRUE, scale = TRUE)
    ))
  
    # 首次运行时生成缓存的模拟Stan输出，赋值仅作用于私有环境
    if (is.null(cached_sim_out) && nSim == 1) {
      cached_sim_out <<- sampling(Sim_Mod, 
                                  data = list(n = nSubj, 
                                              k = ncol(X), 
                                              X = X, 
                                              Y = rnorm(nSubj, mean = 65, sd = 10), 
                                              run_estimation = 0))
    }  
  
    # 后续数据提取、模型拟合逻辑与原代码完全一致
    sim_data <- cached_sim_out %>% 
      as.data.frame %>% 
      select(contains("y_sim")) %>%
      .[, sample(ncol(.), nSubj)] %>%
      apply(., 2, sample, size = 1) %>%
      as_tibble() %>%
      rename("y_sim" = value)
  
    sampling(Sim_Mod, 
            data = list(n = nSubj, 
                        k = ncol(X), 
                        X = X, 
                        Y = sim_data$y_sim, 
                        run_estimation = 1)) 
  }
}

# 初始化一次带私有状态的函数实例，后续直接按原参数调用即可
sim_data_fit <- sim_data_factory()

该方案里的<<-仅会向上查找私有环境中的cached_sim_out完成赋值，完全不会触达全局环境，和原实现的全局赋值有本质区别。

方案2：显式传参拆分模拟流程（更推荐用于蒙特卡洛模拟） #

彻底去掉函数内部的隐式状态，将预生成的sim_out作为显式参数传入函数，所有运行逻辑完全透明、可追溯，避免隐式状态带来的调试困难：

1. 先单独运行一次Stan模拟流程，得到预生成的sim_out对象
2. 调整原函数，将预生成的模拟输出设为函数的传入参数，函数内部不再需要判断是否要生成sim_out、也不需要存储任何历史状态
   实现代码如下：

# 第一步：预生成模拟Stan输出，按你自己的需求指定nSubj、X的取值
X_pre <- as.matrix(data.frame(
  Var1 = sample(c(0,1), nSubj, replace = TRUE), 
  Var2 = sample(c(0,1), nSubj, replace = TRUE),
  Var3 = scale(rnorm(nSubj, mean = 50, sd = 2), center = TRUE, scale = TRUE)
))
pre_sim_out <- sampling(Sim_Mod, 
                        data = list(n = nSubj, 
                                    k = ncol(X_pre), 
                                    X = X_pre, 
                                    Y = rnorm(nSubj, mean = 65, sd = 10), 
                                    run_estimation = 0))

# 第二步：调整后的拟合函数，无任何内部状态
sim_data_fit <- function(nSim, nSubj, pre_generated_sim = pre_sim_out) {
  set.seed(nSim)
  X <- as.matrix(data.frame(
    Var1 = sample(c(0,1), nSubj, replace = TRUE), 
    Var2 = sample(c(0,1), nSubj, replace = TRUE),
    Var3 = scale(rnorm(nSubj, mean = 50, sd = 2), center = TRUE, scale = TRUE)
  ))
  
  sim_data <- pre_generated_sim %>% 
    as.data.frame %>% 
    select(contains("y_sim")) %>%
    .[, sample(ncol(.), nSubj)] %>%
    apply(., 2, sample, size = 1) %>%
    as_tibble() %>%
    rename("y_sim" = value)
  
  sampling(Sim_Mod, 
           data = list(n = nSubj, 
                       k = ncol(X), 
                       X = X, 
                       Y = sim_data$y_sim, 
                       run_estimation = 1)) 
}

方案对比 #

• 闭包方案改动量小，完全兼容原有的函数调用习惯，适合需要快速适配原有代码的场景
• 显式传参方案逻辑更透明，所有输入输出都可追溯，是做大样本量蒙特卡洛模拟时的更规范写法，能减少大量隐式状态带来的奇怪bug

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