Wrapper to FOR loops with progress bar

前端 未结 8 670
走了就别回头了
走了就别回头了 2021-01-31 19:57

I like to use a progress bar while running slow for loops. This could be done easily with several helpers, but I do like the tkProgressBar from tcl

相关标签:
8条回答
  • 2021-01-31 20:14

    The problem is that the for-loop in R is treated special. A normal function is not allowed to look like that. Some small tweaks can make it loop pretty close though. And as @Aaron mentioned, the foreach package's %dopar% paradigm seems like the best fit. Here's my version of how it could work:

    `%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")
    }
    

    As you can see, you have to type x = 1:10 instead of x in 1:10, and the infix operator %<whatever>% is needed to get hold of the looping construct and the loop body. I currently don't do any error checking (to avoid muddling the code). You should check the name of the function ("foreach"), the number of arguments to it (1) and that you actually get a valid loop variable ("x") and not an empty string.

    0 讨论(0)
  • 2021-01-31 20:16

    Given the other answers supplied, I suspect that it is impossible tough to do in exactly the way you specify.

    However, I believe there is a way of getting very close, if you use the plyr package creatively. The trick is to use l_ply which takes a list as input and creates no output.

    The only real differences between this solution and your specification is that in a for loop you can directly modify variables in the same environment. Using l_ply you need to send a function, so you will have to be more careful if you want to modify stuff in the parent environment.

    Try the following:

    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
    

    This creates a progress bar and modifies the value of a in the global environment.


    EDIT.

    For the avoidance of doubt: The argument .fun will always be a function with a single argument, e.g. .fun=function(i){...}.

    For example:

    for(i in 1:10){expr} is equivalent to forp(1:10, function(i){expr})

    In other words:

    • i is the looping parameter of the loop
    • .fun is a function with a single argument i
    0 讨论(0)
  • 2021-01-31 20:18

    R's syntax doesn't let you do exactly what you want, ie:

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

    But what you can do is create some kind of iterator object and loop using while():

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

    Now you have the problem of what m is and how you make nextStep(m) have side effects on m in order to make it return FALSE at the end of your loop. I've written simple iterators that do this, as well as MCMC iterators that let you define and test for a burnin and thinning period within your loop.

    Recently at the R User conference I saw someone define a 'do' function that then worked as an operator, something like:

    do(100) %*% foo()
    

    but I'm not sure that was the exact syntax and I'm not sure how to implement it or who it was put that up... Perhaps someone else can remember!

    0 讨论(0)
  • 2021-01-31 20:20

    Thanks for everyone for your kind answers! As none of those fit my wacky needs, I started to steal some pieces of the given answers and made up a quite customized version:

    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)
    }
    

    This is quite lengthy for a simple function like this, but depends only on base (anf of course: tcltk) and has some nice features:

    • can be used on expressions, not just functions,
    • you do not have to use <<- in your expressions to update global environment, <- are replaced to <<- in the given expr. Well,this might be annoying for someone.
    • can be used with non-numeric indexes (see below). That is why the code become so long :)

    Usage is similar to for except for you do not have to specify the i in part and you have to use i as index in the loop. Other drawback is that I did not find a way to grab the {...} part specified after a function, so this must be included in the parameters.

    Example #1: Basic use

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

    Try it to see the neat progress bar on your computer! :)

    Example #2: Looping through some characters

    > m <- 0
    > forp (names(mtcars), {
    +   m <- m + mean(mtcars[,i])
    + })
    > m
    [1] 435.69
    
    0 讨论(0)
  • 2021-01-31 20:25

    My solution is very similar to Andrie's except it uses base R, and I second his comments on the need to wrap what you want to do in a function and the subsequent need to use <<- to modify stuff in a higher environment.

    Here's a function that does nothing, and does it slowly:

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

    Here's my forp function. Note that regardless of what we're actually looping over, it instead loops over the sequence 1:n instead and get the right term of what we actually want within the loop. plyr does this automatically.

    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)
    }
    

    And here's how both for and forp might be used, if all we want to do is call myfun:

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

    And here's how they might be used if we want to modify something along the way.

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

    For both versions the result is

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

    EDIT: After seeing your (daroczig's) solution, I have another idea that might not be quite so unwieldy, which is to evaluate the expression in the parent frame. This makes it easier to allow for values other than i (now specified with the index argument), though as of right now I don't think it handles a function as the expression, though just to drop in instead a for loop that shouldn't matter.

    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)
    }
    

    The code to run my example from above would be

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

    and the result is the same.

    ANOTHER EDIT, based on the additional information in your bounty offer:

    The syntax forX(1:1000) %doX$ { expression } is possible; that's what the foreach package does. I'm too lazy right now to build it off of your solution, but building off mine, it could look like this:

    `%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
    }
    

    Then the use syntax is this, and the result is the same as above.

    out <- "result:"
    forX(xi=LETTERS[1:5]) %doX% {
      out <- paste(out, myfun(xi, "hi"))
    }
    out
    
    0 讨论(0)
  • 2021-01-31 20:28

    What you're hoping for, I think would be something that looks like

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

    And yep, the problem is that "for" is not a function, or at least not one whose "body" is accessible. You could, I suppose, create a "forp" function that takes as arguments 1) a string to be turned into the loop counter, e.g., " ( i in seq(1,101,5) )" , and 2) the body of your intended loop, e.g., y[i]<- foo[i]^2 ; points(foo[i],y[i], and then jump thru some getcallparse magic to execute the actual for loop. Then , in pseudocode (not close to actual R code, but I think you see what should happen)

    forp<-function(indexer,loopbody) { 
    

    pseudoparse( c("for (", indexer, ") {" ,loopbody,"}") }

    0 讨论(0)
提交回复
热议问题