Question

我有以下功能用于在循环外打印进度条，它可以很好地工作但在全局环境中创建一个环境对象。

我对环境不太满意，但我认为我可以将此环境设置为只能通过我的功能访问，并且只留下全球环境，我该怎么做？

我标记了创建环境的行。

请运行完整代码以查看该功能正在执行的操作。

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

我的问题摘要：

b(0)
exists(".adhoc_pb_env") # [1] TRUE <- this is problematic

Answer 1

简单地构建一个闭包：

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"

定义仅可从给定函数访问的环境

1 个答案: