如何停止 R 中耗时过长的函数并为其提供替代方案？

Question

我正在尝试以“正确的方式”做一件事。有时“正确的方法”需要很长时间，具体取决于输入。我真的不知道这会是什么时候。当“正确的方式”花费太长时间时，我想去“hackish方式”。如何让 R 监控特定任务花费了多长时间，并在超过阈值时让它做其他事情？我想这将成为try 家族的一部分，但我不太确定如何称呼它或谷歌。

下面的虚拟示例。当slow.func 耗时过长时，我希望interuptor 停止它并改为调用fast.func。

slow.func <- function(x){
    Sys.sleep(x)    
    print('good morning')
}

fast.func <- function(x){
    Sys.sleep(x/10) 
    print('hit snooze')
}

interuptor = function(FUN,args, time.limit, ALTFUN){
#   START MONITORING TIME HERE
    do.call(FUN,args)
#   IF FUN TAKES TOO LONG, STOP IT, CALL A
    do.call(ALTFUN,args)
}

interuptor(slow.func, list(x = 2), time.limit = 1, fast.func)

Answer 1

R 包R.utils 有一个函数evalWithTimeout，这几乎就是您所描述的。如果不想安装包，evalWithTimeout 依赖于不太友好的 R 基础函数 setTimeLimit

您的代码将如下所示：

library(R.utils)

slow.func <- function(x){
  Sys.sleep(10)    
  return(x^2)
}

fast.func <- function(x){
  Sys.sleep(2) 
return(x*x)
}
interruptor = function(FUN,args, time.limit, ALTFUN){
  results <- NULL
  results <- evalWithTimeout({FUN(args)},timeout=time.limit,onTimeout="warning")
  if(results==NULL){
    results <- ALTFUN(args)
  }
  return(results)
}   
interruptor(slow.func,args=2,time.limit=3,fast.func)

Answer 2

对于任何想要一个不依赖于R.utils 包的更轻量级解决方案的人，我最终使用了基于withTimeout() 代码的最小解决方案。

foo <- function() {

  time_limit <- 10

  setTimeLimit(cpu = time_limit, elapsed = time_limit, transient = TRUE)
  on.exit({
    setTimeLimit(cpu = Inf, elapsed = Inf, transient = FALSE)
  })

  tryCatch({
    # do some stuff
  }, error = function(e) {
    if (grepl("reached elapsed time limit|reached CPU time limit", e$message)) {
      # we reached timeout, apply some alternative method or do something else
    } else {
      # error not related to timeout
      stop(e)
    }
  })

}

Answer 3

我发布的初始版本适用于“R.utils v2.5.0 (2016-11-07)”，但不适用于“R.utils v2.9.2”。以下是使用“R.utils v2.9.2”进行一些修改的版本

带有“R.utils v2.5.0”的版本

“nwknoblauch”的答案对我不起作用，除非我在中断器函数中将“警告”更改为“静音”。

library(R.utils)

slow.func <- function(x){
  Sys.sleep(10)    
  return(x^2)
}

fast.func <- function(x){
  Sys.sleep(2) 
return(x*x)
}

interruptor = function(FUN,args, time.limit, ALTFUN){
  results <- NULL
  results <- evalWithTimeout({FUN(args)},timeout=time.limit,onTimeout="silent")
  if(is.null(results)){
    results <- ALTFUN(args)
  }
  return(results)
}   

interruptor(FUN = slow.func,args=2,time.limit=3,ALTFUN = fast.func)

带有“R.utils v2.9.2”的版本

library(R.utils)

slow.func <- function(x){
  Sys.sleep(4)    
  return(x^2)
}
fast.func <- function(x){
  Sys.sleep(2) 
  return(x)
}

interruptor <- function(FUN,args, time.limit, ALTFUN){

  results <- 
    tryCatch({
      withTimeout({FUN(args)}, timeout=time.limit)
    }, error = function(e){
      if(grepl("reached elapsed time limit",e$message))
        ALTFUN(args) else
          paste(e$message,"EXTRACTERROR")
      })

  if(grepl("EXTRACTERROR",results)){
    print(gsub("EXTRACTERROR","",results))
    results <- NULL
  } 

  return(results)
}   

根据选择的 time.limit，它执行第一个函数或替代函数。当出现与时间限制无关的错误时返回NULL并打印错误信息。

示例：

test_obj <- interruptor(FUN = slow.func, args=5, time.limit= 6, ALTFUN = fast.func)
test_obj
test_obj <- interruptor(FUN = slow.func, args=5, time.limit= 3, ALTFUN = fast.func)
test_obj
test_obj <- interruptor(FUN = slow.func, args="A", time.limit= 6, ALTFUN = fast.func)
test_obj
test_obj <- interruptor(FUN = slow.func, args="A", time.limit= 3, ALTFUN = fast.func)
test_obj

感谢 andybega 提出如何改进错误消息问题的想法