通过 try() 之类的方法使 R 命令超时

发布于 2024-12-11 19:51:37 字数 333 浏览 0 评论 0原文

我正在并行运行大量迭代。某些迭代比其他迭代花费的时间要长得多（例如 100 倍）。我想将这些超时，但我不想深入研究函数（称为 fun.c）背后的 C 代码来完成繁重的工作。我希望有类似于 try() 的东西，但有一个 time.out 选项。然后我可以做类似的事情：

for (i in 1:1000) {
    try(fun.c(args),time.out=60))->to.return[i]
}

因此，如果 fun.c 对于某个迭代花费的时间超过 60 秒，那么修改后的 try() 函数将杀死它并返回警告或类似的内容。

有人有什么建议吗？提前致谢。

原文

I'm running a large number of iterations in parallel. Certain iterates take much (say 100x) longer than others. I want to time these out, but I'd rather not have to dig into the C code behind the function (call it fun.c) doing the heavy lifting. I am hoping there is something similar to try() but with a time.out option. Then I could do something like:

for (i in 1:1000) {
    try(fun.c(args),time.out=60))->to.return[i]
}

So if fun.c took longer than 60 seconds for a certain iterate, then the revamped try() function would just kill it and return a warning or something along those lines.

Anybody have any advice? Thanks in advance.

分享到QQ

分享到微博

如果你对这篇内容有疑问，欢迎到本站社区发帖提问参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。

发布评论

需要登录才能够评论，你可以免费注册一个本站的账号。

我的痛♀有谁懂 2024-12-18 19:51:37

请参阅此线程：http://r.789695.n4.nabble。 com/Time-out-for-aR-Function-td3075686.html

和 ?evalWithTimeout 中R.utils 包。

这是一个例子：

require(R.utils)

## function that can take a long time
fn1 <- function(x)
{
    for (i in 1:x^x)
    {
        rep(x, 1000)
    }
    return("finished")
}

## test timeout
evalWithTimeout(fn1(3), timeout = 1, onTimeout = "error") # should be fine
evalWithTimeout(fn1(8), timeout = 1, onTimeout = "error") # should timeout

See this thread: http://r.789695.n4.nabble.com/Time-out-for-a-R-Function-td3075686.html

and ?evalWithTimeout in the R.utils package.

Here's an example:

require(R.utils)

## function that can take a long time
fn1 <- function(x)
{
    for (i in 1:x^x)
    {
        rep(x, 1000)
    }
    return("finished")
}

## test timeout
evalWithTimeout(fn1(3), timeout = 1, onTimeout = "error") # should be fine
evalWithTimeout(fn1(8), timeout = 1, onTimeout = "error") # should timeout

回复收藏 0 原文

随遇而安 2024-12-18 19:51:37

这听起来像是应该由向工作人员分发任务的任何东西来管理，而不是应该包含在工作线程中。 multicore 包支持某些函数的超时；据我所知，snow 没有。

编辑：如果您真的非常渴望在工作线程中使用此功能，请尝试此功能，灵感来自@jthetzel 答案中的链接。

try_with_time_limit <- function(expr, cpu = Inf, elapsed = Inf)
{
  y <- try({setTimeLimit(cpu, elapsed); expr}, silent = TRUE) 
  if(inherits(y, "try-error")) NULL else y 
}

try_with_time_limit(sqrt(1:10), 1)                   #value returns as normal
try_with_time_limit(for(i in 1:1e7) sqrt(1:10), 1)   #returns NULL

您可能需要自定义超时时的行为。目前它只返回NULL。

This sounds like it should be something that should be managed by whatever is doling out tasks to the workers, rather than something that should be contained in a worker thread. The multicore package supports timeouts for some functions; snow doesn't, as far as I can tell.

EDIT: If you're really desperate to have this in the worker threads, then try this function, inspired by the links in @jthetzel's answer.

try_with_time_limit <- function(expr, cpu = Inf, elapsed = Inf)
{
  y <- try({setTimeLimit(cpu, elapsed); expr}, silent = TRUE) 
  if(inherits(y, "try-error")) NULL else y 
}

try_with_time_limit(sqrt(1:10), 1)                   #value returns as normal
try_with_time_limit(for(i in 1:1e7) sqrt(1:10), 1)   #returns NULL

You'll perhaps want to customise the behaviour in the event of a timeout. At the moment it just returns NULL.

回复收藏 0 原文

我们的影子 2024-12-18 19:51:37

