使用进度条的FOR循环包装器

Question

我喜欢在运行慢for循环时使用进度条。这可以通过几个助手轻松完成，但我确实喜欢 tcltk 包中的tkProgressBar。

一个小例子：

pb <- tkProgressBar(title = "Working hard:", min = 0, max = length(urls), width = 300)
for (i in 1:300) {
    # DO SOMETHING
    Sys.sleep(0.5)
    setTkProgressBar(pb, i, label=paste( round(i/length(urls)*100, 0), "% ready!"))
}
close(pb)

我想设置一个小函数存储在名为forp的 .Rprofile 中（如：for循环带进度条），调用就像{{1}但是使用自动添加进度条 - 但遗憾的是不知道如何实现和获取循环函数的for部分。我在expr进行了一些实验，但没有成功:(

虚构的工作示例（其行为类似于do.call循环但创建了for并在每次迭代中自动更新它：

TkProgressBar

UPDATE ：我认为问题的核心是如何编写一个函数，该函数不仅在函数后面的括号中有参数（如：forp (i in 1:10) { #do something } ），而且还可以处理在结束括号后指定foo(bar)，例如：expr。

---

BOUNTY OFFER ：会转到任何可以修改my suggested function的答案，就像基本foo(bar) expr循环的语法一样。例如。而不是

for

它可以被称为：

> forp(1:1000, {
+   a<-i
+ })
> a
[1] 1000

再次澄清任务：我们怎样才能抓住函数调用的> forp(1:1000) { + a<-i + } > a [1] 1000 部分？我担心这是不可能的，但会为专业人士留下几天的赏金：）

Answer 1

鉴于提供的其他答案，我怀疑不可能难以完全按照您指定的方式进行。

但是，如果您创造性地使用plyr包，我相信有一种非常接近的方法。诀窍是使用l_ply，它将列表作为输入并且不创建输出。

此解决方案与您的规范之间唯一真正的区别在于，在for循环中，您可以直接在同一环境中修改变量。使用l_ply您需要发送一个函数，因此如果您想在父环境中修改内容，则必须更加小心。

尝试以下方法：

library(plyr)
forp <- function(i, .fun){
  l_ply(i, .fun, .progress="tk")
}

a <- 0
forp(1:100, function(i){
  Sys.sleep(0.01)
  a<<-a+i
  })
print(a)
[1] 5050

这将创建一个进度条并修改全局环境中a的值。

---

修改

为避免疑问：参数.fun将始终是具有单个参数的函数，例如.fun=function(i){...}。

例如：

for(i in 1:10){expr}相当于forp(1:10, function(i){expr})

换句话说：

• i是循环的循环参数
• .fun是一个带有单个参数i
的函数

Answer 2

我的解决方案与Andrie的解决方案非常相似，只不过它使用了基础R，而我的第二个评论是关于需要在函数中包装你想要做什么以及随后需要使用<<-来修改更高的环境。

这是一个什么都不做的功能，并且慢慢地执行：

myfun <- function(x, text) {
  Sys.sleep(0.2)
  cat("running ",x, " with text of '", text, "'\n", sep="")
  x
}

这是我的forp功能。请注意，无论我们实际上是什么循环，它都会循环遍历序列1:n，并获得我们在循环中实际需要的正确术语。 plyr会自动执行此操作。

library(tcltk)
forp <- function(x, FUN, ...) {
  n <- length(x)
  pb <- tkProgressBar(title = "Working hard:", min = 0, max = n, width = 300)
  out <- vector("list", n)
  for (i in seq_len(n)) {
    out[[i]] <- FUN(x[i], ...)
    setTkProgressBar(pb, i, label=paste( round(i/n*100, 0), "% ready!"))
  }
  close(pb)
  invisible(out)
}

以下是for和forp的使用方式，如果我们要做的只是调用myfun：

x <- LETTERS[1:5]
for(xi in x) myfun(xi, "hi")
forp(x, myfun, text="hi")

如果我们想要修改某些东西，可以使用它们。

out <- "result:"
for(xi in x) {
  out <- paste(out, myfun(xi, "hi"))
}

out <- "result:"
forp(x, function(xi) {
    out <<- paste(out, myfun(xi, "hi"))
})

对于这两个版本，结果是

> out
[1] "result: A B C D E"

编辑：在看到你的（daroczig）解决方案后，我有另一个想法，可能不是那么笨重，这是评估父框架中的表达式。这样可以更容易地允许i以外的值（现在使用index参数指定），但是现在我不认为它将函数作为表达式处理，尽管只是为了删除而不是一个无关紧要的for循环。

forp2 <- function(index, x, expr) {
  expr <- substitute(expr)
  n <- length(x)
  pb <- tkProgressBar(title = "Working hard:", min = 0, max = n, width = 300)
  for (i in seq_len(n)) {
    assign(index, x[i], envir=parent.frame())
    eval(expr, envir=parent.frame())
    setTkProgressBar(pb, i, label=paste( round(i/n*100, 0), "% ready!"))
  }
  close(pb)
}

从上面运行我的示例的代码是

out <- "result:"
forp2("xi", LETTERS[1:5], {
    out <- paste(out, myfun(xi, "hi"))
})

，结果是一样的。

另一个编辑，根据您的赏金要约中的其他信息：

语法forX(1:1000) %doX$ { expression }是可能的;这就是foreach包的作用。我现在懒得把它从你的解决方案中解脱出来，但是建立起来，它可能看起来像这样：

`%doX%` <- function(index, expr) {
  x <- index[[1]]
  index <- names(index)
  expr <- substitute(expr)
  n <- length(x)
  pb <- tkProgressBar(title = "Working hard:", min = 0, max = n, width = 300)
  for (i in seq_len(n)) {
    assign(index, x[i], envir=parent.frame())
    eval(expr, envir=parent.frame())
    setTkProgressBar(pb, i, label=paste( round(i/n*100, 0), "% ready!"))
  }
  close(pb)
  invisible(out)
}

forX <- function(...) {
  a <- list(...)
  if(length(a)!=1) {
    stop("index must have only one element")
  }
  a
}

然后使用语法，结果与上面相同。

out <- "result:"
forX(xi=LETTERS[1:5]) %doX% {
  out <- paste(out, myfun(xi, "hi"))
}
out

Answer 3

如果您使用plyr系列命令而不是for循环（如果可能的话，通常是个好主意），您可以获得整个进度系统​​的额外奖励。

R.utils内置了一些进度条，并且存在instructions for using them in for loops。

Answer 4

你希望的是什么，我认为会是这样的事情

body(for)<- as.call(c(as.name('{'),expression([your_updatebar], body(for))))

是的，问题在于“for”不是一个功能，或者至少不是一个“身体”可以访问的功能。我想，你可以创建一个“forp”函数，它将参数作为参数1）转换为循环计数器的字符串，例如" ( i in seq(1,101,5) )"，以及2）预期循环的主体，例如{{ 1}}，然后跳过一些getcallparse魔法来执行实际的for循环。 然后，在伪代码中（不接近实际的R代码，但我认为你会看到应该发生什么）

y[i]<- foo[i]^2 ; points(foo[i],y[i]

forp<-function(indexer,loopbody) {

Answer 5

问题是R中的for循环被特殊处理。正常功能不允许看起来像那样。一些小的调整可以使它循环非常接近。正如@Aaron所提到的， foreach 包的%dopar%范例似乎是最合适的。这是我的工作原理：

`%doprogress%` <- function(forExpr, bodyExpr) {
   forExpr <- substitute(forExpr)
   bodyExpr <- substitute(bodyExpr)

   idxName <- names(forExpr)[[2]]
   vals <- eval(forExpr[[2]])

   e <- new.env(parent=parent.frame())

   pb <- tkProgressBar(title = "Working hard:", min = 0, max = length(vals), width = 300)
   for (i in seq_along(vals)) {
     e[[idxName]] <- vals[[i]]
     eval(bodyExpr, e)
     setTkProgressBar(pb, i, label=paste( round(i/length(vals)*100, 0), "% ready!"))
   }
}


# Example usage:

foreach(x = runif(10)) %doprogress% { 
  # do something
  if (x < 0.5) cat("small\n") else cat("big")
}

如您所见，您必须键入x = 1:10而不是x in 1:10，并且需要中缀运算符%<whatever>%来获取循环结构和循环体。我目前不做任何错误检查（以避免混淆代码）。您应该检查函数的名称（"foreach"），它的参数个数（1）以及您实际获得的有效循环变量（"x"）而不是空字符串

Answer 6

我在此提出两个使用标准for语法的解决方案，两个解决方案都使用来自GáborCsárdi和Rich FitzJohn的出色软件包progress

• 1）我们可以临时或局部覆盖for函数以包装base::for并支持进度条。
• 2）我们可以定义未使用的for<-，并使用语法base::for包装pb -> for(it in seq) {exp}，其中pb是使用progress::progress_bar$new()构建的进度条。

两个解决方案的行为均符合通话标准：

• 在上一次迭代中更改的值可用
• 发生错误时，修改后的变量将具有错误发生前的值

我打包了解决方案，并将在下面进行演示，然后通过代码

---

用法

#devtools::install_github("moodymudskipper/pbfor")
library(pbfor)

使用pb_for()

默认情况下，pb_for()将仅覆盖for函数一次。

pb_for()
for (i in 1:10) {
  # DO SOMETHING
  Sys.sleep(0.5)
}

使用progress::progress_bar$new()中的参数：

pb_for(format = "Working hard: [:bar] :percent :elapsed", 
       callback = function(x) message("Were'd done!"))
for (i in 1:10) {
  # DO SOMETHING
  Sys.sleep(0.5)
}

使用for<-

与标准for调用相比，唯一的限制是第一个参数必须存在且不能为NULL。

i <- NA 
progress_bar$new() -> for (i in 1:10) {
  # DO SOMETHING
  Sys.sleep(0.5)
}

我们可以定义一个自定义进度条，也可以在初始化脚本或R配置文件中方便地定义它。

pb <- progress_bar$new(format = "Working hard: [:bar] :percent :elapsed", 
       callback = function(x) ("Were'd done!"))
pb  -> for (i in 1:10) {
  # DO SOMETHING
  Sys.sleep(0.5)
}

对于嵌套进度条，我们可以使用以下技巧：

pbi <- progress_bar$new(format = "i: [:bar] :percent\n\n")
pbj <- progress_bar$new(format = "j: [:bar] :percent  ")
i <- NA
j <- NA
pbi  -> for (i in 1:10) {
  pbj  -> for (j in 1:10) {
    # DO SOMETHING
    Sys.sleep(0.1)
  }
}

请注意，由于运算符的优先级，调用for<-并从for调用语法中受益的唯一方法是使用从左到右箭头´->´。

---

它们如何工作

pb_for()

pb_for()在其父环境中创建一个for函数对象，然后创建新的for：

• 设置进度条
• 修改循环内容
• 在循环内容表达式的末尾添加一个`*pb*`$tick()
• 在干净的环境中将其反馈给base::`for`
• 在退出时将所有修改或创建的变量分配给父环境。
• 如果once为TRUE（默认设置），则删除自身

重写操作符通常很敏感，但是如果在函数中使用它，它会自行清除并且不会影响全局环境，因此我认为使用起来足够安全。

for<-

这种方法：

• 不会覆盖for
• 允许使用进度条模板
• 拥有一个可以说更直观的api

但是它有一些缺点：

• 它的第一个参数必须存在，所有赋值函数（fun<-）都是这种情况。
• not easily done with assignment functions确实找到了第一个参数的名称，这确实有些记忆力，这可能会降低性能，并且我不确定其健壮性100％
• 我们需要软件包 pryr

它的作用：

• 使用辅助函数查找第一个参数的名称
• 克隆进度条输入
• 对其进行编辑以解决循环的迭代次数（for<-的第二个参数的长度

此后，与上一节中针对pb_for()的描述类似。

---

代码

pb_for()

pb_for <-
  function(
    # all args of progress::progress_bar$new() except `total` which needs to be
    # infered from the 2nd argument of the `for` call, and `stream` which is
    # deprecated
    format = "[:bar] :percent",
    width = options("width")[[1]] - 2,
    complete = "=",
    incomplete = "-",
    current =">",
    callback = invisible, # doc doesn't give default but this seems to work ok
    clear = TRUE,
    show_after = .2,
    force = FALSE,
    # The only arg not forwarded to progress::progress_bar$new()
    # By default `for` will self detruct after being called
    once = TRUE) {

    # create the function that will replace `for`
    f <- function(it, seq, expr){
      # to avoid notes at CMD check
      `*pb*` <- IT <- SEQ <- EXPR <- NULL

      # forward all arguments to progress::progress_bar$new() and add
      # a `total` argument computed from `seq` argument
      pb <- progress::progress_bar$new(
        format = format, width = width, complete = complete,
        incomplete = incomplete, current = current,
        callback = callback,
        clear = clear, show_after = show_after, force = force,
        total = length(seq))

      # using on.exit allows us to self destruct `for` if relevant even if
      # the call fails.
      # It also allows us to send to the local environment the changed/created
      # variables in their last state, even if the call fails (like standard for)
      on.exit({
        vars <- setdiff(ls(env), c("*pb*"))
        list2env(mget(vars,envir = env), envir = parent.frame())
        if(once) rm(`for`,envir = parent.frame())
      })

      # we build a regular `for` loop call with an updated loop code including
      # progress bar.
      # it is executed in a dedicated environment and the progress bar is given
      # a name unlikely to conflict
      env <- new.env(parent = parent.frame())
      env$`*pb*` <-  pb
      eval(substitute(
        env = list(IT = substitute(it), SEQ = substitute(seq), EXPR = substitute(expr)),
        base::`for`(IT, SEQ,{
          EXPR
          `*pb*`$tick()
        })), envir = env)
    }
    # override `for` in the parent frame
    assign("for", value = f,envir = parent.frame())
  }

for<-（和fetch_name()）

`for<-` <-
  function(it, seq, expr, value){
    # to avoid notes at CMD check
    `*pb*` <- IT <- SEQ <- EXPR <- NULL
    # the symbol fed to `it` is unknown, R uses `*tmp*` for assignment functions
    # so we go get it by inspecting the memory addresses
    it_chr <- fetch_name(it)
    it_sym <-as.symbol(it_chr)

    #  complete the progress bar with the `total` parameter
    # we need to clone it because progress bars are environments and updated
    # by reference
    pb <- value$clone()
    pb$.__enclos_env__$private$total <- length(seq)

    # when the script ends, even with a bug, the values that have been changed
    # are written to the parent frame
    on.exit({
      vars <- setdiff(ls(env), c("*pb*"))
      list2env(mget(vars, env),envir = parent.frame())
    })

    # computations are operated in a separate environment so we don't pollute it
    # with it, seq, expr, value, we need the progress bar so we name it `*pb*`
    # unlikely to conflict by accident
    env <- new.env(parent = parent.frame())
    env$`*pb*` <-  pb
    eval(substitute(
      env =  list(IT = it_sym, SEQ = substitute(seq), EXPR = substitute(expr)),
      base::`for`(IT, SEQ,{
        EXPR
        `*pb*`$tick()
      })), envir = env)

    # because of the `fun<-` syntax we need to return the modified first argument
    invisible(get(it_chr,envir = env))
  }

助手：

fetch_name <- function(x,env = parent.frame(2)) {
  all_addresses       <- sapply(ls(env), address2, env)
  all_addresses       <- all_addresses[names(all_addresses) != "*tmp*"]
  all_addresses_short <- gsub("(^|<)[0x]*(.*?)(>|$)","\\2",all_addresses)

  x_address       <- tracemem(x)
  untracemem(x)
  x_address_short <- tolower(gsub("(^|<)[0x]*(.*?)(>|$)","\\2",x_address))

  ind    <- match(x_address_short, all_addresses_short)
  x_name <- names(all_addresses)[ind]
  x_name
}

address2 <- getFromNamespace("address2", "pryr")

Answer 7

R的语法不能让你完全按照自己的意愿行事，即：

forp (i in 1:10) {
    #do something
}

但你可以做的是使用while（）创建某种迭代器对象和循环：

while(nextStep(m)){sleep.milli(20)}

现在您遇到m是什么以及nextStep(m)如何对m产生副作用以使其在您的结尾处返回FALSE的问题环。我编写了这样做的简单迭代器，以及MCMC迭代器，它允许您定义和测试循环中的burnin和thinning周期。

最近在R用户大会上，我看到有人定义了一个'do'函数，然后作为运算符工作，如：

do(100) %*% foo()

但是我不确定这是不是确切的语法，我不确定如何实现它或者它是什么呢......也许其他人都记得了！

Answer 8

感谢大家的回答！由于这些都不符合我古怪的需求，我开始窃取一些给定的答案，并制作了一个非常定制的版本：

forp <- function(iis, .fun) {
    .fun <- paste(deparse(substitute(.fun)), collapse='\n')
    .fun <- gsub(' <- ', ' <<- ', .fun, fixed=TRUE)
    .fun <- paste(.fun, 'index.current <- 1 + index.current; setTkProgressBar(pb, index.current, label=paste( round(index.current/index.max*100, 0), "% ready!"))', sep='\n')
    ifelse(is.numeric(iis), index.max <- max(iis), index.max <- length(iis))
    index.current <- 1
    pb <- tkProgressBar(title = "Working hard:", min = 0, max = index.max, width = 300) 
    for (i in iis) eval(parse(text=paste(.fun)))
    close(pb)
}

这对于像这样的简单函数来说非常冗长，但仅取决于base（当然是anf：tcltk）并且有一些很好的特性：

• 可用于表达式，而不仅仅是函数，
• 您不必在表达式中使用<<-来更新全局环境，<-将替换为给定expr中的<<-。嗯，这对某人来说可能很烦人。
• 可以与非数字索引一起使用（见下文）。这就是代码变得如此之久的原因：）

用法类似于for，除非您不必指定i in部分，并且必须在循环中使用i作为索引。其他缺点是我没有找到一种方法来获取函数后指定的{...}部分，因此必须将其包含在参数中。

示例＃1：基本使用

> forp(1:1000, {
+   a<-i
+ })
> a
[1] 1000

尝试在计算机上查看整洁的进度条！ ：）

示例＃2：循环播放一些字符

> m <- 0
> forp (names(mtcars), {
+   m <- m + mean(mtcars[,i])
+ })
> m
[1] 435.69