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

Posted 2023-02-22

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

【英文标题】：How to stop a function in R that is taking too long and give it an alternative?

【发布时间】：2016-03-24 15:09:25

【问题描述】：

我正在尝试以“正确的方式”做一件事。有时“正确的方法”需要很长时间，具体取决于输入。我真的不知道这会是什么时候。当“正确的方式”花费太长时间时，我想去“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)

【问题讨论】：

如何添加时间检查？

是的，我只是在运行 R。我没有学过任何 C。在这种情况下编写和编译一个简单的 C 程序并使用 .C 调用它会很简单吗？

【参考方案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)

【参考方案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)
    
  )

【参考方案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 提出如何改进错误消息问题的想法

【讨论】：

不起作用：Error: 'evalWithTimeout' is defunct. Use 'R.utils::withTimeout()' instead. See help("Defunct")

时间流逝，版本变化。我修改了功能，它似乎又可以工作了。我目前正在使用 R 版本 3.6.0 和 R.utils v2.9.2