我喜欢 R.utils::withTimeout()，但我也渴望尽可能避免包依赖。这是基本 R 中的解决方案。请注意 on.exit() 调用。即使您的表达式抛出错误，它也确保消除时间限制。

with_timeout <- function(expr, cpu, elapsed){
  expr <- substitute(expr)
  envir <- parent.frame()
  setTimeLimit(cpu = cpu, elapsed = elapsed, transient = TRUE)
  on.exit(setTimeLimit(cpu = Inf, elapsed = Inf, transient = FALSE))
  eval(expr, envir = envir)
}

I like R.utils::withTimeout(), but I also aspire to avoid package dependencies if I can. Here is a solution in base R. Please note the on.exit() call. It makes sure to remove the time limit even if your expression throws an error.

with_timeout <- function(expr, cpu, elapsed){
  expr <- substitute(expr)
  envir <- parent.frame()
  setTimeLimit(cpu = cpu, elapsed = elapsed, transient = TRUE)
  on.exit(setTimeLimit(cpu = Inf, elapsed = Inf, transient = FALSE))
  eval(expr, envir = envir)
}

回复收藏 0 原文

烟织青萝梦 2024-12-18 19:51:37

您在评论中提到您的问题是 C 代码运行时间过长。根据我的经验，基于 setTimeLimit/evalWithTimeout 的纯粹基于 R 的超时解决方案都无法停止 C 代码的执行，除非代码提供了中断 R 的机会

。在评论中还提到您正在对 SNOW 进行并行化。如果您要并行化的机器是支持分叉的操作系统（即不是 Windows），那么您可以在以下环境中使用 mcparallel（位于 parallel 包中，派生自 multicore）： SNOW 集群上节点的命令上下文；顺便说一句，反之亦然，您可以从多核分叉的上下文中触发 SNOW 集群。如果您不通过 SNOW 进行并行化，那么这个答案（当然）也成立，前提是需要使 C 代码超时的机器可以分叉。

这适合 eval_fork，这是 opencpu 使用的解决方案。查看 eval_fork 函数主体的下面，了解 Windows 中的黑客攻击的概要以及该黑客攻击的实施不佳的一半版本。

eval_fork <- function(..., timeout=60){

  #this limit must always be higher than the timeout on the fork!
  setTimeLimit(timeout+5);      

  #dispatch based on method
  ##NOTE!!!!! Due to a bug in mcparallel, we cannot use silent=TRUE for now.
  myfork <- parallel::mcparallel({
    eval(...)
  }, silent=FALSE);

  #wait max n seconds for a result.
  myresult <- parallel::mccollect(myfork, wait=FALSE, timeout=timeout);

  #try to avoid bug/race condition where mccollect returns null without waiting full timeout.
  #see https://github.com/jeroenooms/opencpu/issues/131
  #waits for max another 2 seconds if proc looks dead 
  while(is.null(myresult) && totaltime < timeout && totaltime < 2) {
     Sys.sleep(.1)
     enddtime <- Sys.time();
     totaltime <- as.numeric(enddtime - starttime, units="secs")
     myresult <- parallel::mccollect(myfork, wait = FALSE, timeout = timeout);
  }

  #kill fork after collect has returned
  tools::pskill(myfork$pid, tools::SIGKILL);    
  tools::pskill(-1 * myfork$pid, tools::SIGKILL);  

  #clean up:
  parallel::mccollect(myfork, wait=FALSE);

  #timeout?
  if(is.null(myresult)){
    stop("R call did not return within ", timeout, " seconds. Terminating process.", call.=FALSE);      
  }

  #move this to distinguish between timeout and NULL returns
  myresult <- myresult[[1]];

  #reset timer
  setTimeLimit();     

  #forks don't throw errors themselves
  if(inherits(myresult,"try-error")){
    #stop(myresult, call.=FALSE);
    stop(attr(myresult, "condition"));
  }

  #send the buffered response
  return(myresult);  
}

Windows 黑客：
原则上，特别是对于 SNOW 中的工作节点，您可以通过让工作节点完成类似的操作：

创建一个变量来存储临时文件
将其工作区 (save.image) 存储到已知位置
使用使用 R 脚本加载 Rscript 的系统调用，该脚本加载节点保存的工作区，然后保存结果（本质上是对 R 工作区进行慢速内存分叉）。
在每个工作节点上输入重复循环查找结果文件，如果在设置的时间段后结果文件没有出现，则退出循环并保存反映超时的返回值
否则，成功完成查找并读取保存结果并准备好返回

