Как остановить функцию в R, которая занимает слишком много времени и дать ей альтернативу?

Я пытаюсь сделать что-то "правильно". Иногда "правильный путь" занимает слишком много времени, в зависимости от входов. Я не могу знать априори, когда это будет. Когда "правильный путь" занимает слишком много времени, я хочу перейти к "хакерскому пути". Как заставить R контролировать, как долго выполнялась какая-то конкретная задача, и дать ей что-то еще, если пройден порог? Я бы предположил, что это будет частью семейства try, но я не совсем уверен, как назвать это или google для.

Ниже приведен пример пустышки. Когда 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)

Ответы

Ответ 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

Ответ "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)

Ответ 3

Для тех, кто хочет более легкое решение, которое не зависит от пакета 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)
    }
  })

}