Question

I’m running some some functions in R that sometimes take quite a long time to complete (anywhere from 10 minutes to 4 hours). Specifically, I am using a function (forward.lmer()) written by Rense Nieuwenhuis that can be found here. I’d like to know if there is any way for R to tell the % complete the operation is. Especially, when the operation has been running for over an hour, I’d like to know how close it is to completion.

Is there a generic function that will allow me to know the progress of any given function?
What I would ideally like to know is if there is a function like so:

percentComplete()
forward.lmer(inputs)

That will then tell me about how close to complete the function is?

The first thing I tried was using library(time) and doing the following:

time<-getTime()
function(inputs)
timeReport(time)

But this just tells me how long it took to complete the function upon completion. Is there a way to know how the function is progressing (percentage completed) as it is running?

I’d love to increase the efficiency of this function, in addition, but that is another question. Thanks all!

Answer 1

You can use a txtProgressBar to keep track of how far you’ve progressed through some process.

I’m not familiar enough with the function you reference to know exactly where it should go, but just from eyeballing it, it looks like it could spend a healthy portion of its time in the loop beginning with:

# Iteratively updating the model with addition of one block of variable(s)
# Also: extracting the loglikelihood of each estimated model
for(j in 1:length(blocks))

If you were to use:

pb <- txtProgressBar(style=3)
for(j in 1:length(blocks))
  setTxtProgressBar(pb, j/length(blocks))
  ...
}
close(pb)

That may give you what you’re looking for. Note that some displays work better with certain style progress bars than others. You may have more luck trying different styles when creating your progressbar if the output looks funny to you using the code I posted.

There is no way for R to know in advance how long a generic function will take to complete, so there’s not a generic answer here. Here’s the function you posted with progress bars in each loop.

forward.lmer <- function(
  start.model, blocks,
  max.iter=1, sig.level=FALSE,
  zt=FALSE, print.log=TRUE)
  {

    # forward.lmer: a function for stepwise regression using lmer mixed effects models
    # Author: Rense Nieuwenhuis

    # Initialysing internal variables
    log.step <- 0
    log.LL <- log.p <- log.block <- zt.temp <- log.zt <- NA
    model.basis <- start.model

    # Maximum number of iterations cannot exceed number of blocks
    if (max.iter > length(blocks)) max.iter <- length(blocks)
      pb <- txtProgressBar(style=3)
      # Setting up the outer loop
      for(i in 1:max.iter)
      {
        #each iteration, update the progress bar.
        setTxtProgressBar(pb, i/max.iter)
        models <- list()

        # Iteratively updating the model with addition of one block of variable(s)
        # Also: extracting the loglikelihood of each estimated model
        for(j in 1:length(blocks))
        {
          models[[j]] <- update(model.basis, as.formula(paste(". ~ . + ", blocks[j])))
        }

        LL <- unlist(lapply(models, logLik))

        # Ordering the models based on their loglikelihood.
        # Additional selection criteria apply
        for (j in order(LL, decreasing=TRUE))
        {

          ##############
          ############## Selection based on ANOVA-test
          ##############

          if(sig.level != FALSE)
          {
            if(anova(model.basis, models[[j]])[2,7] < sig.level)
            {

              model.basis <- models[[j]]

              # Writing the logs
              log.step <- log.step + 1
              log.block[log.step] <- blocks[j]
              log.LL[log.step] <- as.numeric(logLik(model.basis))
              log.p[log.step] <- anova(model.basis, models[[j]])[2,7]

              blocks <- blocks[-j]

              break
            }
          }

          ##############
          ############## Selection based significance of added variable-block
          ##############

          if(zt != FALSE)
          {
            b.model <- summary(models[[j]])@coefs
            diff.par <- setdiff(rownames(b.model), rownames(summary(model.basis)@coefs))
            if (length(diff.par)==0) break
            sig.par <- FALSE

            for (k in 1:length(diff.par))
            {
              if(abs(b.model[which(rownames(b.model)==diff.par[k]),3]) > zt)
              {
                sig.par <- TRUE
                zt.temp <- b.model[which(rownames(b.model)==diff.par[k]),3]
                break
              }
            }

            if(sig.par==TRUE)
            {
              model.basis <- models[[j]]

              # Writing the logs
              log.step <- log.step + 1
              log.block[log.step] <- blocks[j]
              log.LL[log.step] <- as.numeric(logLik(model.basis))
              log.zt[log.step] <- zt.temp
              blocks <- blocks[-j]

              break
            }
          }
        }
  }
  close(pb)

  ## Create and print log
  log.df <- data.frame(log.step=1:log.step, log.block, log.LL, log.p, log.zt)
  if(print.log == TRUE) print(log.df, digits=4)

  ## Return the 'best' fitting model
  return(model.basis)
}