在R中以异步模式启动函数,作为一个单独的过程

时间:2015-08-05 10:27:39

标签: r asynchronous

我正在寻找从R内异步启动R进程的能力 类似下面的功能

startFunctionInAsynchMode<-function(workingDir,filesToSource, functionName, ...){
 #workingdir - the dir that should be set as wd
 #filesToSource - vector of fileNames to be sourced
 #functionName - the actual function to be run asynchrously
 #...  - other parameters to be passed to the function
 #Return Value - should be the System Process Id Started
}

有人会有快速的想法吗?我检查了像平行等的包,但似乎不合适。 提前致谢

1 个答案:

答案 0 :(得分:0)

这是使用R CMD的实现。基本版测试。还有一些开放项目。

startFunctionInAsynchMode<-function(workingDir,filesToSource, functionName, ...){
    wd<-getwd()
    setwd(workingDir)
    fs<-makeFiles()
    scriptFile<-fs$ScriptFile
    cat(file=scriptFile,paste0("source(\"",filesToSource,"\")", collapse = "\n"))
    cat(file=scriptFile,"\n",append = T)
    functionCall<-getFunctionCall(functionName,as.list(match.call()), startIndex=5)
    cat(file=scriptFile,functionCall,append = T)
    commandsToRun <- paste0("(R CMD BATCH ", scriptFile, " ",fs$LogFile , " --slave ) &")
    print(commandsToRun)
    system(commandsToRun)
    Sys.sleep(5)
    pids<-getPids(scriptFile, "--restore")
    cat(file=fs$KillScript,paste0("kill -9 ",pids$PID[1]))
    setwd(wd)
    return(as.character(pids$PID[1]))
}

makeFiles<-function(){
    res<-list()
    dir.create("./temp/tempRgen", recursive=T,showWarnings = F)
    tf<-tempfile("rGen-","./temp/tempRgen", fileext = "")
    res$ScriptFile<-paste0(tf,".R")
    res$LogFile<-paste0(tf,".log")
    res$KillScript<-paste0(tf,"-kill.sh")
    file.create(res$KillScript,showWarnings = F)
    file.create(res$ScriptFile,showWarnings = F)
    res
}

#Open Items to be handled
#1. Named Arguments
#2. Non String Arguments
getFunctionCall<-function(functionName,argList,startIndex){
    res<-paste0(functionName,"(")
    if(!is.null(argList)){
        if(length(argList)>=startIndex){
            first=T
            for(i in startIndex:length(argList)){
                if(first){
                    first=F
                } else {
                    res<-paste0(res,",")
                }
                res<-paste0(res,"\"",argList[[i]],"\"")
            }
        }
    }
    res<-paste0(res,")")
}

getPids <- function(grepFor, refineWith){
    numCols <- length(unlist(str_split(system("ps aux", intern=T)[1], "\\s+")))
    psOutput <- system(paste0("ps auxww | grep ", grepFor), intern=T)
    psOutput <- psOutput[str_detect(psOutput, refineWith)]
    pidDf <- ldply(psOutput, parseEachPsLine)
    # Remove the process that actually grep-ed for my search string
    pidDf <- pidDf[!str_detect(pidDf$COMMAND, "grep"),]
    return(pidDf)
}

parseEachPsLine <- function(line){
    tabular <- read.table(textConnection(line), header=F, sep=" ")
    tabular <- tabular[!is.na(tabular)]
    psTitles <- c("USER", "PID", "CPU", "MEM", "VSZ", "RSS", "TTY", "STAT", "START", "TIME", "COMMAND")
    psColNames <- setNames(seq(1, length(psTitles)), psTitles)

    COMMAND <- paste0(tabular[(psColNames["COMMAND"]):length(tabular)], collapse=" ")
    return(data.frame("PID"=tabular[psColNames["PID"]], "STARTED"=tabular[psColNames["START"]], "COMMAND"=COMMAND, "STATUS"=tabular[psColNames["STAT"]]))
}