2

我在 R 中运行一些有时需要很长时间才能完成的功能（从 10 分钟到 4 小时不等）。具体来说，我正在使用forward.lmer()Rense Nieuwenhuis 编写的函数 ()，可以在此处找到。我想知道 R 是否有任何方法可以告诉 % 完成操作。特别是，当操作已经运行了一个多小时时，我想知道它离完成有多近。

是否有一个通用函数可以让我知道任何给定函数的进度？我最想知道的是是否有这样的功能：

percentComplete()
forward.lmer(inputs)

然后这将告诉我完成该功能的距离有多近？

我尝试的第一件事是使用library(time)并执行以下操作：

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

但这只是告诉我完成该功能需要多长时间。有没有办法知道函数在运行时的进展情况（完成百分比）？

此外，我很想提高此功能的效率，但这是另一个问题。谢谢大家！

4

1 回答 1

5

您可以使用txtProgressBar来跟踪您在某个过程中的进度。

我对您引用的函数不够熟悉，无法确切知道它应该去哪里，但仅从目测来看，它似乎可以在循环中花费大量时间：

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

如果您要使用：

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

这可能会给你你正在寻找的东西。请注意，某些显示在某些样式的进度条上比其他显示效果更好。如果使用我发布的代码输出对您来说很有趣，那么在创建进度条时尝试不同的样式可能会更幸运。

R 无法提前知道通用函数需要多长时间才能完成，因此这里没有通用答案。这是您在每个循环中使用进度条发布的功能。

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)
}
于 2012-04-12T20:45:32.240 回答