Search code examples
rr-environment

Define environment only accessible from a given function


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

Solution

  • 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"