snow/0000755000176200001440000000000012221306424011234 5ustar liggesuserssnow/inst/0000755000176200001440000000000012221074547012221 5ustar liggesuserssnow/inst/RSOCKnode.R0000644000176200001440000000167111625450003014070 0ustar liggesuserslocal({ master <- "localhost" port <- "" snowlib <- Sys.getenv("R_SNOW_LIB") outfile <- Sys.getenv("R_SNOW_OUTFILE") ##**** defaults to ""; document args <- commandArgs() pos <- match("--args", args) args <- args[-(1 : pos)] for (a in args) { pos <- regexpr("=", a) name <- substr(a, 1, pos - 1) value <- substr(a,pos + 1, nchar(a)) switch(name, MASTER = master <- value, PORT = port <- value, SNOWLIB = snowlib <- value, OUT = outfile <- value) } if (! (snowlib %in% .libPaths())) .libPaths(c(snowlib, .libPaths())) library(methods) ## because Rscript as of R 2.7.0 doesn't load methods library(snow) if (port == "") port <- getClusterOption("port") sinkWorkerOutput(outfile) cat("starting worker for", paste(master, port, sep = ":"), "\n") slaveLoop(makeSOCKmaster(master, port)) }) snow/inst/RMPISNOW0000755000176200001440000000413712221074363013426 0ustar liggesusers#! /bin/sh # if defined, prepend R_SNOW_LIB to $_LIBS if test ! -z "${R_SNOW_LIB}" ; then R_LIBS=${R_SNOW_LIB}:${R_LIBS}; export R_LIBS fi # find the library containing the snow package; should eventually use Rscript snowdir=`echo 'invisible(cat(tryCatch(dirname(.find.package("snow")), error = function(e) ""),"\n",sep=""))' | R --slave` # for now this hijacks the R_PROFILE mechanism to start up the R # sessions and load snow and Rmpi into them R_PROFILE=${snowdir}/snow/RMPISNOWprofile; export R_PROFILE if test ! -z "${LAMRANK}" ; then # use the LAMRANK environment variable set by LAM-MPI's mpirun to # run R with appropriate arguments for master and workers. if test "${LAMRANK}" -eq 0 ; then exec R $* else exec R --slave > /dev/null 2>&1 fi elif test ! -z "${MV2_COMM_WORLD_RANK}" ; then # For MVAPICH2 if test "${MV2_COMM_WORLD_RANK}" -eq 0 ; then exec R --no-save $* else exec R --slave > /dev/null 2>&1 fi elif test ! -z "${OMPI_MCA_ns_nds_vpid}" ; then # Similar approach for OpenMPI using the OMPI_MCA_ns_nds_vpid # variable. This is for backward compatibility with pre-1.3 # versions. The master R process thinks it is non-interactive so # for now --no-save or something like that is needed. if test "${OMPI_MCA_ns_nds_vpid}" -eq 0 ; then exec R --no-save $* else exec R --slave > /dev/null 2>&1 fi elif test ! -z "${OMPI_COMM_WORLD_RANK}" ; then # Similar approach for OpenMPI using the OMPI_COMM_WORLD_RANK # variable. This is the correct variable to use as of v1.3+. The # master R process thinks it is non-interactive so for now # --no-save or something like that is needed. if test "${OMPI_COMM_WORLD_RANK}" -eq 0 ; then exec R --no-save $* else exec R --slave > /dev/null 2>&1 fi else # The fallback is to use the same arguments on master and workers, # with --no-save for cases where workers don't have a terminal. # This means that things like CMD batch won't work. It seems to be # important NOT to use exec here, at least when this code runs under LAM. R --no-save $* fi snow/inst/RunSnowWorker0000755000176200001440000000010311564216477014757 0ustar liggesusers#!/bin/sh exec ${R_SNOW_RSCRIPT_CMD:-Rscript} $R_SNOW_LIB/snow/$* snow/inst/RunSnowWorker.bat0000755000176200001440000000034411564216477015533 0ustar liggesusers@echo off rem If the R_SNOW_RSCRIPT_CMD variable is not defined assume Rscript rem is in the search path. if not defined R_SNOW_RSCRIPT_CMD set R_SNOW_RSCRIPT_CMD=Rscript %R_SNOW_RSCRIPT_CMD% %R_SNOW_LIB%\snow\%* snow/inst/RMPInode.R0000755000176200001440000000130011625450003013746 0ustar liggesuserslocal({ snowlib <- Sys.getenv("R_SNOW_LIB") outfile <- Sys.getenv("R_SNOW_OUTFILE") args <- commandArgs() pos <- match("--args", args) args <- args[-(1 : pos)] for (a in args) { pos <- regexpr("=", a) name <- substr(a, 1, pos - 1) value <- substr(a,pos + 1, nchar(a)) switch(name, SNOWLIB = snowlib <- value, OUT = outfile <- value) } if (! (snowlib %in% .libPaths())) .libPaths(c(snowlib, .libPaths())) library(methods) ## because Rscript as of R 2.7.0 doesn't load methods library(Rmpi) library(snow) sinkWorkerOutput(outfile) cat("starting MPI worker\n") runMPIslave() }) snow/inst/RPVMnode.R0000755000176200001440000000133611625450003013774 0ustar liggesuserslocal({ snowlib <- Sys.getenv("R_SNOW_LIB") outfile <- Sys.getenv("R_SNOW_OUTFILE") args <- commandArgs() pos <- match("--args", args) args <- args[-(1 : pos)] for (a in args) { pos <- regexpr("=", a) name <- substr(a, 1, pos - 1) value <- substr(a,pos + 1, nchar(a)) switch(name, SNOWLIB = snowlib <- value, OUT = outfile <- value) } if (! (snowlib %in% .libPaths())) .libPaths(c(snowlib, .libPaths())) library(methods) ## because Rscript as of R 2.7.0 doesn't load methods library(rpvm) library(snow) sinkWorkerOutput(outfile) cat("starting PVM worker\n") slaveLoop(makePVMmaster()) .PVM.exit() }) snow/inst/RMPInode.sh0000755000176200001440000000016111564216477014204 0ustar liggesusers#! /bin/sh ${RPROG:-R} --vanilla < ${OUT:-/dev/null} 2>&1 library(Rmpi) library(snow) runMPIslave() EOF snow/inst/RNWSnode.R0000755000176200001440000000220311625450003013773 0ustar liggesuserslocal({ master <- "localhost" port <- "8765" snowlib <- Sys.getenv("R_SNOW_LIB") outfile <- Sys.getenv("R_SNOW_OUTFILE") args <- commandArgs() pos <- match("--args", args) args <- args[-(1 : pos)] for (a in args) { pos <- regexpr("=", a) name <- substr(a, 1, pos - 1) value <- substr(a,pos + 1, nchar(a)) switch(name, MASTER = master <- value, PORT = port <- value, SNOWLIB = snowlib <- value, OUT = outfile <- value, RANK = rank <- value, TMPWS = tmpWsName <- value) } ##**** these should be passed as arguments to makeNWSmaster Sys.setenv(MASTER = master) Sys.setenv(PORT = port) Sys.setenv(RANK = rank) Sys.setenv(TMPWS = tmpWsName) if (! (snowlib %in% .libPaths())) .libPaths(c(snowlib, .libPaths())) library(methods) ## because Rscript as of R 2.7.0 doesn't load methods library(nws) library(snow) sinkWorkerOutput(outfile) master <- makeNWSmaster() sendData(master, "ping") cat("starting NWS worker\n") slaveLoop(master) }) snow/inst/RNWSnode.sh0000755000176200001440000000030011564216477014221 0ustar liggesusers#! /bin/sh ${RPROG:-R} --vanilla < ${OUT:-/dev/null} 2>&1 & library(nws) library(snow) local({ master <- makeNWSmaster() sendData(master, "ping") slaveLoop(master) }) EOF snow/inst/RunSnowNode0000755000176200001440000000011211564216477014373 0ustar liggesusers#!/bin/sh export R_LIBS=${R_SNOW_LIB}:${R_LIBS} exec $R_SNOW_LIB/snow/$1 snow/inst/RPVMnode.sh0000755000176200001440000000021211564216477014216 0ustar liggesusers#! /bin/sh ${RPROG:-R} --vanilla < ${OUT:-/dev/null} 2>&1 library(rpvm) library(snow) slaveLoop(makePVMmaster()) .PVM.exit() EOF snow/inst/RMPISNOWprofile0000644000176200001440000000067311564216477015022 0ustar liggesuserslibrary(Rmpi) library(snow) .MPIrun <- function() { if (mpi.comm.rank(0) > 0){ sys.load.image(".RData",TRUE) .First.sys() sink(file="/dev/null") slaveLoop(makeMPImaster()) mpi.quit() } else { makeMPIcluster() .Last <<- function(){ cl <- getMPIcluster() if (! is.null(cl)) stopCluster(cl) mpi.quit() } } } .MPIrun() snow/inst/RSOCKnode.sh0000755000176200001440000000035711564216477014325 0ustar liggesusers#! /bin/sh # the & for backgrounding works in bash--does it work in other sh variants? ${RPROG:-R} --vanilla < ${OUT:-/dev/null} 2>&1 & library(snow) options(timeout=getClusterOption("timeout")) slaveLoop(makeSOCKmaster()) EOF snow/NAMESPACE0000644000176200001440000000010711620777306012466 0ustar liggesusers# Export all names unless they start with a dot exportPattern("^[^.]") snow/R/0000755000176200001440000000000012221074327011441 5ustar liggesuserssnow/R/sock.R0000644000176200001440000001255211620777306012541 0ustar liggesusers# # Socket Implementation # #**** allow user to be different on different machines #**** allow machines to be selected from a hosts list newSOCKnode <- function(machine = "localhost", ..., options = defaultClusterOptions, rank) { # **** allow some form of spec here # **** make sure options are quoted options <- addClusterOptions(options, list(...)) if (is.list(machine)) { options <- addClusterOptions(options, machine) machine <- machine$host } outfile <- getClusterOption("outfile", options) if (machine == "localhost") master <- "localhost" else master <- getClusterOption("master", options) port <- getClusterOption("port", options) manual <- getClusterOption("manual", options) ## build the local command for starting the worker homogeneous <- getClusterOption("homogeneous", options) if (getClusterOption("useRscript", options)) { if (homogeneous) { rscript <- shQuoteIfNeeded(getClusterOption("rscript", options)) snowlib <- getClusterOption("snowlib", options) script <- shQuoteIfNeeded(file.path(snowlib, "snow", "RSOCKnode.R")) env <- paste("MASTER=", master, " PORT=", port, " OUT=", outfile, " SNOWLIB=", snowlib, sep="") cmd <- paste(rscript, script, env) } else { script <- "RunSnowWorker RSOCKnode.R" env <- paste("MASTER=", master, " PORT=", port, " OUT=", outfile, sep="") cmd <- paste(script, env) } } else { if (homogeneous) { scriptdir <- getClusterOption("scriptdir", options) script <- shQuoteIfNeeded(file.path(scriptdir, "RSOCKnode.sh")) rlibs <- paste(getClusterOption("rlibs", options), collapse = ":") rprog <- shQuoteIfNeeded(getClusterOption("rprog", options)) env <- paste("MASTER=", master, " PORT=", port, " OUT=", outfile, " RPROG=", rprog, " R_LIBS=", rlibs, sep="") } else { script <- "RunSnowNode RSOCKnode.sh" env <- paste("MASTER=", master, " PORT=", port, " OUT=", outfile, sep="") } cmd <- paste("env", env, script) } if (manual) { cat("Manually start worker on", machine, "with\n ", cmd, "\n") flush.console() } else { ## add the remote shell command if needed if (machine != "localhost") { rshcmd <- getClusterOption("rshcmd", options) user <- getClusterOption("user", options) cmd <- paste(rshcmd, "-l", user, machine, cmd) } if (.Platform$OS.type == "windows") { ## On windows using input = something seems needed to ## disconnect standard input of an ssh process when run ## from Rterm (at least using putty's plink). In ## principle this could also be used for supplying a ## password, but that is probably a bad idea. So, for now ## at least, on windows password-less authentication is ## necessary. system(cmd, wait = FALSE, input = "") } else system(cmd, wait = FALSE) } ## need timeout here because of the way internals work timeout <- getClusterOption("timeout") old <- options(timeout = timeout); on.exit(options(old)) con <- socketConnection(port = port, server=TRUE, blocking=TRUE, open="a+b") structure(list(con = con, host = machine, rank = rank), class = "SOCKnode") } makeSOCKmaster <- function(master = Sys.getenv("MASTER"), port = Sys.getenv("PORT")) { port <- as.integer(port) ## maybe use `try' and sleep/retry if first time fails? ## need timeout here because of the way internals work timeout <- getClusterOption("timeout") old <- options(timeout = timeout); on.exit(options(old)) con <- socketConnection(master, port = port, blocking=TRUE, open="a+b") structure(list(con = con), class = "SOCKnode") } closeNode.SOCKnode <- function(node) close(node$con) sendData.SOCKnode <- function(node, data) { ## timeout <- getClusterOption("timeout") ## old <- options(timeout = timeout); ## on.exit(options(old)) serialize(data, node$con) } recvData.SOCKnode <- function(node) { ## timeout <- getClusterOption("timeout") ## old <- options(timeout = timeout); ## on.exit(options(old)) unserialize(node$con) } recvOneData.SOCKcluster <- function(cl) { socklist <- lapply(cl, function(x) x$con) repeat { ready <- socketSelect(socklist) if (length(ready) > 0) break; } n <- which(ready)[1] # may need rotation or some such for fairness list(node = n, value = unserialize(socklist[[n]])) } makeSOCKcluster <- function(names, ..., options = defaultClusterOptions) { if (is.numeric(names)) names <- rep('localhost', names[1]) options <- addClusterOptions(options, list(...)) cl <- vector("list",length(names)) for (i in seq(along=cl)) cl[[i]] <- newSOCKnode(names[[i]], options = options, rank = i) class(cl) <- c("SOCKcluster", "cluster") cl } snow/R/nws.R0000644000176200001440000002025512127310024012367 0ustar liggesusers# # NWS Implementation # # driver side newNWSnode <- function(machine = "localhost", tmpWsName, rank, ws, wsServer, state, options) { if (is.list(machine)) { options <- addClusterOptions(options, machine) machine <- machine$host } outfile <- getClusterOption("outfile", options) master <- getClusterOption("master", options) port <- getClusterOption("port", options) manual <- getClusterOption("manual", options) ## build the local command for starting the worker homogeneous <- getClusterOption("homogeneous", options) if (getClusterOption("useRscript", options)) { if (homogeneous) { rscript <- shQuoteIfNeeded(getClusterOption("rscript", options)) snowlib <- getClusterOption("snowlib", options) script <- shQuoteIfNeeded(file.path(snowlib, "snow", "RNWSnode.R")) env <- paste("MASTER=", master, " PORT=", port, " OUT=", outfile, " SNOWLIB=", snowlib, " RANK=", rank, " TMPWS=", tmpWsName, sep="") cmd <- paste(rscript, script, env) } else { script <- "RunSnowWorker RNWSnode.R" env <- paste("MASTER=", master, " PORT=", port, " OUT=", outfile, " RANK=", rank, " TMPWS=", tmpWsName, sep="") cmd <- paste(script, env) } } else { if (homogeneous) { scriptdir <- getClusterOption("scriptdir", options) script <- shQuoteIfNeeded(file.path(scriptdir, "RNWSnode.sh")) rlibs <- paste(getClusterOption("rlibs", options), collapse = ":") rprog <- shQuoteIfNeeded(getClusterOption("rprog", options)) env <- paste("MASTER=", master, " PORT=", port, " OUT=", outfile, " RANK=", rank, " TMPWS=", tmpWsName, " RPROG=", rprog, " R_LIBS=", rlibs, sep="") } else { script <- "RunSnowNode RNWSnode.sh" env <- paste("MASTER=", master, " PORT=", port, " OUT=", outfile, " RANK=", rank, " TMPWS=", tmpWsName, sep="") } cmd <- paste("env", env, script) } if (manual) { cat("Manually start worker on", machine, "with\n ", cmd, "\n") flush.console() } else { ## add the remote shell command if needed if (machine != "localhost") { rshcmd <- getClusterOption("rshcmd", options) user <- getClusterOption("user", options) cmd <- paste(rshcmd, "-l", user, machine, cmd) } if (.Platform$OS.type == "windows") { ## On windows using input = something seems needed to ## disconnect standard input of an ssh process when run ## from Rterm (at least using putty's plink). In ## principle this could also be used for supplying a ## password, but that is probably a bad idea. So, for now ## at least, on windows password-less authentication is ## necessary. system(cmd, wait = FALSE, input = "") } else system(cmd, wait = FALSE) } node <- structure(list(ws = ws, wsServer = wsServer, incomingVar = 'forDriver', outgoingVar = sprintf('forNode%04d', rank), rank = rank, state = state, mybuffer = sprintf('buffer%04d', rank), host = machine), class = "NWSnode") recvData(node) ## wait for "ping" from worker node } # compute engine side makeNWSmaster <- function() { if (! require(nws)) stop("the `nws' package is needed for NWS clusters.") ws <- netWorkSpace(tmpWs <- Sys.getenv("TMPWS"), serverHost = Sys.getenv("MASTER"), port = as.integer(Sys.getenv("PORT"))) rank = as.integer(Sys.getenv("RANK")) structure(list(ws = ws, outgoingVar = 'forDriver', incomingVar = sprintf('forNode%04d', rank), rank = rank), class = "NWSnode") } closeNode.NWSnode <- function(node) {} # note that all messages to the driver include the rank of the sender. # in a context where this information is not needed (and would be # unexpected), we strip it out. we can do this because the driver # signals its interest in the node's identity implicitly via a call to # recvOneData, rather than recvData. if this ever changes, we will have # to revisit this hack. sendData.NWSnode <- function(node, data) { if (node$outgoingVar == 'forDriver') data <- list(node = node$rank, data = data) nwsStore(node$ws, node$outgoingVar, data) } recvData.NWSnode <- function(node) { if (node$incomingVar != 'forDriver') { data <- nwsFetch(node$ws, node$incomingVar) } else { # first check if we have already received a message for this node if (! is.null(node$state[[node$mybuffer]])) { # cat("debug: found a buffered message for", node$rank, "\n") data <- node$state[[node$mybuffer]] node$state[[node$mybuffer]] <- NULL } else { repeat { # get the next message d <- nwsFetch(node$ws, node$incomingVar) # find out who this data is from rank <- d$node data <- d$data # if it's from worker node$rank, we're done if (rank == node$rank) { # cat("debug: received the right message for", rank, "\n") break } # it's not, so stash this in node$state$buffer, # issuing a warning if node$state$buffer is not empty # cat("debug: received a message for", rank, # "when I want one for", node$rank, "\n") k <- sprintf('buffer%04d', rank) if (! is.null(node$state[[k]])) warning("overwriting previous message") node$state[[k]] <- data } } } data } # only called from the driver and only when we care about # the source of the data. recvOneData.NWScluster <- function(cl) { # check if there is any previously received data # (I don't think there ever should be) for (i in seq(along=cl)) { bname <- sprintf('buffer%04d', i) if (! is.null(cl[[1]]$state[[bname]])) { # cat("debug: received a buffered message from node", i, "\n") warning("recvOneData called while there is buffered data", immediate.=TRUE) data <- cl[[1]]$state[[bname]] cl[[1]]$state[[bname]] <- NULL return(list(node = i, value = data)) } } d <- nwsFetch(cl[[1]]$ws, 'forDriver') # cat("debug: received a message from node", d$node, "\n") list(node = d$node, value = d$data) } makeNWScluster <- function(names=rep('localhost', 3), ..., options = defaultClusterOptions) { if (! require(nws)) stop("the `nws' package is needed for NWS clusters.") # this allows makeNWScluster to be called like makeMPIcluster and # makePVMcluster if (is.numeric(names)) names <- rep('localhost', names[1]) options <- addClusterOptions(options, list(port = 8765, scriptdir = path.package("snow"))) options <- addClusterOptions(options, list(...)) wsServer <- nwsServer(serverHost = getClusterOption("master", options), port = getClusterOption("port", options)) state <- new.env() tmpWsName = nwsMktempWs(wsServer, 'snow_nws_%04d') ws = nwsOpenWs(wsServer, tmpWsName) cl <- vector("list", length(names)) for (i in seq(along=cl)) cl[[i]] <- newNWSnode(names[[i]], tmpWsName = tmpWsName, rank = i, ws = ws, wsServer = wsServer, state = state, options = options) class(cl) <- c("NWScluster", "cluster") cl } stopCluster.NWScluster <- function(cl) { NextMethod() nwsDeleteWs(cl[[1]]$wsServer, nwsWsName(cl[[1]]$ws)) close(cl[[1]]$wsServer) } snow/R/snow.R0000644000176200001440000004403012127310024012543 0ustar liggesusers# # Utilities # docall <- function(fun, args) { if ((is.character(fun) && length(fun) == 1) || is.name(fun)) fun <- get(as.character(fun), envir = .GlobalEnv, mode = "function") do.call("fun", lapply(args, enquote)) } shQuoteIfNeeded <- function(p) { if (length(grep("[[:space:]]", p)) == 0) p else if (.Platform$OS.type == "windows") shQuote(p) else stop("file names with spaces do not work properly on this platform") } # # Checking and subsetting # checkCluster <- function(cl) { if (! inherits(cl, "cluster")) stop("not a valid cluster"); } "[.cluster" <-function(cl,...) { v<-unclass(cl)[...] class(v)<-class(cl) v } # # Slave Loop Function # slaveLoop <- function(master) { repeat tryCatch({ msg <- recvData(master) cat(paste("Type:", msg$type, "\n")) if (msg$type == "DONE") { closeNode(master) break; } else if (msg$type == "EXEC") { success <- TRUE ## This uses the message, rather than the exception since ## the exception class/methods may not be available on the ## master. handler <- function(e) { success <<- FALSE structure(conditionMessage(e), class=c("snow-try-error","try-error")) } t1 <- proc.time() value <- tryCatch(docall(msg$data$fun, msg$data$args), error = handler) t2 <- proc.time() value <- list(type = "VALUE", value = value, success = success, time = t2 - t1, tag = msg$data$tag) sendData(master, value) } }, interrupt = function(e) NULL) } sinkWorkerOutput <- function(outfile) { if (outfile != "") { if (.Platform$OS.type == "windows" && outfile == "/dev/null") outfile <- "nul:" outcon <- file(outfile, open = "w") sink(outcon) sink(outcon, type = "message") } } # # Higher-Level Node Functions # closeNode <- function(node) UseMethod("closeNode") closeNode.default <- function(node) {} sendData <- function(node, data) UseMethod("sendData") recvData <- function(node) UseMethod("recvData") postNode <- function(con, type, value = NULL, tag = NULL) { sendData(con, list(type = type, data = value, tag = tag)) } stopNode <- function(n) { postNode(n, "DONE") closeNode(n) } recvOneData <- function(cl) UseMethod("recvOneData") # # Cluster Creation and Destruction # defaultClusterOptions <- NULL #**** check valid cluster option initDefaultClusterOptions <- function(libname) { rhome <- Sys.getenv("R_HOME") if (Sys.getenv("R_SNOW_LIB") != "") homogeneous <- FALSE else homogeneous <- TRUE if (.Platform$OS.type == "windows") rscript <- file.path(rhome, "bin", "Rscript.exe") else rscript <- file.path(rhome, "bin", "Rscript") port <- 10187 port <- as.integer(Sys.getenv("R_PARALLEL_PORT")) if (is.na(port)) port <- 11000 + 1000 * ((stats::runif(1L) + unclass(Sys.time())/300) %% 1) options <- list(port = as.integer(port), timeout = 60 * 60 * 24 * 30, # 30 days master = Sys.info()["nodename"], homogeneous = homogeneous, type = NULL, outfile = "/dev/null", rhome = rhome, user = Sys.info()["user"], rshcmd = "ssh", rlibs = Sys.getenv("R_LIBS"), scriptdir = file.path(libname, "snow"), rprog = file.path(rhome, "bin", "R"), snowlib = libname, rscript = rscript, useRscript = file.exists(rscript), manual = FALSE) defaultClusterOptions <<- addClusterOptions(emptyenv(), options) } addClusterOptions <- function(options, new) { if (! is.null(new)) { options <- new.env(parent = options) names <- names(new) for (i in seq(along = new)) assign(names[i], new[[i]], envir = options) } options } getClusterOption <- function(name, options = defaultClusterOptions) get(name, envir = options) setDefaultClusterOptions <- function(...) { list <- list(...) names <- names(list) for (i in seq(along = list)) assign(names[i], list[[i]], envir = defaultClusterOptions) } makeCluster <- function(spec, type = getClusterOption("type"), ...) { if (is.null(type)) stop("need to specify a cluster type") switch(type, SOCK = makeSOCKcluster(spec, ...), PVM = makePVMcluster(spec, ...), MPI = makeMPIcluster(spec, ...), NWS = makeNWScluster(spec, ...), stop("unknown cluster type")) } stopCluster <- function(cl) UseMethod("stopCluster") stopCluster.default <- function(cl) for (n in cl) stopNode(n) # # Cluster Functions # sendCall <- function (con, fun, args, return = TRUE, tag = NULL) { #**** mark node as in-call timing <- .snowTimingData$running() if (timing) start <- proc.time()[3] postNode(con, "EXEC", list(fun = fun, args = args, return = return, tag = tag)) if (timing) .snowTimingData$enterSend(con$rank, start, proc.time()[3]) NULL } recvResult <- function (con) { if (.snowTimingData$running()) { start <- proc.time()[3] r <- recvData(con) end <- proc.time()[3] .snowTimingData$enterRecv(con$rank, start, end, r$time[3]) } else r <- recvData(con) r$value } checkForRemoteErrors <- function(val) { count <- 0 firstmsg <- NULL for (v in val) { if (inherits(v, "try-error")) { count <- count + 1 if (count == 1) firstmsg <- v } } if (count == 1) stop("one node produced an error: ", firstmsg) else if (count > 1) stop(count, " nodes produced errors; first error: ", firstmsg) val } clusterCall <- function(cl, fun, ...) { checkCluster(cl) for (i in seq(along = cl)) sendCall(cl[[i]], fun, list(...)) checkForRemoteErrors(lapply(cl, recvResult)) } staticClusterApply <- function(cl, fun, n, argfun) { checkCluster(cl) p <- length(cl) if (n > 0 && p > 0) { val <- vector("list", n) start <- 1 while (start <= n) { end <- min(n, start + p - 1) jobs <- end - start + 1 for (i in 1:jobs) sendCall(cl[[i]], fun, argfun(start + i - 1)) val[start:end] <- lapply(cl[1:jobs], recvResult) start <- start + jobs } checkForRemoteErrors(val) } } clusterApply <- function(cl, x, fun, ...) { argfun <- function(i) c(list(x[[i]]), list(...)) staticClusterApply(cl, fun, length(x), argfun) } clusterEvalQ<-function(cl, expr) clusterCall(cl, eval, substitute(expr), env=.GlobalEnv) clusterExport <- local({ gets <- function(n, v) { assign(n, v, envir = .GlobalEnv); NULL } function(cl, list, envir = .GlobalEnv) { ## do this with only one clusterCall--loop on slaves? for (name in list) { clusterCall(cl, gets, name, get(name, envir = envir)) } } }) ## A variant that does the exports one at at ime--this may be useful ## when large objects are being sent # clusterExportSerial <- function(cl, list) { # gets <- function(n, v) { assign(n, v, envir = .GlobalEnv); NULL } # for (name in list) { # v <- get(name, envir = .GlobalEnv) # for (i in seq(along = cl)) { # sendCall(cl[[i]], gets, list(name, v)) # recvResult(cl[[i]]) # } # } # } recvOneResult <- function (cl) { if (.snowTimingData$running()) { start <- proc.time()[3] v <- recvOneData(cl) end <- proc.time()[3] .snowTimingData$enterRecv(v$node, start, end, v$value$time[3]) } else v <- recvOneData(cl) list(value = v$value$value, node = v$node, tag = v$value$tag) } findRecvOneTag <- function(cl, anytag) { rtag <- NULL for (node in cl) { if (is.null(rtag)) rtag <- node$RECVTAG else if (rtag != node$RECVTAG) { rtag <- anytag break; } } rtag } dynamicClusterApply <- function(cl, fun, n, argfun) { checkCluster(cl) p <- length(cl) if (n > 0 && p > 0) { submit <- function(node, job) sendCall(cl[[node]], fun, argfun(job), tag = job) for (i in 1 : min(n, p)) submit(i, i) val <- vector("list", n) for (i in 1:n) { d <- recvOneResult(cl) j <- i + min(n, p) if (j <= n) submit(d$node, j) val[d$tag] <- list(d$value) } checkForRemoteErrors(val) } } clusterApplyLB <- function(cl, x, fun, ...) { ## **** this closure is sending all of x to all nodes argfun <- function(i) c(list(x[[i]]), list(...)) dynamicClusterApply(cl, fun, length(x), argfun) } ## **** should this allow load balancing? ## **** disallow recycling if one arg is length zero? clusterMap <- function (cl, fun, ..., MoreArgs = NULL, RECYCLE = TRUE) { checkCluster(cl) args <- list(...) if (length(args) == 0) stop("need at least one argument") n <- sapply(args, length) if (RECYCLE) { vlen <- max(n) if (!all(n == vlen)) for (i in 1:length(args)) args[[i]] <- rep(args[[i]], length = max(n)) } else vlen = min(n) ## **** this closure is sending all of ... to all nodes argfun <- function(i) c(lapply(args, function(x) x[[i]]), MoreArgs) staticClusterApply(cl, fun, vlen, argfun) } # # Cluster RNG Support # clusterSetupRNG <- function (cl, type="RNGstream", ...) { RNGnames <- c("RNGstream", "SPRNG") rng <- pmatch (type, RNGnames) if (is.na(rng)) stop(paste("'", type, "' is not a valid choice. Choose 'RNGstream' or 'SPRNG'.", sep = "")) type <- RNGnames[rng] if (rng == 1) clusterSetupRNGstream(cl, ...) else clusterSetupSPRNG(cl, ...) type } # # Cluster SPRNG Support # # adapted from rpvm (Li & Rossini) clusterSetupSPRNG <- function (cl, seed = round(2^32 * runif(1)), prngkind = "default", para = 0, ...) { if (!is.character(prngkind) || length(prngkind) > 1) stop("'rngkind' must be a character string of length 1.") if (!is.na(pmatch(prngkind, "default"))) prngkind <- "LFG" prngnames <- c("LFG", "LCG", "LCG64", "CMRG", "MLFG", "PMLCG") kind <- pmatch(prngkind, prngnames) - 1 if (is.na(kind)) stop(paste("'", prngkind, "' is not a valid choice", sep = "")) nc <- length(cl) invisible(clusterApply(cl, 0:(nc-1), initSprngNode, nc, seed, kind, para)) } initSprngNode <- function (streamno, nstream, seed, kind, para) { if (! require(rsprng)) stop("the `rsprng' package is needed for SPRNG support.") .Call("r_init_sprng", as.integer(kind), as.integer(streamno), as.integer(nstream), as.integer(seed), as.integer(para), PACKAGE = "rsprng") RNGkind("user") } # # rlecuyer support # clusterSetupRNGstream <- function (cl, seed=rep(12345,6), ...) { if (! require(rlecuyer)) stop("the `rlecuyer' package is needed for RNGstream support.") .lec.init() .lec.SetPackageSeed(seed) nc <- length(cl) names <- as.character(1:nc) .lec.CreateStream(names) states <- lapply(names, .lec.GetStateList) invisible(clusterApply(cl, states, initRNGstreamNode)) } initRNGstreamNode <- function (stream) { if (! require(rlecuyer)) stop("the `rlecuyer' package is needed for RNGstream support.") if (length(.lec.Random.seed.table$name) > 0) { rm(".lec.Random.seed.table", envir=.GlobalEnv) assign(".lec.Random.seed.table", list(Cg=matrix(0,nrow=0,ncol=6), Bg=matrix(0,nrow=0,ncol=6), Ig=matrix(0,nrow=0,ncol=6), AIP=matrix(0,nrow=0,ncol=2), name=c()), envir=.GlobalEnv) } .lec.Random.seed.table$Cg <<- rbind(.lec.Random.seed.table$Cg, stream$Cg[1:6]) .lec.Random.seed.table$Bg <<- rbind(.lec.Random.seed.table$Bg,stream$Bg) .lec.Random.seed.table$Ig <<- rbind(.lec.Random.seed.table$Ig,stream$Ig) .lec.Random.seed.table$AIP <<- rbind(.lec.Random.seed.table$AIP, c(stream$Anti, stream$IncPrec)) .lec.Random.seed.table$name <<- c(.lec.Random.seed.table$name, stream$name) old.kind<-.lec.CurrentStream(stream$name) old.kind } # # Parallel Functions # splitIndices <- function(nx, ncl) { batchsize <- if (nx %% ncl == 0) nx %/% ncl else 1 + nx %/% ncl batches <- (nx + batchsize - 1) %/% batchsize split(1:nx, rep(1:batches, each = batchsize)[1:nx]) } splitIndices <- function(nx, ncl) { i <- 1:nx; if (ncl == 1) i else structure(split(i, cut(i, ncl)), names=NULL) } # The fuzz used by cut() is too small when nx and ncl are both large # and causes some groups to be empty. The definition below avoids that # while minimizing changes from the results produced by the definition # above. splitIndices <- function(nx, ncl) { i <- 1:nx; if (ncl == 1) i else { fuzz <- min((nx - 1) / 1000, 0.4 * nx / ncl) breaks <- seq(1 - fuzz, nx + fuzz, length = ncl + 1) structure(split(i, cut(i, breaks)), names = NULL) } } clusterSplit <- function(cl, seq) lapply(splitIndices(length(seq), length(cl)), function(i) seq[i]) splitList <- function(x, ncl) lapply(splitIndices(length(x), ncl), function(i) x[i]) splitRows <- function(x, ncl) lapply(splitIndices(nrow(x), ncl), function(i) x[i,, drop=FALSE]) splitCols <- function(x, ncl) lapply(splitIndices(ncol(x), ncl), function(i) x[,i, drop=FALSE]) parLapply <- function(cl, x, fun, ...) docall(c, clusterApply(cl, splitList(x, length(cl)), lapply, fun, ...)) parRapply <- function(cl, x, fun, ...) docall(c, clusterApply(cl, splitRows(x,length(cl)), apply, 1, fun, ...)) parCapply <- function(cl, x, fun, ...) docall(c, clusterApply(cl, splitCols(x,length(cl)), apply, 2, fun, ...)) parMM <- function(cl, A, B) docall(rbind,clusterApply(cl, splitRows(A, length(cl)), get("%*%"), B)) # adapted from sapply in the R sources parSapply <- function (cl, X, FUN, ..., simplify = TRUE, USE.NAMES = TRUE) { FUN <- match.fun(FUN) # should this be done on slave? answer <- parLapply(cl,as.list(X), FUN, ...) if (USE.NAMES && is.character(X) && is.null(names(answer))) names(answer) <- X if (simplify && length(answer) != 0) { common.len <- unique(unlist(lapply(answer, length))) if (common.len == 1) unlist(answer, recursive = FALSE) else if (common.len > 1) array(unlist(answer, recursive = FALSE), dim = c(common.len, length(X)), dimnames = list(names(answer[[1]]), names(answer))) else answer } else answer } # adapted from apply in the R sources parApply <- function(cl, X, MARGIN, FUN, ...) { FUN <- match.fun(FUN) # should this be done on slave? ## Ensure that X is an array object d <- dim(X) dl <- length(d) if(dl == 0) stop("dim(X) must have a positive length") ds <- 1:dl # for compatibility with R versions prior to 1.7.0 if (! exists("oldClass")) oldClass <- class if(length(oldClass(X)) > 0) X <- if(dl == 2) as.matrix(X) else as.array(X) dn <- dimnames(X) ## Extract the margins and associated dimnames s.call <- ds[-MARGIN] s.ans <- ds[MARGIN] d.call <- d[-MARGIN] d.ans <- d[MARGIN] dn.call<- dn[-MARGIN] dn.ans <- dn[MARGIN] ## dimnames(X) <- NULL ## do the calls d2 <- prod(d.ans) if(d2 == 0) { ## arrays with some 0 extents: return ``empty result'' trying ## to use proper mode and dimension: ## The following is still a bit `hackish': use non-empty X newX <- array(vector(typeof(X), 1), dim = c(prod(d.call), 1)) ans <- FUN(if(length(d.call) < 2) newX[,1] else array(newX[,1], d.call, dn.call), ...) return(if(is.null(ans)) ans else if(length(d.call) < 2) ans[1][-1] else array(ans, d.ans, dn.ans)) } ## else newX <- aperm(X, c(s.call, s.ans)) dim(newX) <- c(prod(d.call), d2) if(length(d.call) < 2) {# vector if (length(dn.call)) dimnames(newX) <- c(dn.call, list(NULL)) arglist <- lapply(1:d2, function(i) newX[,i]) } else arglist <- lapply(1:d2, function(i) array(newX[,i], d.call, dn.call)) ans <- parLapply(cl, arglist, FUN, ...) ## answer dims and dimnames ans.list <- is.recursive(ans[[1]]) l.ans <- length(ans[[1]]) ans.names <- names(ans[[1]]) if(!ans.list) ans.list <- any(unlist(lapply(ans, length)) != l.ans) if(!ans.list && length(ans.names)) { all.same <- sapply(ans, function(x) identical(names(x), ans.names)) if (!all(all.same)) ans.names <- NULL } len.a <- if(ans.list) d2 else length(ans <- unlist(ans, recursive = FALSE)) if(length(MARGIN) == 1 && len.a == d2) { names(ans) <- if(length(dn.ans[[1]])) dn.ans[[1]] # else NULL return(ans) } if(len.a == d2) return(array(ans, d.ans, dn.ans)) if(len.a > 0 && len.a %% d2 == 0) return(array(ans, c(len.a %/% d2, d.ans), if(is.null(dn.ans)) { if(!is.null(ans.names)) list(ans.names,NULL) } else c(list(ans.names), dn.ans))) return(ans) } # # Library Initialization # .onLoad <- function(libname, pkgname) { initDefaultClusterOptions(libname) if (exists("mpi.comm.size")) type <- "MPI" else if (length(find.package("rpvm", quiet = TRUE)) != 0) type <- "PVM" else if (length(find.package("Rmpi", quiet = TRUE)) != 0) type <- "MPI" else if (length(find.package("nws", quiet = TRUE)) != 0) type <- "NWS" else type <- "SOCK" setDefaultClusterOptions(type = type) } snow/R/timing.R0000644000176200001440000001253611620777306013073 0ustar liggesusers## This approach uses a single global data structure to record timing ## information. The structure contains functions defined in a shared ## environment to implement mutable state. Workers are identified by ## their rank. The functions recvData, recvOneData, and sendCall have ## been modified to record timing information in timing is active. ## The overhead of the test for timing should be fairly small compared ## to the data transmissions. If we had an efficient dynamically ## scoped variable mechanism it would probably be better to use that ## instead of the global variable that is reset via on.exit. ## ## For now, calls to the timing function snow.time() cannot be nested. .snowTimingData <- local({ data <- NULL timerRunning <- function(run) { if (! missing(run)) { if (run) data <<- list(index = integer(0), data = NULL) else data <<- NULL } ! is.null(data) } incrementIndex <- function(rank) { n <- length(data$index) if (rank > n) data$index <<- c(data$index, rep(0L, rank - n)) data$index[rank] <<- data$index[rank] + 1L data$index[rank] } getIndex <- function(rank) { data$index[rank] } enterSend <- function(rank, start, end) { n <- length(data$data) if (rank > n) data$data <<- c(data$data, vector(mode = "list", rank - n)) if (is.null(data$data[[rank]])) { d <- matrix(NA_real_, 10, 5) colnames(d) <- c("send_start", "send_end", "recv_start", "recv_end", "exec") data$data[[rank]] <<- d } i <- incrementIndex(rank) nr <- nrow(data$data[[rank]]) if (nr < i) data$data[[rank]] <<- rbind(data$data[[rank]], matrix(NA_real_, nr, 5)) data$data[[rank]][i, 1:2] <<- c(start, end) } enterRecv <- function(rank, start, end, exec) { i <- getIndex(rank) data$data[[rank]][i, 3:5] <<- c(start, end, exec) } extractTimingData <- function() lapply(seq_along(data$data), function(i) { d <- data$data[[i]] n <- data$index[[i]] if (! is.null(d)) { d <- d[1:n,, drop = FALSE] d[, 3] <- pmax(d[, 3], d[, 2] + d[, 5]) d } }) list(running = timerRunning, enterSend = enterSend, enterRecv = enterRecv, extract = extractTimingData) }) snow.time <- function(expr) { if (.snowTimingData$running()) stop("nested snow.sime calls are currently not supported") .snowTimingData$running(TRUE) on.exit(.snowTimingData$running(FALSE)) start <- proc.time()[3] expr end <- proc.time()[3] data <- lapply(.snowTimingData$extract(), function(d) { if (! is.null(d)) { d[,1:4] <- d[,1:4] - start d } else NULL }) structure(list(elapsed = end - start, data = data), class = "snowTimingData") } plot.snowTimingData <- function(x, xlab = "Elapsed Time", ylab = "Node", title = "Cluster Usage", ...) { w2 <- 0.05 data <- x$data n <- length(data) r <- c(0, x$elapsed) plot(r, c(0 - w2, max(n, 1) + w2), xlab = xlab, ylab = ylab, type = "n", yaxt = "n", ...) axis(2, yaxp = c(0, n, max(n, 1))) title(title) ## show the information for the workers for (i in 0 : n) abline(i, 0, lty = 2) for (i in seq_along(data)) { d <- data[[i]] nr <- nrow(d) segments(d[, 1], rep(0, nr), d[, 2], rep(i, nr), col = "red") rect(d[, 2], rep(i - w2, nr), d[, 2] + d[, 5], rep(i + w2, nr), col = "green") segments(d[, 2] + d[, 5], rep(i, nr), d[, 3], rep(i, nr), col = "blue") segments(d[, 3], rep(i, nr), d[, 4], rep(0, nr), col = "red") } ## compute and draw the intervals where no worker is active if (length(data) > 0) { d <- do.call(rbind, data) times <- c(d[, 1], d[, 4]) ord <- order(times) cs <- cumsum(rep(c(1,-1), each = nrow(d))[ord]) st <- sort(times) left <- c(0, st[cs == 0]) right <- c(st[c(1, which(cs[-length(cs)] == 0) + 1)], x$elapsed) } else { left <- 0 right <- x$elapsed } rect(left, -w2, right, w2, col = "green") } print.snowTimingData <- function(x, ...) { data <- x$data send <- sum(unlist(lapply(data, function(d) if (is.null(d)) 0 else sum(d[,2] - d[,1])))) recv <- sum(unlist(lapply(data, function(d) if (is.null(d)) 0 else sum(d[,4] - d[,3])))) nodes <- sapply(data, function(d) if (is.null(d)) 0 else sum(d[,5])) n <- length(data) if (n > 0) nodeNames <- paste("node", 1:n) else nodeNames <- character(0) y <- structure(c(x$elapsed, send, recv, nodes), names = c("elapsed", "send", "receive", nodeNames)) print(y) invisible(x) } snow/R/mpi.R0000644000176200001440000001166411620777306012372 0ustar liggesusers# # MPI Implementation # newMPInode <- function(rank, comm) structure(list(rank = rank, RECVTAG = 33, SENDTAG = 22, comm = comm), class = "MPInode") makeMPImaster <- function(comm = 0) structure(list(rank = 0, RECVTAG = 22, SENDTAG = 33, comm = comm), class = "MPInode") sendData.MPInode <- function(node, data) mpi.send.Robj(data, node$rank, node$SENDTAG, node$comm) recvData.MPInode <- function(node) mpi.recv.Robj(node$rank, node$RECVTAG, node$comm) recvOneData.MPIcluster <- function(cl) { rtag <- findRecvOneTag(cl, mpi.any.tag()) comm <- cl[[1]]$comm # should all be the same status <- 0 mpi.probe(mpi.any.source(), rtag, comm, status) srctag <- mpi.get.sourcetag(status) data <- mpi.recv.Robj(srctag[1], srctag[2], comm) list(node = srctag[1], value = data) } getMPIcluster <- NULL setMPIcluster <- NULL local({ cl <- NULL getMPIcluster <<- function() cl setMPIcluster <<- function(new) cl <<- new }) makeMPIcluster <- function(count, ..., options = defaultClusterOptions) { options <- addClusterOptions(options, list(...)) cl <- getMPIcluster() if (! is.null(cl)) { if (missing(count) || count == length(cl)) cl else stop(sprintf("MPI cluster of size %d already running", length(cl))) } else if (missing(count)) { # assume something like mpirun -np count+1 has been used to start R count <- mpi.comm.size(0) - 1 if (count <= 0) stop("no nodes available.") cl <- vector("list",count) for (i in seq(along=cl)) cl[[i]] <- newMPInode(i, 0) class(cl) <- c("MPIcluster","cluster") setMPIcluster(cl) cl } else { # use process spawning to create cluster if (! require(Rmpi)) stop("the `Rmpi' package is needed for MPI clusters.") comm <- 1 intercomm <- 2 if (mpi.comm.size(comm) > 0) stop(paste("a cluster already exists", comm)) scriptdir <- getClusterOption("scriptdir", options) outfile <- getClusterOption("outfile", options) homogeneous <- getClusterOption("homogeneous", options) if (getClusterOption("useRscript", options)) { if (homogeneous) { rscript <- shQuoteIfNeeded(getClusterOption("rscript", options)) snowlib <- getClusterOption("snowlib", options) script <- shQuoteIfNeeded(file.path(snowlib, "snow", "RMPInode.R")) args <- c(script, paste("SNOWLIB=", snowlib, sep=""), paste("OUT=", outfile, sep="")) mpitask <- rscript } else { args <- c("RMPInode.R", paste("OUT=", outfile, sep="")) mpitask <- "RunSnowWorker" } } else { if (homogeneous) { script <- shQuoteIfNeeded(file.path(scriptdir, "RMPInode.sh")) rlibs <- paste(getClusterOption("rlibs", options), collapse = ":") rprog <- shQuoteIfNeeded(getClusterOption("rprog", options)) args <- c(paste("RPROG=", rprog, sep=""), paste("OUT=", outfile, sep=""), paste("R_LIBS=", rlibs, sep=""), script) } else { args <- c(paste("OUT=", outfile, sep=""), "RunSnowNode", "RMPInode.sh") } mpitask <- "/usr/bin/env" } count <- mpi.comm.spawn(slave = mpitask, slavearg = args, nslaves = count, intercomm = intercomm) if (mpi.intercomm.merge(intercomm, 0, comm)) { mpi.comm.set.errhandler(comm) mpi.comm.disconnect(intercomm) } else stop("Failed to merge the comm for master and slaves.") cl <- vector("list",count) for (i in seq(along=cl)) cl[[i]] <- newMPInode(i, comm) class(cl) <- c("spawnedMPIcluster", "MPIcluster", "cluster") setMPIcluster(cl) cl } } runMPIslave <- function() { comm <- 1 intercomm <- 2 mpi.comm.get.parent(intercomm) mpi.intercomm.merge(intercomm,1,comm) mpi.comm.set.errhandler(comm) mpi.comm.disconnect(intercomm) slaveLoop(makeMPImaster(comm)) mpi.comm.disconnect(comm) mpi.quit() } stopCluster.MPIcluster <- function(cl) { NextMethod() setMPIcluster(NULL) } stopCluster.spawnedMPIcluster <- function(cl) { comm <- 1 NextMethod() mpi.comm.disconnect(comm) } #**** figure out how to get mpi.quit called (similar issue for pvm?) #**** fix things so stopCluster works in both versions. #**** need .Last to make sure cluster is shut down on exit of master #**** figure out why the slaves busy wait under mpirun snow/R/pvm.R0000644000176200001440000000550411620777306012403 0ustar liggesusers# # PVM Implementation # newPVMnode <- function(where = "", options = defaultClusterOptions, rank) { # **** allow some form of spec here # **** make sure options are quoted scriptdir <- getClusterOption("scriptdir", options) outfile <- getClusterOption("outfile", options) homogeneous <- getClusterOption("homogeneous", options) if (getClusterOption("useRscript", options)) { if (homogeneous) { rscript <- shQuoteIfNeeded(getClusterOption("rscript", options)) snowlib <- getClusterOption("snowlib", options) script <- shQuoteIfNeeded(file.path(snowlib, "snow", "RPVMnode.R")) args <- c(script, paste("SNOWLIB=", snowlib, sep=""), paste("OUT=", outfile, sep="")) pvmtask <- rscript } else { args <- c("RPVMnode.R", paste("OUT=", outfile, sep="")) pvmtask <- "RunSnowWorker" } } else { if (homogeneous) { script <- shQuoteIfNeeded(file.path(scriptdir, "RPVMnode.sh")) rlibs <- paste(getClusterOption("rlibs", options), collapse = ":") rprog <- shQuoteIfNeeded(getClusterOption("rprog", options)) args <- c(paste("RPROG=", rprog, sep=""), paste("OUT=", outfile, sep=""), paste("R_LIBS=", rlibs, sep=""), script) } else args <- c(paste("OUT=", outfile, sep=""), "RunSnowNode", "RPVMnode.sh") pvmtask <- "/usr/bin/env" } tid <- .PVM.spawn(task=pvmtask, arglist = args, where = where) structure(list(tid = tid, RECVTAG = 33,SENDTAG = 22, rank = rank), class = "PVMnode") } makePVMmaster <- function() structure(list(tid = .PVM.parent (), RECVTAG = 22, SENDTAG = 33), class = "PVMnode") sendData.PVMnode <- function(node, data) { .PVM.initsend () .PVM.serialize(data, node$con) .PVM.send (node$tid, node$SENDTAG) } recvData.PVMnode <- function(node) { .PVM.recv (node$tid, node$RECVTAG) .PVM.unserialize(node$con) } recvOneData.PVMcluster <- function(cl) { rtag <- findRecvOneTag(cl, -1) binfo <- .PVM.bufinfo(.PVM.recv(-1, rtag)) for (i in seq(along = cl)) { if (cl[[i]]$tid == binfo$tid) { n <- i break } } data <- .PVM.unserialize() list(node = n, value = data) } makePVMcluster <- function(count, ..., options = defaultClusterOptions) { if (! require(rpvm)) stop("the `rpvm' package is needed for PVM clusters.") options <- addClusterOptions(options, list(...)) cl <- vector("list",count) for (i in seq(along=cl)) cl[[i]] <- newPVMnode(options = options, rank = i) class(cl) <- c("PVMcluster", "cluster") cl } snow/MD50000644000176200001440000000254612221306424011553 0ustar liggesuserscbb7fb175e8db1e51d6a82fca7025205 *DESCRIPTION e8edaef7a57ba16230ebe794beaa0959 *NAMESPACE a2cb431a26771f0a2904438d07441fb6 *R/mpi.R a0c0b94f0dd6282893a0607ef3a03600 *R/nws.R fe48794232a337521755c9fd19c6ef33 *R/pvm.R c2d9eca98a86c4c14477ed0cef52474b *R/snow.R e74b59b2a64eb707da3f14f5470da7d3 *R/sock.R 59d3c83000da91b34a6fbbd9e98f168b *R/timing.R f85cf256aaf8e467bddb4b46194fc2d2 *README c72517fa7fb7e4643e1dd1ad9b009e33 *inst/RMPISNOW e9b37f77f4c7bcd1706ab314020de791 *inst/RMPISNOWprofile de2b0457b3741eb3a31ff2cac593e127 *inst/RMPInode.R f5089d9a8447fee9d373cc8fa60574de *inst/RMPInode.sh f5e90dac233534be8c2d16c0a476bad3 *inst/RNWSnode.R 802c3c3658d2d1013ae4fc015aa060d3 *inst/RNWSnode.sh e7f48f5490678c7177fd909af75862d2 *inst/RPVMnode.R 4e470824e25d3dff1deb1ff636b84839 *inst/RPVMnode.sh 359b2a46b8335a8789bcf043b39bb713 *inst/RSOCKnode.R 124b492cc5baf1340e76c2822d10db0c *inst/RSOCKnode.sh 33f05b3ea71a95a24d42a8725665ec83 *inst/RunSnowNode 28d30ce64558eef7cac822ff090ebcdf *inst/RunSnowWorker 618bcd4abfbbc08f8c9df392de152497 *inst/RunSnowWorker.bat 9ad1de9d79cde60991f772fdca78f9f8 *man/snow-cluster.Rd 44b1cbbfa1fe978da1d367a6b73b5f4e *man/snow-internal.Rd 6dcb34ff5c1151176b87e9e7a353e038 *man/snow-parallel.Rd f32461fec0eccbeef5e2e29ab3787201 *man/snow-rand.Rd d04364aafd3d7f467adb6792342b22d6 *man/snow-startstop.Rd 31ba5f9fda5da83fbdac36eaf05c117f *man/snow-timing.Rd snow/README0000644000176200001440000001007611564216477012141 0ustar liggesusers SNOW: Simple Network of Workstations The snow package provides support for simple parallel computing on a network of workstations using R. A master R process calls makeCluster to start a cluster of worker processes; the master process then uses functions such as clusterCall and clusterApply to execute R code on the worker processes and collect and return the results on the master. This framework supports many forms of "embarrassingly parallel" computations. Snow can use one of four communications mechanisms: sockets, PVM, MPI, or NetWorkSpaces (NWS). NWS support was provided by Steve Weston. PVM clusters use the rpvm package; MPI clusters use package Rmpi; NWS clusters use package nws. If pvm is used, then pvm must be started, either using a pvm console (e.g the pvm text console or the graphical xpvm console, both available with pvm) or from R using functions provided by rpvm. Similarly, LAM-MPI must be started, e.g. using lamboot, for MPI clusters that use Rmpi and LAM-MPI. If NWS is used, the NetWorkSpaces server must be running. SOCK clusters are the easiest approach for using snow on a single multi-core computer as they require no additional software. CAUTION Be sure to call stopCluster before exiting R. Otherwise stray processes may remain running and need to be shut down manually. INSTALLATION PVM clusters require PVM and the rpvm package. MPI clusters require a suitable MPI implementation (e.g. LAM-MPI or Open MPI) and the Rmpi package. NWS clusters require the NetWorkSpaces server (a Python application) on one network accessible machine, and the nws package on all hosts used for a cluster. The rsprng and/or rlecuyer packages may also be useful to support parallel random number generation. These supporting R packages and the snow package should be installed in the same library directory. The snow package and supporting packages need to be available on all hosts that are to be used for a cluster. No further configuration should be needed for a homogeneous network of workstations with a common architecture, operating system, and common file system layout. If some hosts have different file system layouts, then SOCK and NWS clusters can use host specifications for the workers that specify where to find the snow package and the Rscript program to use. Alternatively, the file RunSnowWorker should be placed in a directory on the PATH of each host to be used for worker processes, and each such host should define the variable R_SNOW_LIB as the directory in which the snow package and supporting packages have been installed. Thus if snow has been installed with R CMD INSTALL snow -l $HOME/SNOW/R/lib then users with a csh shell would place something like setenv R_SNOW_LIB $HOME/SNOW/R/lib in their .cshrc files. Setting this variable to a nonempty value on the master as well ensures that the cluster startup mechanism assumes an inhomogeneous cluster by default. Rscript should also be on the PATH of the hosts used to run worker processes. Alternatively, you can define the environment variable R_SNOW_RSCRIPT_CMD to the path for Rscript, or you can edit edit the RunSnowWorker scripts to use a fully qualified path to the R shell script. For SOCK and NWS clusters the option manual = TRUE forces a manual startup mode in which the master prints the command to be run manually to start a worker process. Together with setting the outfile option this can be useful for debugging cluster startup. To date, snow has been used successfully with master and workers running on combinations of several flavors of Unix-like operating systems, including Linux, HP-UX and Mac OS X using PVM, NWS, LAM-MPI, or sockets. The socket version of snow has been run with a master on Linux or Windows Windows and workers on a combination of Windows, Linux, and Mac OS X; freeSSHd and Putty's plink were used for remote process startup on windows. The MPI version has been run on a single multi-core Windows machine using DeinoMPI; reports on experiences with MPICH2 on windows would be welcome. REFERENCE http://www.stat.uiowa.edu/~luke/R/cluster/cluster.html. snow/DESCRIPTION0000644000176200001440000000065412221306424012747 0ustar liggesusersPackage: snow Title: Simple Network of Workstations Version: 0.3-13 Author: Luke Tierney, A. J. Rossini, Na Li, H. Sevcikova Description: Support for simple parallel computing in R. Maintainer: Luke Tierney Suggests: Rmpi,rpvm,rlecuyer,rsprng,nws License: GPL Depends: R (>= 2.12.1), utils Packaged: 2013-09-26 18:14:45 UTC; luke NeedsCompilation: no Repository: CRAN Date/Publication: 2013-09-27 15:50:12 snow/man/0000755000176200001440000000000012221074327012013 5ustar liggesuserssnow/man/snow-internal.Rd0000644000176200001440000000635611620777306015125 0ustar liggesusers\name{snow-internal} \title{Internal SNOW Objects} \alias{runMPIslave} \alias{setMPIcluster} \alias{stopCluster.default} \alias{stopCluster.MPIcluster} \alias{stopCluster.spawnedMPIcluster} \alias{stopCluster.NWScluster} \alias{defaultClusterOptions} \alias{docall} \alias{slaveLoop} \alias{sinkWorkerOutput} \alias{newSOCKnode} \alias{makeSOCKmaster} \alias{closeNode.SOCKnode} \alias{sendData.SOCKnode} \alias{recvData.SOCKnode} \alias{newPVMnode} \alias{makePVMmaster} \alias{closeNode.PVMnode} \alias{sendData.PVMnode} \alias{recvData.PVMnode} \alias{newMPInode} \alias{makeMPImaster} \alias{closeNode.MPInode} \alias{sendData.MPInode} \alias{recvData.MPInode} \alias{newNWSnode} \alias{makeNWSmaster} \alias{closeNode.NWSnode} \alias{sendData.NWSnode} \alias{recvData.NWSnode} \alias{closeNode} \alias{closeNode.default} \alias{sendData} \alias{recvData} \alias{sendNode} \alias{postNode} \alias{stopNode} \alias{sendCall} \alias{recvResult} \alias{initSprngNode} \alias{initRNGstreamNode} \alias{splitIndices} \alias{splitList} \alias{splitRows} \alias{splitCols} \alias{addClusterOptions} \alias{initDefaultClusterOptions} \alias{findRecvOneTag} \alias{recvOneData} \alias{recvOneData.MPIcluster} \alias{recvOneData.PVMcluster} \alias{recvOneData.SOCKcluster} \alias{recvOneData.NWScluster} \alias{recvOneResult} \alias{getClusterOption} \alias{checkCluster} \alias{checkForRemoteErrors} \alias{staticClusterApply} \alias{dynamicClusterApply} \alias{[.cluster} \alias{shQuoteIfNeeded} \usage{ \method{stopCluster}{default}(cl) \method{stopCluster}{MPIcluster}(cl) \method{stopCluster}{spawnedMPIcluster}(cl) \method{stopCluster}{NWScluster}(cl) defaultClusterOptions addClusterOptions(options, new) initDefaultClusterOptions(libname) docall(fun, args) slaveLoop(master) sinkWorkerOutput(outfile) newSOCKnode(machine = "localhost", ..., options = defaultClusterOptions, rank) makeSOCKmaster(master = Sys.getenv("MASTER"), port = Sys.getenv("PORT")) \method{closeNode}{SOCKnode}(node) \method{sendData}{SOCKnode}(node, data) \method{recvData}{SOCKnode}(node) newPVMnode(where = "", options = defaultClusterOptions, rank) makePVMmaster() \method{sendData}{PVMnode}(node, data) \method{recvData}{PVMnode}(node) setMPIcluster(new) runMPIslave() newMPInode(rank, comm) makeMPImaster(comm) \method{sendData}{MPInode}(node, data) \method{recvData}{MPInode}(node) closeNode(node) \method{closeNode}{default}(node) sendData(node, data) recvData(node) postNode(con, type, value = NULL, tag = NULL) stopNode(n) sendCall(con, fun, args, return = TRUE, tag = NULL) recvResult(con) initSprngNode(streamno, nstream, seed, kind, para) initRNGstreamNode(stream) splitIndices(nx, ncl) splitList(x, ncl) splitRows(x, ncl) splitCols(x, ncl) findRecvOneTag(cl, anytag) recvOneData(cl) recvOneResult(cl) \method{recvOneData}{MPIcluster}(cl) \method{recvOneData}{PVMcluster}(cl) \method{recvOneData}{SOCKcluster}(cl) \method{recvOneData}{NWScluster}(cl) getClusterOption(name, options = defaultClusterOptions) checkCluster(cl) checkForRemoteErrors(val) staticClusterApply(cl, fun, n, argfun) dynamicClusterApply(cl, fun, n, argfun) \method{[}{cluster}(cl, ...) shQuoteIfNeeded(p) } \description{ Internal functions for the snow package. } \details{ These are not to be called by the user. } \keyword{internal} snow/man/snow-cluster.Rd0000644000176200001440000000767712001020150014745 0ustar liggesusers\name{snow-cluster} \title{Cluster-Level SNOW Functions} \alias{clusterSplit} \alias{clusterCall} \alias{clusterApply} \alias{clusterApplyLB} \alias{clusterEvalQ} \alias{clusterExport} \alias{clusterMap} \usage{ clusterSplit(cl, seq) clusterCall(cl, fun, ...) clusterApply(cl, x, fun, ...) clusterApplyLB(cl, x, fun, ...) clusterEvalQ(cl, expr) clusterExport(cl, list, envir = .GlobalEnv) clusterMap(cl, fun, ..., MoreArgs = NULL, RECYCLE = TRUE) } \arguments{ \item{cl}{cluster object} \item{fun}{function or character string naming a function} \item{expr}{expression to evaluate} \item{seq}{vector to split} \item{list}{character vector of variables to export} \item{envir}{environment from which t export variables} \item{x}{array} \item{...}{additional arguments to pass to standard function} \item{MoreArgs}{additional argument for \code{fun}} \item{RECYCLE}{logical; if true shorter arguments are recycled} } \description{ Functions for computing on a SNOW cluster. } \details{ These are the basic functions for computing on a cluster. All evaluations on the slave nodes are done using \code{tryCatch}. Currently an error is signaled on the master if any one of the nodes produces an error. More sophisticated approaches will be considered in the future. \code{clusterCall} calls a function \code{fun} with identical arguments \code{...} on each node in the cluster \code{cl} and returns a list of the results. \code{clusterEvalQ} evaluates a literal expression on each cluster node. It a cluster version of \code{evalq}, and is a convenience function defined in terms of \code{clusterCall}. \code{clusterApply} calls \code{fun} on the first cluster node with arguments \code{seq[[1]]} and \code{...}, on the second node with \code{seq[[2]]} and \code{...}, and so on. If the length of \code{seq} is greater than the number of nodes in the cluster then cluster nodes are recycled. A list of the results is returned; the length of the result list will equal the length of \code{seq}. \code{clusterApplyLB} is a load balancing version of \code{clusterApply}. if the length \code{p} of \code{seq} is greater than the number of cluster nodes \code{n}, then the first \code{n} jobs are placed in order on the \code{n} nodes. When the first job completes, the next job is placed on the available node; this continues until all jobs are complete. Using \code{clusterApplyLB} can result in better cluster utilization than using \code{clusterApply}. However, increased communication can reduce performance. Furthermore, the node that executes a particular job is nondeterministic, which can complicate ensuring reproducibility in simulations. \code{clusterMap} is a multi-argument version of \code{clusterApply}, analogous to \code{mapply}. If \code{RECYCLE} is true shorter arguments are recycled; otherwise, the result length is the length of the shortest argument. Cluster nodes are recycled if the length of the result is greater than the number of nodes. \code{clusterExport} assigns the values on the master of the variables named in \code{list} to variables of the same names in the global environments of each node. The environment on the master from which variables are exported defaults to the global environment. \code{clusterSplit} splits \code{seq} into one consecutive piece for each cluster and returns the result as a list with length equal to the number of cluster nodes. Currently the pieces are chosen to be close to equal in length. Future releases may attempt to use relative performance information about nodes to choose split proportional to performance. For more details see \url{http://www.stat.uiowa.edu/~luke/R/cluster/cluster.html}. } \examples{ \dontrun{ cl <- makeSOCKcluster(c("localhost","localhost")) clusterApply(cl, 1:2, get("+"), 3) clusterEvalQ(cl, library(boot)) x<-1 clusterExport(cl, "x") clusterCall(cl, function(y) x + y, 2) } } \keyword{programming} snow/man/snow-rand.Rd0000644000176200001440000000400511564216477014226 0ustar liggesusers\name{snow-rand} \title{Uniform Random Number Generation in SNOW Clusters} \alias{clusterSetupRNG} \alias{clusterSetupSPRNG} \alias{clusterSetupRNGstream} \usage{ clusterSetupRNG (cl, type = "RNGstream", ...) clusterSetupRNGstream (cl, seed=rep(12345,6), ...) clusterSetupSPRNG (cl, seed = round(2^32 * runif(1)), prngkind = "default", para = 0, ...) } \arguments{ \item{cl}{Cluster object.} \item{type}{\code{type="RNGstream"} (default) initializes the L'Ecuyer's RNG. \code{type="SPRNG"} initializes the SPRNG generator.} \item{...}{Arguments passed to the underlying function (see details bellow).} \item{seed}{Integer value (SPRNG) or a vector of six integer values (RNGstream) used as seed for the RNG.} \item{prngkind}{Character string naming generator type used with SPRNG.} \item{para}{Additional parameters for the generator.} } \description{ Initialize independent uniform random number streams to be used in a SNOW cluster. It uses either the L'Ecuyer's random number generator (package rlecuyer required) or the SPRNG generator (package rsprng required). } \details{ \code{clusterSetupRNG} calls (subject to its argument values) one of the other functions, passing arguments \code{(cl, ...)}. If the "SPRNG" type is used, then the function \code{clusterSetupSPRNG} is called. If the "RNGstream" type is used, then the function \code{clusterSetupRNGstream} is called. \code{clusterSetupSPRNG} loads the \code{rsprng} package and initializes separate streams on each node. For further details see the documentation of \code{init.sprng}. The generator on the master is not affected. \code{clusterSetupRNGstream} loads the \code{rlecuyer} package, creates one stream per node and distributes the stream states to the nodes. For more details see \url{http://www.stat.uiowa.edu/~luke/R/cluster/cluster.html}. } \examples{ \dontrun{ clusterSetupSPRNG(cl) clusterSetupSPRNG(cl, seed=1234) clusterSetupRNG(cl, seed=rep(1,6)) } } \keyword{programming} snow/man/snow-parallel.Rd0000644000176200001440000000303311564216477015076 0ustar liggesusers\name{snow-parallel} \title{Higher Level SNOW Functions} \alias{parLapply} \alias{parRapply} \alias{parCapply} \alias{parApply} \alias{parMM} \alias{parSapply} \usage{ parLapply(cl, x, fun, ...) parSapply(cl, X, FUN, ..., simplify = TRUE, USE.NAMES = TRUE) parApply(cl, X, MARGIN, FUN, ...) parRapply(cl, x, fun, ...) parCapply(cl, x, fun, ...) parMM(cl, A, B) } \arguments{ \item{cl}{cluster object} \item{fun}{function or character string naming a function} \item{X}{array to be used} \item{x}{matrix to be used} \item{FUN}{function or character string naming a function} \item{MARGIN}{vector specifying the dimensions to use.} \item{simplify}{logical; see \code{sapply}} \item{USE.NAMES}{logical; see \code{sapply}} \item{...}{additional arguments to pass to standard function} \item{A}{matrix} \item{B}{matrix} } \description{ Parallel versions of \code{apply} and related functions. } \details{ \code{parLapply}, \code{parSapply}, and \code{parApply} are parallel versions of \code{lapply}, \code{sapply}, and \code{apply}. \code{parRapply} and \code{parCapply} are parallel row and column \code{apply} functions for a matrix \code{x}; they may be slightly more efficient than \code{parApply}. \code{parMM} is a very simple(minded) parallel matrix multiply; it is intended as an illustration. For more details see \url{http://www.stat.uiowa.edu/~luke/R/cluster/cluster.html}. } \examples{ \dontrun{ cl <- makeSOCKcluster(c("localhost","localhost")) parSapply(cl, 1:20, get("+"), 3) } } \keyword{programming} snow/man/snow-startstop.Rd0000644000176200001440000001346012033616340015333 0ustar liggesusers\name{snow-startstop} \title{Starting and Stopping SNOW Clusters} \alias{getMPIcluster} \alias{makeMPIcluster} \alias{makePVMcluster} \alias{makeNWScluster} \alias{makeSOCKcluster} \alias{makeCluster} \alias{stopCluster} \alias{setDefaultClusterOptions} \usage{ makeCluster(spec, type = getClusterOption("type"), ...) stopCluster(cl) setDefaultClusterOptions(...) makeSOCKcluster(names, ..., options = defaultClusterOptions) makePVMcluster(count, ..., options = defaultClusterOptions) makeMPIcluster(count, ..., options = defaultClusterOptions) makeNWScluster(names, ..., options = defaultClusterOptions) getMPIcluster() } \arguments{ \item{spec}{cluster specification} \item{count}{number of nodes to create} \item{names}{character vector of node names} \item{options}{cluster options object} \item{cl}{cluster object} \item{...}{cluster option specifications} \item{type}{character; specifies cluster type.} } \description{ Functions to start and stop a SNOW cluster and to set default cluster options. } \details{ \code{makeCluster} starts a cluster of the specified or default type and returns a reference to the cluster. Supported cluster types are \code{"SOCK"}, \code{"PVM"}, \code{"MPI"}, and \code{"NWS"}. For \code{"PVM"} and \code{"MPI"} clusters the \code{spec} argument should be an integer specifying the number of slave nodes to create. For \code{"SOCK"} and \code{"NWS"} clusters \code{spec} should be a character vector naming the hosts on which slave nodes should be started; one node is started for each element in the vector. For \code{"SOCK"} and \code{"NWS"} clusters \code{spec} can also be an integer specifying the number of slaves nodes to create on the local machine. For \code{SOCK} and \code{NWS} clusters the \code{spec} can also be a list of machine specifications, each a list of named option values. Such a list must include a character value named \code{host} host specifying the name or address of the host to use. Any other option can be specified as well. For \code{SOCK} and \code{NWS} clusters this may be a more convenient alternative than inhomogeneous cluster startup procedure. The options \code{rscript} and \code{snowlib} are often useful; see the examples below. \code{stopCluster} should be called to properly shut down the cluster before exiting R. If it is not called it may be necessary to use external means to ensure that all slave processes are shut down. \code{setDefaultClusterOptions} can be used to specify alternate values for default cluster options. There are many options. The most useful ones are \code{type} and \code{homogeneous}. The default value of the \code{type} option is currently set to "MPI" if \pkg{Rmpi} is on the search path. Otherwise it is set to \code{"PVM"} if the \pkg{rpvm} package is available, to \code{"MPI"} if \pkg{Rmpi} is available but \pkg{rpvm} is not, and to \code{"SOCK"} if neither of these packages is found. The \code{homogeneous} option should be set to \code{FALSE} to specify that the startup procedure for inhomogeneous clusters is to be used; this requires some additional configuration. The default setting is \code{TRUE} unless the environment variable \code{R_SNOW_LIB} is defined on the master host with a non-empty value. The option\code{outfile} can be used to specify the file to which slave node output is to be directed. The default is \code{/dev/null}; during debugging of an installation it can be useful to set this to a proper file. On some systems setting \code{outfile} to \code{""} or to \code{/dev/tty} will result in worker output being sent tothe terminal running the master process. The functions \code{makeSOCKcluster}, \code{makePVMcluster}, \code{makeMPIcluster}, and \code{makeNWScluster} can be used to start a cluster of the corresponding type. In MPI configurations where process spawning is not available and something like \code{mpirun} is used to start a master and a set of slaves the corresponding cluster will have been pre-constructed and can be obtained with \code{getMPIcluster}. It is also possible to obtain a reference to the running cluster using \code{makeCluster} or \code{makeMPIcluster}. In this case the \code{count} argument can be omitted; if it is supplied, it must equal the number of nodes in the cluster. This interface is still experimental and subject to change. For SOCK and NWS clusters the option \code{manual = TRUE} forces a manual startup mode in which the master prints the command to be run manually to start a worker process. Together with setting the \code{outfile} option this can be useful for debugging cluster startup. For more details see \url{http://www.stat.uiowa.edu/~luke/R/cluster/cluster.html}. } \examples{ \dontrun{ ## Two workers run on the local machine as a SOCK cluster. cl <- makeCluster(c("localhost","localhost"), type = "SOCK") clusterApply(cl, 1:2, get("+"), 3) stopCluster(cl) ## Another approach to running on the local machine as a SOCK cluster. cl <- makeCluster(2, type = "SOCK") clusterApply(cl, 1:2, get("+"), 3) stopCluster(cl) ## A SOCK cluster with two workers on Mac OS X, two on Linux, and two ## on Windows: macOptions <- list(host = "owasso", rscript = "/Library/Frameworks/R.framework/Resources/bin/Rscript", snowlib = "/Library/Frameworks/R.framework/Resources/library") lnxOptions <- list(host = "itasca", rscript = "/usr/lib64/R/bin/Rscript", snowlib = "/home/luke/tmp/lib") winOptions <- list(host="192.168.1.168", rscript="C:/Program Files/R/R-2.7.1/bin/Rscript.exe", snowlib="C:/Rlibs") cl <- makeCluster(c(rep(list(macOptions), 2), rep(list(lnxOptions), 2), rep(list(winOptions), 2)), type = "SOCK") clusterApply(cl, 1:6, get("+"), 3) stopCluster(cl) } } \keyword{programming} snow/man/snow-timing.Rd0000644000176200001440000000311111564216477014566 0ustar liggesusers\name{snow-timing} \title{Timing SNOW Clusters} \alias{snow.time} \alias{plot.snowTimingData} \alias{print.snowTimingData} \usage{ snow.time(expr) \method{print}{snowTimingData}(x, ...) \method{plot}{snowTimingData}(x, xlab = "Elapsed Time", ylab = "Node", title = "Cluster Usage", ...) } \arguments{ \item{expr}{expression to evaluate} \item{x}{timing data object to plot or print} \item{xlab}{x axis label} \item{ylab}{y axis label} \item{title}{plot main title} \item{...}{additional arguments} } \description{ Experimental functions to collect and display timing data for cluster computations. } \details{ \code{snow.time} collects and returns and returns timing information for cluster usage in evaluating \code{expr}. The return value is an object of class \code{snowTimingData}; details of the return value are subject to change. The \code{print} method for \code{snowTimingData} objects shows the total elapsed time, the total communication time between master and worker nodes, and the compute time on each worker node. The \code{plot}, motivated by the display produced by \code{xpvm}, produces a Gantt chart of the computation, with green rectangles representing active computation, blue horizontal lines representing a worker waiting to return a result, and red lines representing master/worker communications. } \examples{ \dontrun{ cl <- makeCluster(2,type="SOCK") x <- rnorm(1000000) tm <- snow.time(clusterCall(cl, function(x) for (i in 1:100) sum(x), x)) print(tm) plot(tm) stopCluster(cl) } } \keyword{programming}