Question

下面是我的问题的MWE：我已经使用引导程序（通过引导程序包中的引导功能）为某些功能编写了进度条。

只要我不使用并行处理（res_1core下面），这就可以正常工作。如果我想通过设置parallel = "multicore"和ncpus = 2来使用并行处理，则进度条显示不正确（res_2core下方）。

library(boot)

rsq <- function(formula, data, R, parallel = c("no", "multicore", "snow"), ncpus = 1) {
  env <- environment()
  counter <- 0
  progbar <- txtProgressBar(min = 0, max = R, style = 3)
  bootfun <- function(formula, data, indices) {
    d <- data[indices,]
    fit <- lm(formula, data = d)
    curVal <- get("counter", envir = env)
    assign("counter", curVal + 1, envir = env)
    setTxtProgressBar(get("progbar", envir = env), curVal + 1)
    return(summary(fit)$r.square)
  }
  res <- boot(data = data, statistic = bootfun, R = R, formula = formula, parallel = parallel, ncpus = ncpus)
  return(res)
}

res_1core <- rsq(mpg ~ wt + disp, data = mtcars, R = 1000)
res_2core <- rsq(mpg ~ wt + disp, data = mtcars, R = 1000, parallel = "multicore", ncpus = 2)

我已经读过这与启动函数调用lapply进行单核处理和mclapply进行多核处理有关。有谁知道一个简单的解决方法来处理这个？我的意思是，我想在考虑所有并行流程的情况下显示进度。

更新

感谢KarolisKoncevičius的输入，我找到了一种解决方法（只需使用下面更新的rsq函数）：

rsq <- function(formula, data, R, parallel = c("no", "multicore", "snow"), ncpus = 1) {
  bootfun <- function(formula, data, indices) {
    d <- data[indices,]
    fit <- lm(formula, data = d)
    return(summary(fit)$r.square)
  }

  env <- environment()
  counter <- 0
  progbar <- txtProgressBar(min = 0, max = R, style = 3)
  flush.console()

  intfun <- function(formula, data, indices) {
    curVal <- get("counter", envir = env) + ncpus
    assign("counter", curVal, envir = env)
    setTxtProgressBar(get("progbar", envir = env), curVal)
    bootfun(formula, data, indices)
  }
  res <- boot(data = data, statistic = intfun, R = R, formula = formula, parallel = parallel, ncpus = ncpus)
  return(res)
}

不幸的是，当我从终端运行R时，这仅适用于多核处理。任何想法如何修补它，以便它也可以在R控制台或Rstudio中正确显示？

Answer 1

不完全是您订购的，但可能会有帮助。

要启动的简单统计功能：

library(boot)

bootfun <- function(formula, data, indices) {
    d <- data[indices,]
    fit <- lm(formula, data=d)
    summary(fit)$r.square
}

显示进度的高阶函数：

progressReporter <- function(total, nBars=100, f, ...) {
    count <- 1
    step <- ceiling(total/nBars)
    cat(paste(rep("|", nBars), collapse=""), "\r")
    flush.console()
    function(...) {
        if (count %% step==0) {
            cat(".")
        }
        count <<- count + 1
        f(...)
    }
}

现在这个功能正在作弊 - 它会在迭代的每个“步骤”中显示进度。如果你有1000次迭代，使用两个核心并每10次迭代打印 - 它将完成这项工作。核心不共享状态，但每个核心运行计数器最多500个，该函数将响应两个计数器。

另一方面，如果你进行1000次迭代，运行10个核心并每200个报告一次 - 该功能将保持静默，因为所有核心都将计为100个。没有人会达到200 - 没有进度条。希望你明白这个主意。我认为在大多数情况下应该没问题。

尝试一下：

res_1core <- boot(formula="mpg ~ wt + disp", data=mtcars, R=1000, statistic=progressReporter(1000, nBars=100, f=bootfun))
res_2core <- boot(formula="mpg ~ wt + disp", data=mtcars, R=1000, statistic=progressReporter(1000, nBars=100, f=bootfun), parallel="multicore", ncpus=2)

txtProgressBar用于并行引导程序无法正常显示

1 个答案: