将R脚本改写为单一R函数时ar参数缺失报错如何解决

原始需求 #

将ARIMA模拟匹配的流程封装为单个可自定义参数的函数，原始代码如下：

FUN <- function(i) {
  set.seed(i)
  ar1 <- arima.sim(n = 10, model = list(ar = 0.7, order = c(1, 0, 0)), sd = 1)
  ar2 <- auto.arima(ar1, ic = "aicc")
  (cf <- ar2$coef)
  if (length(cf) == 0) {
    rep(NA, 2)
  }
  else if (all(grepl(c("ar1|intercept"), names(cf))) &
           substr(cf["ar1"], 1, 3) %in% "0.7") {
    c(cf, seed = I)
  }
  else {
    rep(NA, 2)
  }
}

seedv <- 1:1e2

library(parallel)
cl <- makeCluster(detectCores() - 1 + 1)
clusterExport(cl, c("FUN"), envir = environment())
clusterEvalQ(cl, suppressPackageStartupMessages(library(forecast)))

res <- parLapply(cl, seedv, "FUN")

(res1 <- res[!sapply(res, anyNA)])

stopCluster(cl)

library(tibble)
res2 <- tibble(Reduce(function(...) merge(..., all = T), lapply(res1, function(x) as.data.frame(t(x)))))

res2[order(res2$seed), ]

res2 <- Reduce(function(...) merge(..., all = T), lapply(res1, function(x) as.data.frame(t(x))))
res2[order(res2$seed), ]

原始代码运行输出：

#        ar1 seed
#1 0.7468994   51

改写后报错信息 #

自行改写的代码运行抛出如下错误：

#Error in checkForRemoteErrors(val) : 
#3 nodes produced errors; first error: argument "ar" is missing, with no default 

存在的问题 #

• 并行调用参数传递缺失：parLapply仅传入了种子序列seedv，没有将n、ar、arr这些自定义参数传递给子节点运行的内部函数，导致子进程找不到对应参数
• 冗余参数定义：外层函数定义了不需要的入参i、FUN2，前者是内部遍历的种子值，后者是内部定义的子函数，均无需外部传入
• 多处语法错误：
  • arima.sim调用中sd参数漏了赋值为1
  • 匹配AR系数时把变量arr加了引号变成固定字符串"arr"，永远无法匹配到数值结果
  • 返回结果时seed = I误用大写I，应该用当前迭代的种子值小写i
• 冗余代码：最后结果合并排序逻辑重复写了两次，多余无意义

修正后的完整代码 #

FUN1 <- function(n=10, ar=0.7, arr=0.7, R=100, sd=1) {
  # 内部运算子函数
  FUN2 <- function(i, n, ar, arr, sd) {
    set.seed(i)
    ar1 <- arima.sim(n = n, model = list(ar=ar, order = c(1, 0, 0)), sd = sd)
    ar2 <- auto.arima(ar1, ic = "aicc")
    cf <- ar2$coef
    if (length(cf) == 0) {
      return(rep(NA, 2))
    }
    else if (all(grepl(c("ar1|intercept"), names(cf))) &
             substr(cf["ar1"], 1, 3) %in% as.character(arr)) {
      return(c(cf, seed = i))
    }
    else {
      return(rep(NA, 2))
    }
  }

  seedv <- 1:R

  library(parallel)
  # 预留1个核心给系统，避免占满CPU
  cl <- makeCluster(detectCores() - 1)
  # 导出所有需要用到的变量到子节点
  clusterExport(cl, c("FUN2", "n", "ar", "arr", "sd"), envir = environment())
  clusterEvalQ(cl, suppressPackageStartupMessages(library(forecast)))

  # 调用时传入所有额外参数给FUN2
  res <- parLapply(cl, seedv, FUN2, n = n, ar = ar, arr = arr, sd = sd)
  res1 <- res[!sapply(res, anyNA)]
  stopCluster(cl)

  # 空结果兼容处理
  if(length(res1) == 0) {
    message("没有匹配到符合条件的结果")
    return(invisible(NULL))
  }
  
  library(tibble)
  res2 <- tibble(Reduce(function(...) merge(..., all = TRUE), lapply(res1, function(x) as.data.frame(t(x)))))
  res2 <- res2[order(res2$seed), ]
  return(res2)
}

调用示例 #

result <- FUN1(n=10, ar=0.7, arr=0.7, R=100)
print(result)

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