26

I'm trying to do a thing "the right way". Sometimes "the right way" takes too long, depending on the inputs. I can't really know a priori when this will be. When "the right way" is taking too long, I want to go to "the hackish way". How do I make R monitor how long a particular task as taken, and give it something else to do if a threshold has passed? I'd imagine that this will be part of the try family, but I'm not quite sure what to call it or google for.

Dummy example below. When slow.func takes too long, I want interuptor to stop it and call fast.func instead.

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)
2
  • how would I add a time check? Dec 18, 2015 at 0:41
  • yeah I'm just running R. I haven't learned any C. Would it be trivial to write and compile a simple C program in this case and call it with .C? Dec 18, 2015 at 0:46

3 Answers 3

14

The R package R.utils has a function evalWithTimeout that's pretty much exactly what you're describing. If you don't want to install a package, evalWithTimeout relies on the less user friendly R base function setTimeLimit

Your code would look something like this:

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

For anyone who wants a lighter weight solution that does not depend on the R.utils package, I ended up using a minimal solution based on the withTimeout() code.

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

}
4

The initial version I posted worked with "R.utils v2.5.0 (2016-11-07)" but it does not with "R.utils v2.9.2". Below a version with some modifications that works using "R.utils v2.9.2"

version with "R.utils v2.5.0"

The answer of "nwknoblauch" does not work for me unless I change "warning" by "silent" inside the interruptor function.

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)

version with "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)
}   

Depending on the selected time.limit, it executes the first function or the alternative. It returns NULL when there is an error not related to time limit and print the error message.

EXAMPLE:

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

Thanks to andybega for the idea of how improving the issue of error messages

2
  • Doesn't work: Error: 'evalWithTimeout' is defunct. Use 'R.utils::withTimeout()' instead. See help("Defunct")
    – dca
    Mar 17, 2020 at 23:19
  • 1
    The time pass and versions change. I modified the function and it seems to work again. I am currently using R version 3.6.0 and R.utils v2.9.2
    – MarinaGA
    Mar 19, 2020 at 12:42

Your Answer

Reminder: Answers generated by Artificial Intelligence tools are not allowed on Stack Overflow. Learn more

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.