为什么“foreach”在并行运行时不导出到我的可变对象？

Question

我正在 R 中建立一个患者级别的模拟模型。它需要随着时间的推移（使用两个内部循环）为每个患者（有和没有治疗）生成两个数据框。然后，我需要为模型中所需的每个患者循环内部循环。然后将内部循环的结果存储在全局环境中的列表中。

为了尝试加快进程，我想使用foreach 包并行运行外部循环。使用%do% 时，循环按预期工作（不并行运行循环）。但是，一旦我将其设置为 %dopar% 以并行运行，内部循环将不再导出到全局环境中的列表，并且我收到错误消息：

{ 中的错误：任务 1 失败 - “找不到对象‘Patient_Data’”

我在下面提供了代码，其中包含我的外循环函数的%do% 和%dopar% 版本的工作示例。示例中的内部循环已被移除，而仅替换为简单的概率图。

任何帮助将不胜感激。

library(tidyverse)
library(foreach)
library(doSNOW)

# Input
rm(list = ls())
Patient_Number <- 1000

#### Create a place to store patient data generated during the simulation ####

Patient_Data <- vector("list", length = Patient_Number)


#### Function - Non-parallel ####

Run_Sim <- function(){

  cl <- makeCluster(4, type = "SOCK")
  registerDoSNOW(cl)

  # record the time the model started

  model_start <- Sys.time()

  print(noquote(paste("Time model started: ", format(Sys.time(), "%a %d %b %Y %X"), sep = "")))

  #### Simulate Patient's BCVA scores ####

  # create progress bar

  print(noquote("Simulating Patients:"))

  pb <- txtProgressBar(min = 0, max = Patient_Number, style = 3)
  progress <- function(n) setTxtProgressBar(pb, n)
  opts <- list(progress = progress)

  foreach(i = 1:Patient_Number, .packages = c("tidyverse"), .inorder = FALSE,
          .export = ls(globalenv()),
          .options.snow = opts) %do% {

            This_Patient <- list(
              Patient_ID = 0,
              Intervention = 0,
              Comparator = 0
            )

            This_Patient_Draw_Int <- rnorm(1, mean = 50, sd = 7.8) # These normally would be more complex functions generating a data frame for each patient
            This_Patient_Draw_Comp <- rnorm(1, mean = 44, sd = 10) # These normally would be more complex functions generating a data frame for each patient

            This_Patient$Patient_ID <- i
            This_Patient$Intervention <- This_Patient_Draw_Int
            This_Patient$Comparator <- This_Patient_Draw_Comp

            Patient_Data[[i]] <<- This_Patient

          }

  # stop the progress bar

  close(pb)

  # record when model finished

  model_finish <- Sys.time()
  print(noquote(paste("Time model finished: ", format(Sys.time(), "%a %d %b %Y %X"), sep = "")))

  print(noquote(paste("Model took ", round(difftime(model_finish, model_start, units = c("mins")), 0),
                      " minute(s) to simulate ", Patient_Number, " Patients", sep = "")))

  stopCluster(cl)

}

Run_Sim()


#### Parallel version using foreach %dopar% ####

rm(list = ls())
Patient_Number <- 1000
Patient_Data <- vector("list", length = Patient_Number)

Run_Sim_Para <- function(){

  cl <- makeCluster(4, type = "SOCK")
  registerDoSNOW(cl)

  # record the time the model started

  model_start <- Sys.time()

  print(noquote(paste("Time model started: ", format(Sys.time(), "%a %d %b %Y %X"), sep = "")))

  #### Simulate Patient's BCVA scores ####

  # create progress bar

  print(noquote("Simulating Patients:"))

  pb <- txtProgressBar(min = 0, max = Patient_Number, style = 3)
  progress <- function(n) setTxtProgressBar(pb, n)
  opts <- list(progress = progress)

  foreach(i = 1:Patient_Number, .packages = c("tidyverse"), .inorder = FALSE,
          .export = ls(globalenv()),
          .options.snow = opts) %dopar% {

            This_Patient <- list(
              Patient_ID = 0,
              Intervention = 0,
              Comparator = 0
            )

            This_Patient_Draw_Int <- rnorm(1, mean = 50, sd = 7.8) # These normally would be more complex functions generating a data frame for each patient
            This_Patient_Draw_Comp <- rnorm(1, mean = 44, sd = 10) # These normally would be more complex functions generating a data frame for each patient

            This_Patient$Patient_ID <- i
            This_Patient$Intervention <- This_Patient_Draw_Int
            This_Patient$Comparator <- This_Patient_Draw_Comp

            Patient_Data[[i]] <<- This_Patient

          }

  # stop the progress bar

  close(pb)

  # record when model finished

  model_finish <- Sys.time()
  print(noquote(paste("Time model finished: ", format(Sys.time(), "%a %d %b %Y %X"), sep = "")))

  print(noquote(paste("Model took ", round(difftime(model_finish, model_start, units = c("mins")), 0),
                      " minute(s) to simulate ", Patient_Number, " Patients", sep = "")))

  stopCluster(cl)

}

Run_Sim_Para()

Answer 1

我通过以下方式解决了这个问题；

1. 创建一个单独的函数，将内部循环编译成一个列表
2. 然后将此列表函数传递给foreach 函数
3. assign 函数用于将 foreach 循环的输出传递给全局环境中名为“Patient_Data”的对象，而不是使用可变状态来更新全局环境中的现有列表

下面的示例代码。希望这对可能遇到类似问题的其他人有所帮助。

library(tidyverse)
library(foreach)
library(doSNOW)

# Input
rm(list = ls())
Patient_Number <- 1e4

#### Create a listing function which will be ran through "foreach" ####

list_func <- function(Patient_ID_Code){

  This_Patient <- list(
    Patient_ID = 0,
    Intervention = 0,
    Comparator = 0
  )

  This_Patient_Draw_Int <- rnorm(1, mean = 50, sd = 7.8) # These normally would be more complex functions generating a data frame for each patient
  This_Patient_Draw_Comp <- rnorm(1, mean = 44, sd = 10) # These normally would be more complex functions generating a data frame for each patient

  This_Patient$Patient_ID <- Patient_ID_Code
  This_Patient$Intervention <- This_Patient_Draw_Int
  This_Patient$Comparator <- This_Patient_Draw_Comp

  return(This_Patient)


}


Run_Sim_Para <- function(){

  cl <- parallel::makeCluster(parallel::detectCores() - 1)
  registerDoSNOW(cl)

  # record the time the model started

  model_start <- Sys.time()

  print(noquote(paste("Time model started: ", format(Sys.time(), "%a %d %b %Y %X"), sep = "")))

  #### Simulate Patient's BCVA scores ####

  # create progress bar

  print(noquote("Simulating Patients:"))

  pb <- txtProgressBar(min = 0, max = Patient_Number, style = 3)
  progress <- function(n) setTxtProgressBar(pb, n)
  opts <- list(progress = progress)

  test <- foreach(i = 1:Patient_Number, .packages = c("tidyverse"),
                  .export = ls(.GlobalEnv),
                  .options.snow = opts) %dopar% {

                    list_func(i)

                  }

  # stop the progress bar

  close(pb)

  # record when model finished

  model_finish <- Sys.time()
  print(noquote(paste("Time model finished: ", format(Sys.time(), "%a %d %b %Y %X"), sep = "")))

  print(noquote(paste("Model took ", round(difftime(model_finish, model_start, units = c("mins")), 0),
                      " minute(s) to simulate ", Patient_Number, " Patients", sep = "")))

  stopCluster(cl)

  assign("Patient_Data", test, envir = .GlobalEnv)

}

Run_Sim_Para()