How to stop a function in R that is taking too long and give it an alternative?

Question

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

Answer 1

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