我很久以前使用慢速内存副本在本地主机上的 Windows 上为类似 mcparallel 的东西编写了一些代码。我现在会完全不同地写它，但它可能会给你一个起点，所以我无论如何都会提供它。需要注意一些问题，russmisc 是我正在编写的一个包，现在作为 repsych 在 github 上。 glibrary 是 repsych 中的一个函数，如果软件包尚不可用，它会安装该软件包（如果您的 SNOW 不仅仅位于本地主机上，则可能很重要）。 ...当然，我已经很多年没有使用过这个代码了，而且我最近也没有测试过它 - 我共享的版本可能包含我在后续版本中解决的错误。

# Farm has been banished here because it likely violates 
# CRAN's rules in regards to where it saves files and is very
# windows specific.  Also, the darn thing is buggy.

#' Create a farm
#'
#' A farm is an external self-terminating instance of R to solve a time consuming problem in R.  
#' Think of it as a (very) poor-person's multi-core.
#' For a usage example, see checkFarm.
#' Known issues:  May have a problem if the library gdata has been loaded.//
#' If a farm produces warnings or errors you won't see them
#' If a farm produces an error... it never will produce a result.
#'
#' @export
#' @param commands A text string of commands including line breaks to run.  
#' This must include the result being saved in the object farmName in the file farmResult (both are variables provided by farm() to the farm).
#' @param farmName This is the name of the farm, used for creating and destroying filenames.  One is randomly assigned that is plausibly unique.
#' @param Rloc The location of R.exe.  The default loads the version of R that is stored in the windows registry as being \"current\".
#' @return The farm name is returned to be stored in an object and then used in checkFarm()
#' @seealso \code{\link{checkFarm}} \code{\link{waitForFarm}}
farm <- function(commands,farmName=paste("farm-",as.integer(Sys.time())+runif(1),sep=""),Rloc = NULL)
{
  if (is.null(Rloc)) {Rloc <- paste('\"',readRegistry(paste("Software\\R-core\\R\\",readRegistry("Software\\R-core\\R\\",maxdepth=100)您在评论中提到您的问题是 C 代码运行时间过长。根据我的经验，基于 setTimeLimit/evalWithTimeout 的纯粹基于 R 的超时解决方案都无法停止 C 代码的执行，除非代码提供了中断 R 的机会
。在评论中还提到您正在对 SNOW 进行并行化。如果您要并行化的机器是支持分叉的操作系统（即不是 Windows），那么您可以在以下环境中使用 mcparallel（位于 parallel 包中，派生自 multicore）： SNOW 集群上节点的命令上下文；顺便说一句，反之亦然，您可以从多核分叉的上下文中触发 SNOW 集群。如果您不通过 SNOW 进行并行化，那么这个答案（当然）也成立，前提是需要使 C 代码超时的机器可以分叉。
这适合 eval_fork，这是 opencpu 使用的解决方案。查看 eval_fork 函数主体的下面，了解 Windows 中的黑客攻击的概要以及该黑客攻击的实施不佳的一半版本。
eval_fork <- function(..., timeout=60){

  #this limit must always be higher than the timeout on the fork!
  setTimeLimit(timeout+5);      

  #dispatch based on method
  ##NOTE!!!!! Due to a bug in mcparallel, we cannot use silent=TRUE for now.
  myfork <- parallel::mcparallel({
    eval(...)
  }, silent=FALSE);

  #wait max n seconds for a result.
  myresult <- parallel::mccollect(myfork, wait=FALSE, timeout=timeout);

  #try to avoid bug/race condition where mccollect returns null without waiting full timeout.
  #see https://github.com/jeroenooms/opencpu/issues/131
  #waits for max another 2 seconds if proc looks dead 
  while(is.null(myresult) && totaltime < timeout && totaltime < 2) {
     Sys.sleep(.1)
     enddtime <- Sys.time();
     totaltime <- as.numeric(enddtime - starttime, units="secs")
     myresult <- parallel::mccollect(myfork, wait = FALSE, timeout = timeout);
  }

  #kill fork after collect has returned
  tools::pskill(myfork$pid, tools::SIGKILL);    
  tools::pskill(-1 * myfork$pid, tools::SIGKILL);  

  #clean up:
  parallel::mccollect(myfork, wait=FALSE);

  #timeout?
  if(is.null(myresult)){
    stop("R call did not return within ", timeout, " seconds. Terminating process.", call.=FALSE);      
  }

  #move this to distinguish between timeout and NULL returns
  myresult <- myresult[[1]];

  #reset timer
  setTimeLimit();     

  #forks don't throw errors themselves
  if(inherits(myresult,"try-error")){
    #stop(myresult, call.=FALSE);
    stop(attr(myresult, "condition"));
  }

  #send the buffered response
  return(myresult);  
}

 Windows 黑客：

原则上，特别是对于 SNOW 中的工作节点，您可以通过让工作节点完成类似的操作：

创建一个变量来存储临时文件
将其工作区 (save.image) 存储到已知位置
使用使用 R 脚本加载 Rscript 的系统调用，该脚本加载节点保存的工作区，然后保存结果（本质上是对 R 工作区进行慢速内存分叉）。
在每个工作节点上输入重复循环查找结果文件，如果在设置的时间段后结果文件没有出现，则退出循环并保存反映超时的返回值
否则，成功完成查找并读取保存结果并准备好返回

我很久以前使用慢速内存副本在本地主机上的 Windows 上为类似 mcparallel 的东西编写了一些代码。我现在会完全不同地写它，但它可能会给你一个起点，所以我无论如何都会提供它。需要注意一些问题，russmisc 是我正在编写的一个包，现在作为 repsych 在 github 上。 glibrary 是 repsych 中的一个函数，如果软件包尚不可用，它会安装该软件包（如果您的 SNOW 不仅仅位于本地主机上，则可能很重要）。 ...当然，我已经很多年没有使用过这个代码了，而且我最近也没有测试过它 - 我共享的版本可能包含我在后续版本中解决的错误。
Current Version`,"\\",sep=""))$InstallPath,"\\bin",sep="")}
  Rloc <- paste(Rloc,"\\R.exe\"",sep="")
  farmRda <- paste(farmName,".Rda",sep="")
    farmRda.int <- paste(farmName,".int.Rda",sep="") #internal .Rda
    farmR <- paste(farmName,".R",sep="")
    farmResult <- paste(farmName,".res.Rda",sep="") #result .Rda
    unlink(c(farmRda,farmR,farmResult,farmRda.int))
    farmwd <- getwd()
    cat("setwd(\"",farmwd,"\")\n",file=farmR,append=TRUE,sep="")
    #loading the internals to get them, then loading the globals, then reloading the internals to make sure they have haven't been overwritten
  cat("
load(\"",farmRda.int,"\")
load(farmRda)
load(\"",farmRda.int,"\")
        ",file=farmR,append=TRUE,sep="")
    cat("library(russmisc)\n",file=farmR,append=TRUE)
    cat("glibrary(",paste(c(names(sessionInfo()$loadedOnly),names(sessionInfo()$otherPkgs)),collapse=","),")\n",file=farmR,append=TRUE)
    cat(commands,file=farmR,append=TRUE)
    cat("
        unlink(farmRda)
        unlink(farmRda.int)
    ",file=farmR,append=TRUE,sep="")
    save(list = ls(all.names=TRUE,envir=.GlobalEnv), file = farmRda,envir=.GlobalEnv)
    save(list = ls(all.names=TRUE), file = farmRda.int)
    #have to drop the escaped quotes for file.exists to find the file
  if (file.exists(gsub('\"','',Rloc))) {
        cmd <- paste(Rloc," --file=",getwd(),"/",farmR,sep="")
    } else {
        stop(paste("Error in russmisc:farm: Unable to find R.exe at",Rloc))
    }
    print(cmd)
    shell(cmd,wait=FALSE)
    return(farmName)
}
NULL

#' Check a farm
#'
#' See farm() for details on farms.  This function checks for a file based on the farmName parameter called farmName.res.Rda.
#' If that file exists it loads it and returns the object stored by the farm in the object farmName.  If that file does not exist,
#' then the farm is not done processing, and a warning and NULL are returned.  Note that a rapid loop through checkFarm() without Sys.sleep produced an error during development.
#'
#' @export
#' @param farmName This is the name of the farm, used for creating and destroying filenames.  This should be saved from when the farm() is created
#' @seealso \code{\link{farm}} \code{\link{waitForFarm}}
#' @examples 
#' #Example not run
#' #.tmp <- "This is a test of farm()"
#' #exampleFarm <- farm("
#' #print(.tmp)
#' #helloFarm <- 10+2
#' #farmName <- helloFarm
#' #save(farmName,file=farmResult)
#' #")
#' #example.result <- checkFarm(exampleFarm)
#' #while (is.null(example.result)) {
#' #    example.result <- checkFarm(exampleFarm)
#' #    Sys.sleep(1)
#' #}
#' #print(example.result)
checkFarm <- function(farmName) {
  farmResult <- paste(farmName,".res.Rda",sep="")
  farmR <- paste(farmName,".r",sep="")
  if (!file.exists(farmR)) {
    message(paste("Warning in russmisc:checkFarm:  There is no evidence that the farm '",farmName,"' exists (no .r file found).\n",sep=""))
  }
    if (file.exists(farmResult)) {
        load(farmResult)
    unlink(farmResult) #delete the farmResult file
    unlink(farmR)      #delete the script file
        return(farmName)
    } else {
        warning(paste("Warning in russmisc:checkFarm:  The farm '",farmName,"' is not ready.\n",sep=""))
        return(invisible(NULL))
    }
}
NULL

#' Wait for a farm result
#'
#' This function repeatedly checks for a farm, when the farm is found it returns the harvest (the farm result object).
#' If the farm terminated with an error or there is some other sort of coding error, waitForFarm will be an infinate loop. As
#' \code{checkFarm} produces errors on checks when the harvest is not ready, waitForFarm hides these errors in the factory error-catching wrapper.
#'
#' @export
#' @param farmName This is the name of the farm, used for creating and destroying filenames.  This should be saved from when the farm() is created
#' @param noCheck If this value is TRUE the check for the farm's .r is skipped.  If it is FALSE, the existance of the appropriate .r is checked for before entering a potentially unending while loop.
waitForFarm <- function(farmName,noCheck=FALSE) {
  f.checkFarm <- factory(checkFarm)
  farmR <- paste(farmName,".r",sep="")
  if (!file.exists(farmR) & !noCheck) {
    stop(paste("Error in russmisc:checkFarm:  There is no evidence that the farm '",farmName,"' exists (no .r file found).\n",sep=""))
  }
  repeat {
    harvest <- f.checkFarm(farmName)
    if (!is.null(harvest[[1]])) {break}
    Sys.sleep(1)
  }
    return(harvest[[1]])
}
NULL

#' Create a one-line simple farm
#'
#' This is a convience wrapper function that uses farm to create a single farm appropriate for processing single line commands.
#'
#' @export
#' @param command A single command
#' @param farmName This is the name of the farm, used for creating and destroying filenames.  One is randomly assigned that is plausibly unique.
#' @param Rloc The location of R.exe.  The default loads the version of R that is stored in the windows registry as being \"current\".
#' @return The farm name is returned to be stored in an object and then used in checkFarm()
#' @seealso \code{\link{farm}}, \code{\link{checkFarm}}, and \code{\link{waitForFarm}}
#' @examples
#' #Example not run
#' #a <- 5
#' #b <- 10
#' #farmID <- simpleFarm("a + b")
#' #waitForFarm(farmID)
simpleFarm <- function(command,farmName=paste("farm-",as.integer(Sys.time())+runif(1),sep=""),Rloc = NULL) {
  return(farm(paste("farmName <- (",command,");save(farmName,file=farmResult)",collapse=""),farmName=paste("farm-",as.integer(Sys.time())+runif(1),sep=""),Rloc = NULL))
}
NULL

You mentioned in a comment that your problem is with C code running long. In my experience, none of the purely R based timeout solutions based on setTimeLimit/evalWithTimeout can stop the execution of C code unless the code provides an opportunity to interrupt to R.

You also mentioned in a comment that you are parallelizing over SNOW. If the machines you are parallelizing to are an OS that supports forking (i.e., not Windows), then you can use mcparallel (in the parallel package, derived from multicore) within the context of a command to a node on a SNOW cluster; the inverse is also true BTW, you can trigger SNOW clusters from the context of a multicore fork. This answer also (of course) holds if you aren't parallelizing via SNOW, provided the machine that needs to timeout the C code can fork.

This lends itself to eval_fork, a solution used by opencpu. Look below the body of the eval_fork function for an outline of a hack in Windows and a poorly implemented half version of that hack.

eval_fork <- function(..., timeout=60){

  #this limit must always be higher than the timeout on the fork!
  setTimeLimit(timeout+5);      

  #dispatch based on method
  ##NOTE!!!!! Due to a bug in mcparallel, we cannot use silent=TRUE for now.
  myfork <- parallel::mcparallel({
    eval(...)
  }, silent=FALSE);

  #wait max n seconds for a result.
  myresult <- parallel::mccollect(myfork, wait=FALSE, timeout=timeout);

  #try to avoid bug/race condition where mccollect returns null without waiting full timeout.
  #see https://github.com/jeroenooms/opencpu/issues/131
  #waits for max another 2 seconds if proc looks dead 
  while(is.null(myresult) && totaltime < timeout && totaltime < 2) {
     Sys.sleep(.1)
     enddtime <- Sys.time();
     totaltime <- as.numeric(enddtime - starttime, units="secs")
     myresult <- parallel::mccollect(myfork, wait = FALSE, timeout = timeout);
  }

  #kill fork after collect has returned
  tools::pskill(myfork$pid, tools::SIGKILL);    
  tools::pskill(-1 * myfork$pid, tools::SIGKILL);  

  #clean up:
  parallel::mccollect(myfork, wait=FALSE);

  #timeout?
  if(is.null(myresult)){
    stop("R call did not return within ", timeout, " seconds. Terminating process.", call.=FALSE);      
  }

  #move this to distinguish between timeout and NULL returns
  myresult <- myresult[[1]];

  #reset timer
  setTimeLimit();     

  #forks don't throw errors themselves
  if(inherits(myresult,"try-error")){
    #stop(myresult, call.=FALSE);
    stop(attr(myresult, "condition"));
  }

  #send the buffered response
  return(myresult);  
}

Windows hack:
In principle, especially with worker nodes in SNOW, you could accomplish something similar by having the worker nodes:

create a variable to store a temporary file
store their workspace (save.image) to a known location
Use a system call to load Rscript with an R script that loads the workspace saved by the node and then saves a result (essentially doing a slow memory fork of the R workspace).
Enter a repeat loop on each worker node looking for the result file, if the result file doesn't manifest after your set period of time, break from the loop and save a return value reflecting the timeout
Otherwise, successfully complete the look and read the saved the result and have it ready for return

I wrote some code a /long/ time ago for something like mcparallel on Windows on localhost using slow memory copies. I would write it completely differently now, but it might give you a place to start, so I'm providing it anyway. Some gotchas to note, russmisc was a package I'm writing which now is on github as repsych. glibrary is a function in repsych that installs a package if it isn't already available (potentially important if your SNOW isn't just on localhost). ... and of course I haven't used this code for /years/, and I haven't tested it recently - it is possible the version I'm sharing contains errors that I resolved in later versions.

# Farm has been banished here because it likely violates 
# CRAN's rules in regards to where it saves files and is very
# windows specific.  Also, the darn thing is buggy.

#' Create a farm
#'
#' A farm is an external self-terminating instance of R to solve a time consuming problem in R.  
#' Think of it as a (very) poor-person's multi-core.
#' For a usage example, see checkFarm.
#' Known issues:  May have a problem if the library gdata has been loaded.//
#' If a farm produces warnings or errors you won't see them
#' If a farm produces an error... it never will produce a result.
#'
#' @export
#' @param commands A text string of commands including line breaks to run.  
#' This must include the result being saved in the object farmName in the file farmResult (both are variables provided by farm() to the farm).
#' @param farmName This is the name of the farm, used for creating and destroying filenames.  One is randomly assigned that is plausibly unique.
#' @param Rloc The location of R.exe.  The default loads the version of R that is stored in the windows registry as being \"current\".
#' @return The farm name is returned to be stored in an object and then used in checkFarm()
#' @seealso \code{\link{checkFarm}} \code{\link{waitForFarm}}
farm <- function(commands,farmName=paste("farm-",as.integer(Sys.time())+runif(1),sep=""),Rloc = NULL)
{
  if (is.null(Rloc)) {Rloc <- paste('\"',readRegistry(paste("Software\\R-core\\R\\",readRegistry("Software\\R-core\\R\\",maxdepth=100)You mentioned in a comment that your problem is with C code running long.  In my experience, none of the purely R based timeout solutions based on setTimeLimit/evalWithTimeout can stop the execution of C code unless the code provides an opportunity to interrupt to R.
You also mentioned in a comment that you are parallelizing over SNOW.  If the machines you are parallelizing to are an OS that supports forking (i.e., not Windows), then you can use mcparallel (in the parallel package, derived from multicore) within the context of a command to a node on a SNOW cluster; the inverse is also true BTW, you can trigger SNOW clusters from the context of a multicore fork.  This answer also (of course) holds if you aren't parallelizing via SNOW, provided the machine that needs to timeout the C code can fork.
This lends itself to eval_fork, a solution used by opencpu.  Look below the body of the eval_fork function for an outline of a hack in Windows and a poorly implemented half version of that hack.
eval_fork <- function(..., timeout=60){

  #this limit must always be higher than the timeout on the fork!
  setTimeLimit(timeout+5);      

  #dispatch based on method
  ##NOTE!!!!! Due to a bug in mcparallel, we cannot use silent=TRUE for now.
  myfork <- parallel::mcparallel({
    eval(...)
  }, silent=FALSE);

  #wait max n seconds for a result.
  myresult <- parallel::mccollect(myfork, wait=FALSE, timeout=timeout);

  #try to avoid bug/race condition where mccollect returns null without waiting full timeout.
  #see https://github.com/jeroenooms/opencpu/issues/131
  #waits for max another 2 seconds if proc looks dead 
  while(is.null(myresult) && totaltime < timeout && totaltime < 2) {
     Sys.sleep(.1)
     enddtime <- Sys.time();
     totaltime <- as.numeric(enddtime - starttime, units="secs")
     myresult <- parallel::mccollect(myfork, wait = FALSE, timeout = timeout);
  }

  #kill fork after collect has returned
  tools::pskill(myfork$pid, tools::SIGKILL);    
  tools::pskill(-1 * myfork$pid, tools::SIGKILL);  

  #clean up:
  parallel::mccollect(myfork, wait=FALSE);

  #timeout?
  if(is.null(myresult)){
    stop("R call did not return within ", timeout, " seconds. Terminating process.", call.=FALSE);      
  }

  #move this to distinguish between timeout and NULL returns
  myresult <- myresult[[1]];

  #reset timer
  setTimeLimit();     

  #forks don't throw errors themselves
  if(inherits(myresult,"try-error")){
    #stop(myresult, call.=FALSE);
    stop(attr(myresult, "condition"));
  }

  #send the buffered response
  return(myresult);  
}

Windows hack:

In principle, especially with worker nodes in SNOW, you could accomplish something similar by having the worker nodes:

create a variable to store a temporary file 
store their workspace (save.image) to a known location
Use a system call to load Rscript with an R script that loads the workspace saved by the node and then saves a result (essentially doing a slow memory fork of the R workspace).
Enter a repeat loop on each worker node looking for the result file, if the result file doesn't manifest after your set period of time, break from the loop and save a return value reflecting the timeout
Otherwise, successfully complete the look and read the saved the result and have it ready for return

I wrote some code a /long/ time ago for something like mcparallel on Windows on localhost using slow memory copies.  I would write it completely differently now, but it might give you a place to start, so I'm providing it anyway.  Some gotchas to note, russmisc was a package I'm writing which now is on github as repsych.  glibrary is a function in repsych that installs a package if it isn't already available (potentially important if your SNOW isn't just on localhost).  ... and of course I haven't used this code for /years/, and I haven't tested it recently - it is possible the version I'm sharing contains errors that I resolved in later versions.
Current Version`,"\\",sep=""))$InstallPath,"\\bin",sep="")}
  Rloc <- paste(Rloc,"\\R.exe\"",sep="")
  farmRda <- paste(farmName,".Rda",sep="")
    farmRda.int <- paste(farmName,".int.Rda",sep="") #internal .Rda
    farmR <- paste(farmName,".R",sep="")
    farmResult <- paste(farmName,".res.Rda",sep="") #result .Rda
    unlink(c(farmRda,farmR,farmResult,farmRda.int))
    farmwd <- getwd()
    cat("setwd(\"",farmwd,"\")\n",file=farmR,append=TRUE,sep="")
    #loading the internals to get them, then loading the globals, then reloading the internals to make sure they have haven't been overwritten
  cat("
load(\"",farmRda.int,"\")
load(farmRda)
load(\"",farmRda.int,"\")
        ",file=farmR,append=TRUE,sep="")
    cat("library(russmisc)\n",file=farmR,append=TRUE)
    cat("glibrary(",paste(c(names(sessionInfo()$loadedOnly),names(sessionInfo()$otherPkgs)),collapse=","),")\n",file=farmR,append=TRUE)
    cat(commands,file=farmR,append=TRUE)
    cat("
        unlink(farmRda)
        unlink(farmRda.int)
    ",file=farmR,append=TRUE,sep="")
    save(list = ls(all.names=TRUE,envir=.GlobalEnv), file = farmRda,envir=.GlobalEnv)
    save(list = ls(all.names=TRUE), file = farmRda.int)
    #have to drop the escaped quotes for file.exists to find the file
  if (file.exists(gsub('\"','',Rloc))) {
        cmd <- paste(Rloc," --file=",getwd(),"/",farmR,sep="")
    } else {
        stop(paste("Error in russmisc:farm: Unable to find R.exe at",Rloc))
    }
    print(cmd)
    shell(cmd,wait=FALSE)
    return(farmName)
}
NULL

#' Check a farm
#'
#' See farm() for details on farms.  This function checks for a file based on the farmName parameter called farmName.res.Rda.
#' If that file exists it loads it and returns the object stored by the farm in the object farmName.  If that file does not exist,
#' then the farm is not done processing, and a warning and NULL are returned.  Note that a rapid loop through checkFarm() without Sys.sleep produced an error during development.
#'
#' @export
#' @param farmName This is the name of the farm, used for creating and destroying filenames.  This should be saved from when the farm() is created
#' @seealso \code{\link{farm}} \code{\link{waitForFarm}}
#' @examples 
#' #Example not run
#' #.tmp <- "This is a test of farm()"
#' #exampleFarm <- farm("
#' #print(.tmp)
#' #helloFarm <- 10+2
#' #farmName <- helloFarm
#' #save(farmName,file=farmResult)
#' #")
#' #example.result <- checkFarm(exampleFarm)
#' #while (is.null(example.result)) {
#' #    example.result <- checkFarm(exampleFarm)
#' #    Sys.sleep(1)
#' #}
#' #print(example.result)
checkFarm <- function(farmName) {
  farmResult <- paste(farmName,".res.Rda",sep="")
  farmR <- paste(farmName,".r",sep="")
  if (!file.exists(farmR)) {
    message(paste("Warning in russmisc:checkFarm:  There is no evidence that the farm '",farmName,"' exists (no .r file found).\n",sep=""))
  }
    if (file.exists(farmResult)) {
        load(farmResult)
    unlink(farmResult) #delete the farmResult file
    unlink(farmR)      #delete the script file
        return(farmName)
    } else {
        warning(paste("Warning in russmisc:checkFarm:  The farm '",farmName,"' is not ready.\n",sep=""))
        return(invisible(NULL))
    }
}
NULL

#' Wait for a farm result
#'
#' This function repeatedly checks for a farm, when the farm is found it returns the harvest (the farm result object).
#' If the farm terminated with an error or there is some other sort of coding error, waitForFarm will be an infinate loop. As
#' \code{checkFarm} produces errors on checks when the harvest is not ready, waitForFarm hides these errors in the factory error-catching wrapper.
#'
#' @export
#' @param farmName This is the name of the farm, used for creating and destroying filenames.  This should be saved from when the farm() is created
#' @param noCheck If this value is TRUE the check for the farm's .r is skipped.  If it is FALSE, the existance of the appropriate .r is checked for before entering a potentially unending while loop.
waitForFarm <- function(farmName,noCheck=FALSE) {
  f.checkFarm <- factory(checkFarm)
  farmR <- paste(farmName,".r",sep="")
  if (!file.exists(farmR) & !noCheck) {
    stop(paste("Error in russmisc:checkFarm:  There is no evidence that the farm '",farmName,"' exists (no .r file found).\n",sep=""))
  }
  repeat {
    harvest <- f.checkFarm(farmName)
    if (!is.null(harvest[[1]])) {break}
    Sys.sleep(1)
  }
    return(harvest[[1]])
}
NULL

#' Create a one-line simple farm
#'
#' This is a convience wrapper function that uses farm to create a single farm appropriate for processing single line commands.
#'
#' @export
#' @param command A single command
#' @param farmName This is the name of the farm, used for creating and destroying filenames.  One is randomly assigned that is plausibly unique.
#' @param Rloc The location of R.exe.  The default loads the version of R that is stored in the windows registry as being \"current\".
#' @return The farm name is returned to be stored in an object and then used in checkFarm()
#' @seealso \code{\link{farm}}, \code{\link{checkFarm}}, and \code{\link{waitForFarm}}
#' @examples
#' #Example not run
#' #a <- 5
#' #b <- 10
#' #farmID <- simpleFarm("a + b")
#' #waitForFarm(farmID)
simpleFarm <- function(command,farmName=paste("farm-",as.integer(Sys.time())+runif(1),sep=""),Rloc = NULL) {
  return(farm(paste("farmName <- (",command,");save(farmName,file=farmResult)",collapse=""),farmName=paste("farm-",as.integer(Sys.time())+runif(1),sep=""),Rloc = NULL))
}
NULL