1

I have the following function designed to print a progress bar outside of loops, it works well but creates an environment object in the global environment.

I'm not so comfortable with environments but I think I could set up this environment to be only accessible from my function, and leave the global environment alone, how could I do this ?

I marked the line where the environment is created.

Please run full code to see what the function is doing.

#' A progress bar to use outside of loops.
#' 
#' Useful when loading data, sourcing files etc .
#' Prints '+' characters like a regular progress bar,
#' however it saves times between calls and returns a suggestion
#' of new steps once value 100 is reached
#' b(0) initiates the time value in a dedicated environment
#' b(100) (or incremental call reaching 100) advises depending on
#' 3rd argument and removes the variable and environment
#' @param n status or increment, from 0 to 100
#' @param incremental by default we give absolute progress values,
#' set to TRUE to give incremental values
#' @param advise relevant for last step only, give advises better
#' n values for the next time you run your script on similar data
#' @example
#' {
#'   b(0);Sys.sleep(2)
#'   b();Sys.sleep(1)
#'   b();Sys.sleep(1)
#'   b(100,a=T)
#'   b(00);Sys.sleep(2)
#'   b(50);Sys.sleep(1)
#'   b(75);Sys.sleep(1)
#'   b(100)
#' }
b <- function(n,incremental=FALSE,advise=F){
  # default b() will increment 1 
  if(missing(n)) {
    n <- 1
    incremental = TRUE
  }

  # initialize environment and value, or update time vector
  if(n == 0) {
    assign(".adhoc_pb_env",new.env(),envir=globalenv()) # <- THIS IS WHAT I DON'T LIKE
    .adhoc_pb_env[["t"]] <- Sys.time()
    .adhoc_pb_env[["n"]] <- 0
  } else
  {
    .adhoc_pb_env[["t"]] <- c(.adhoc_pb_env[["t"]],Sys.time())
  }

  # update n and print line
  if(incremental) n <- .adhoc_pb_env[["n"]] + n
  .adhoc_pb_env[["n"]] <- n
  cat("\r    |",rep("+",n),rep(" ",100-n),"| ",n, "%",sep="")

  # complete line, advise if requested, remove values and environment
  if(.adhoc_pb_env[["n"]] >= 100) {
    cat(" Task completed!\n")
    if(advise){
      times <- cumsum(as.numeric(diff(.adhoc_pb_env[["t"]])))
      rec <- c(0,round(100 * times / tail(times,1)))
      cat("Recommended split:",rec,"(incremental:",c(0,diff(rec)),")\n")
    }
    rm(list=ls(envir = .adhoc_pb_env),envir = .adhoc_pb_env)
    rm(.adhoc_pb_env,envir = globalenv())
  }
}

{
  b(0);Sys.sleep(2)
  b();Sys.sleep(1)
  b();Sys.sleep(1)
  b(100,a=T)
  b(00);Sys.sleep(2)
  b(50);Sys.sleep(1)
  b(75);Sys.sleep(1)
  b(100)
}

A summary of my issue:

b(0)
exists(".adhoc_pb_env") # [1] TRUE <- this is problematic
moodymudskipper
  • 46,417
  • 11
  • 121
  • 167
  • This doesn't create an environment enclosed by the global environment. Check the parameters of `new.env` in the documentation. – Roland Oct 19 '17 at 09:31
  • @Roland right, `parent = parent.frame()`, my issue however is not about the position of this environment in the stack, as it's always accessed explicitely, but that the object `.adhoc_pb_env` is polluting my global environment during the timespan of the progress bar. Apologies for my sloppy formulation. – moodymudskipper Oct 19 '17 at 09:41

1 Answers1

2

Simply build a closure:

a <- function() {
  n1 <- NULL; t1<- NULL
  function(n,incremental=FALSE,advise=F){
    # default b() will increment 1 
    if(missing(n)) {
      n <- 1
      incremental = TRUE
    }

    # initialize environment and value, or update time vector
    if(n == 0) {
      t1 <<- Sys.time()
      n1 <<- 0
    } else
    {
      t1 <<- c(t1,Sys.time())
    }

    # update n and print line
    if(incremental) n <- n1 + n
    n1 <- n
    cat("\r    |",rep("+",n),rep(" ",100-n),"| ",n, "%",sep="")

    # complete line, advise if requested, remove values and environment
    if(n1 >= 100) {
      cat(" Task completed!\n")
      if(advise){
        times <- cumsum(as.numeric(diff(t1)))
        rec <- c(0,round(100 * times / tail(times,1)))
        cat("Recommended split:",rec,"(incremental:",c(0,diff(rec)),")\n")
      }
      n1 <<- NULL; t1 <<- NULL
    }
  }
}

b <- a()

{
  b(0);Sys.sleep(2)
  b();Sys.sleep(1)
  b();Sys.sleep(1)
  b(100,a=T)
  b(00);Sys.sleep(2)
  b(50);Sys.sleep(1)
  b(75);Sys.sleep(1)
  b(100)
}

ls(globalenv(), all.names = TRUE)
#[1] ".Random.seed" "a"            "b"
Roland
  • 127,288
  • 10
  • 191
  • 288