R/functions.R

In wilcoxa/frequencies: Easy Frequency Tables

round2 <- function(x, n) {
  # get rid of floating point error
  x <- round(x, 10)
  posneg = sign(x)
  z <- abs(x)*10^n
  z <- z + 0.5
  z <- trunc(z)
  z <- z/10^n
  z*posneg
}

#--- keeps decimal places - does not truncate
dec_dig <- function(x, n) {
  x <- round2(x, n)
  formatC(x, format = "f", digits = n)
}

lapply_pb <- function(X, FUN, ...)
{
  env <- environment()
  pb_Total <- length(X)
  counter <- 0
  pb <- txtProgressBar(min = 0, max = pb_Total, style = 3)

  # wrapper around FUN
  wrapper <- function(...){
    curVal <- get("counter", envir = env)
    assign("counter", curVal +1 ,envir=env)
    setTxtProgressBar(get("pb", envir=env), curVal +1)
    FUN(...)
  }
  res <- lapply(X, wrapper, ...)
  close(pb)
  res
}