带有进度条的 FOR 循环包装器
Posted
技术标签:
【中文标题】带有进度条的 FOR 循环包装器【英文标题】：Wrapper to FOR loops with progress bar 【发布时间】：2011-11-13 01:20:15 【问题描述】：我喜欢在运行缓慢的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)
我想设置一个小函数来存储在我的 .Rprofile 中，命名为 forp（如：for loop with progressbar），像 for 一样调用，但使用 auto添加了进度条 - 但不幸的是不知道如何实现和获取循环函数的 expr 部分。我对do.call 进行了一些实验，但没有成功:(
虚构的工作示例（其作用类似于 for 循环，但会创建 TkProgressBar 并在每次迭代中自动更新它）：
forp (i in 1:10)
#do something
UPDATE：我认为问题的核心是如何编写一个函数，它不仅在函数后面的括号中有参数（如：foo(bar)），而且可以处理@987654333 @ 在右括号后指定，例如：foo(bar) expr。
BOUNTY OFFER：将转到任何可以修改 my suggested function 以像基本 for 循环的语法一样工作的答案。例如。而不是
> forp(1:1000,
+ a<-i
+ )
> a
[1] 1000
可以这样称呼：
> forp(1:1000)
+ a<-i
+
> a
[1] 1000
再次澄清任务：我们如何获取函数调用的 expression 部分？恐怕这是不可能的，但会为专业人士留下几天的赏金:)
【问题讨论】：
我们能否在forp 和表达式之间添加一些内容，例如forp(1:1000) %do% expression ？如果是这样，它应该类似于foreach 包的作用，甚至可以直接使用。我不认为你可以不添加它，但愿意被纠正。
感谢@Aaron 的评论。我希望可以有某种解决方案，而无需对语法进行额外的调整。如果没有，那么下面的工作功能无需任何修改就可以了。
我们会看看是否有人提出了一种无需修改的方法；与此同时，我确实编写了我的上述建议，至少只需要在循环顶部进行修改（即最后没有额外的)）。
这很酷@Aaron，谢谢！如果即使是很小的修改也没有解决方案，那么赏金将归您所有:)
您正在尝试修改语言。我会非常小心...您可能会忘记很多事情（例如中断/继续语句等），并为未来的神秘错误做好准备。小心点。
【参考方案1】：
如果您使用plyr 系列命令而不是 for 循环（如果可能的话，这通常是一个好主意），您可以获得整个进度条系统的额外奖励。
R.utils也内置了一些进度条，还有instructions for using them in for loops。
【讨论】：
感谢您的回答：plyr 在大多数情况下都是一个非常棒的工具，但有时我肯定需要for 循环（具有复杂的结构，其中数据分布在多个数据集中）。不幸的是，链接的资源只是显示了一个例子，就像我在我的问题中输入的那样，所以只有几种手动向for 循环添加进度条的方法，但没有关于我所追求的自动进度条的想法（例如forp函数）。【参考方案2】：
R 的语法不能让你做你想做的事，即：
forp (i in 1:10)
#do something
但你可以做的是创建某种迭代器对象并使用 while() 循环：
while(nextStep(m))sleep.milli(20)
现在你的问题是m 是什么，以及如何使nextStep(m) 对m 产生副作用，以使其在循环结束时返回FALSE。我编写了执行此操作的简单迭代器，以及允许您在循环中定义和测试老化和细化期的 MCMC 迭代器。
最近在 R 用户会议上，我看到有人定义了一个 'do' 函数，然后用作运算符，例如：
do(100) %*% foo()
但我不确定那是确切的语法，我不确定如何实现它或它是谁提出的......也许其他人可以记得！
【讨论】：
后一个示例看起来类似于 foreach 包中的foreach 语法。
也谢谢@Spacedman！我现在不确定您的建议如何帮助我构建forp 函数，但会努力赶上:) 会报告。【参考方案3】：
你所希望的，我想应该是这样的
body(for)<- as.call(c(as.name(''),expression([your_updatebar], body(for))))
是的，问题在于“for”不是一个函数，或者至少不是一个“body”可访问的函数。我想，您可以创建一个“forp”函数，该函数将 1) 一个要转换为循环计数器的字符串作为参数，例如 " ( i in seq(1,101,5) )" 和 2) 预期循环的主体，例如 y[i]<- foo[i]^2 ; points(foo[i],y[i]，然后跳过一些 getcallparse 魔术来执行实际的 for 循环。
然后，在伪代码中（不接近实际的 R 代码，但我想你知道应该发生什么）
forp<-function(indexer,loopbody)
pseudoparse( c("for (", indexer, ") " ,loopbody,"")
【讨论】：
【参考方案4】：鉴于提供的其他答案，我怀疑完全按照您指定的方式进行操作是不可能。
但是，如果您创造性地使用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
【讨论】：
这看起来确实是我的伪代码答案的一个不错的版本。但是：如果你想运行一个包含多个变量的现有函数会发生什么？据我所知，lply(i, myfunc(x,y)) 不会起作用。
@CarlWitthoft 没关系，不是吗？因为在 for 循环中只能有一个变量。任何其他变量都在函数体内简单地引用...由于调用堆栈的作用域，它可以工作 - 与 for 循环完全相同。
安德烈，我想我明白你的意思了。 i <- c(1,3,5,6,7,8,9); forp(i,myfunc(x=i,y)) 是它的工作方式。
非常感谢，这是一个巧妙的解决方案，但有一些妥协（+1）。不幸的是它离我所追求的有点远，但我的目标似乎无法实现。
@CarlWitthoft 我不确定这是否可行。我已经编辑了我的答案以提供更多细节。 for(i in seq(1, 9, by=2)expr 的等价物是 forp(i=seq(1, 9, by=2), .fun=function(i)expr)。换句话说，.fun 将始终是一个只有一个参数的函数。【参考方案5】：
我的解决方案与 Andrie 的解决方案非常相似，只是它使用基础 R，我支持他的 cmets 需要将您想要做的事情包装在一个函数中，并且随后需要使用 <<- 在更高的环境中修改内容.
这是一个什么都不做的函数，而且做的很慢：
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
【讨论】：
谢谢 Aaron，这也很棒 (+1)。不完全符合我的要求，但很接近:) 再次感谢 Aaron，特别是更新的脚本。正如我之前写的，如果我们找不到“完美”的解决方案，那么应该将赏金奖励给你。谢谢！【参考方案6】：感谢大家的热心回答！由于这些都不符合我古怪的需求，我开始窃取一些给定的答案并制作了一个非常定制的版本：
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）并且有一些不错的特性：
可用于表达式，而不仅仅是函数， 您不必在表达式中使用<<- 来更新全局环境，<- 在给定的表达式中被替换为<<-。好吧，这对某人来说可能很烦人。
可以与非数字索引一起使用（见下文）。这就是代码变得如此之长的原因:)
用法类似于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
【讨论】：
请注意，a <<- b 将被替换为 `a
确实如此 :) 感谢您指出@Carl Witthoft！我已经根据这个问题更新了我的函数，认为由于这个修改，编写 forp 函数的表达式部分将要求用户使用正确格式化的语法（在 <- 之前和之后留一个空格）。【参考方案7】：
问题在于 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") 而不是一个空字符串。
【讨论】：
如果你选择直接使用foreach，我建议也使用foreach包中的迭代函数iter；类似于foreach:::doSEQ。
谢谢汤米，这也很酷。因为@Aaron 更快，尤其是%doX% 比%doprogress% 短，所以赏金归他：) 我只能给你点赞。【参考方案8】：
我在此提出两个使用标准 for 语法的解决方案，两者都使用来自 Gábor Csárdi 和 Rich FitzJohn 的出色包 progress
for 函数以环绕base::for 并支持进度条。
2) 我们可以定义未使用的for<-，并使用语法pb -> for(it in seq) exp 环绕base::for，其中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")
【讨论】：
以上是关于带有进度条的 FOR 循环包装器的主要内容，如果未能解决你的问题，请参考以下文章
带有进度条的 jQuery ajax 上传 - 没有 flash