应用功能的进度条异常长

Question

我有一个函数要应用于大型数值向量：

numbers <- 1:100000

prime <- function(n){
  if(sum(n/1:n==n%/%1:n)==2){TRUE}
  else{FALSE}
}

results <- lapply(numbers, prime)

这需要 ~90 秒 才能完成：

> microbenchmark::microbenchmark(results <- lapply(numbers, prime), times = 1)
Unit: seconds
                                      expr      min       lq     mean   median       uq      max neval
        results <- lapply(numbers, prime)  89.75836 89.75836 89.75836 89.75836 89.75836 89.75836     1

我想添加一个进度条以查看还剩多少时间。但是当我尝试使用 purrr::walk 从 progress 包中实施一个时，它说预计完成时间是 2 小时 ！我从包的 Github.

的“purrr 迭代器”部分获得了语法

> pb <- progress::progress_bar$new(format = "computing [:bar] :percent time left: :eta", total = 100, show_after = 0)
> purrr::walk(1:100, ~{pb$tick();results <<- lapply(numbers, prime)})
computing [====>-----------------------------------------------------------------------------]   4% time left:  2h

我找到了另一种方法来获得我想要的东西，即使用带有 pbapply::pblapply 的 timer 选项，但我想知道为什么 progress 包中的方法无法正常工作。

Answer 1

看起来 walk 是运行相同的代码 100 次。我认为这 100 步中的每一步都会再次产生 results2。

下面的not_purrr是我认为在循环之前设置100个断点的方法

numbers <- 1:1000
microbenchmark('original'={
  results <- lapply(numbers, prime)
}, 
'not_purrr'={
  checkpoints <- ceiling(seq(min(numbers), max(numbers), length.out = 100))
  pb <- progress::progress_bar$new(format = "computing [:bar] :percent time left: :eta", total = 100, show_after = 0)
  foo <- lapply(numbers, function(x){
    if(x %in% checkpoints) pb$tick()
    prime(x)
  })
},
'purrr'={
    pb <- progress::progress_bar$new(format = "computing [:bar] :percent time left: :eta", total = 100, show_after = 0)
    purrr::walk(1:100, ~{pb$tick();results2 <<- lapply(numbers, prime)})
}, times=5)

您可以使用 profvis 并添加一些 sys.sleep 来查看差距：

numbers <- 1:10000
profvis::profvis({
  pb <- progress::progress_bar$new(format = "computing [:bar] :percent time left: :eta", total = 10, show_after = 0)
  purrr::walk(1:10, ~{
    pb$tick();
    results2 <<- lapply(numbers, prime);
    Sys.sleep(0.1)
  })
})

应用功能的进度条异常长

Progress bar taking abnormally long with applied function

r

lapply

progress-bar