parallel-examples/foreach_ex_1.R

In tom-n-pdx/lpSolveS4: Title: Technology Forecasting using DEA (Data Envelopment Analysis)

#
# Parallel example using do parallel
# - from foreach vingette
#

library(foreach)

# Example foreach
x <- foreach(i=1:3) %do% sqrt(i)        # Specify i in foreach, returns list
x

# a & b are iteration variables
# Example foreach
x <- foreach(a=1:3, b=rep(10, 3)) %do% (a + b)
x

# Can use braces
x <- foreach(a=1:3, b=rep(10, 3)) %do% {
  a + b
}
x

# If itteration vars different length, get shorter of two values
x <- foreach(a=1:1000, b=rep(10, 2)) %do% {
  a + b
}
x

# Return a vector using .combine
# Use standard c - concat - to combine results
x <- foreach(i=1:3, .combine='c') %do% exp(i)
x

#
# Use cbind to combine into array
x <- foreach(i=1:4, .combine='cbind') %do% rnorm(4)
x

#
# Combine results with + - or another function
x <- foreach(i=1:4, .combine='+') %do% rnorm(4)
x

#
# Can write user function to combine
#
cfun <- function(a, b) NULL
x <- foreach(i=1:4, .combine='cfun') %do% rnorm(4)
x

#
# foreach knows if function takes many arguments like c, or specific number like 2
# Use multicombine if user function can take more then 2 args
cfun <- function(...) NULL
x <- foreach(i=1:4, .combine='cfun', .multicombine=TRUE) %do% rnorm(4)
x


#
# Can limit max number of values to combine at a time
#
cfun <- function(...) NULL
x <- foreach(i=1:4, .combine='cfun', .multicombine=TRUE, .maxcombine=10) %do% rnorm(4)
x

# library(doParallel)
library(doMC)
registerDoMC(cores=4)
#
# Can indicate if the results should be combined in order or not
#
foreach(i=4:1, .combine='c') %dopar% {
  Sys.sleep(3 * i)
  i
}

# Not guranteed in order
foreach(i=4:1, .combine='c', .inorder=FALSE) %dopar% {
  Sys.sleep(3 * i)
  i
}

#
# Itterators
# automaticlly generated by foreach from a vactor, etc.
# iterator package includes irnorm to gen random numbers
# usefull becuase don't gen whole list upfront - so less to pass around
#
library(iterators)
x <- foreach(a=irnorm(4, count=4), .combine='cbind') %do% a
x

set.seed(123)
x <- foreach(a=irnorm(4, count=1000), .combine='+') %do% a
x

# Equvalanst code - but less clear
# uses itterator icount
set.seed(123)
x <- foreach(icount(1000), .combine='+') %do% rnorm(4)
x

#
# Introduce parallel
#
x <- matrix(runif(500), 100)
y <- gl(2, 50)

library(randomForest)

# Serial calculation
rf <- foreach(ntree=rep(250, 4), .combine=combine) %do% randomForest(x, y, ntree=ntree)
rf

# Run in parallel
# Tell other process what must be loaded
rf <- foreach(ntree=rep(250, 4), .combine=combine, .packages='randomForest') %dopar%
  randomForest(x, y, ntree=ntree)
rf

#
# Can create a parallel version of apply
# Need to create as function to keep clean
#
applyKernel <- function(newX, FUN, d2, d.call, dn.call=NULL, ...) {
    foreach(i=1:d2) %dopar%
    FUN(array(newX[,i], d.call, dn.call), ...)
}
applyKernel(matrix(1:16, 4), mean, 4, 4)


#
# But can make more effecient - only send colume data needed
# This only sends a colume
#
applyKernel <- function(newX, FUN, d2, d.call, dn.call=NULL, ...) {
    foreach(x=iter(newX, by='col')) %dopar%
    FUN(array(x, d.call, dn.call), ...)
}
applyKernel(matrix(1:16, 4), mean, 4, 4)

#
# Setup to send a chunk of cols - not one col at a time
# use: iblkcol function
# code from hidden in vingette
#
iblkcol <- function(a, chunks) {
  n <- ncol(a)
  i <- 1
  nextElem <- function() {
    if (chunks <= 0 || n <= 0) stop('StopIteration')
    m <- ceiling(n / chunks)
    r <- seq(i, length=m)
    i <<- i + m
    n <<- n - m
    chunks <<- chunks - 1
    a[,r, drop=FALSE]
  }
  structure(list(nextElem=nextElem), class=c('iblkcol', 'iter'))
}
nextElem.iblkcol <- function(obj) obj$nextElem()

applyKernel <- function(newX, FUN, d2, d.call, dn.call=NULL, ...) {
  foreach(x=iblkcol(newX, 3), .combine='c', .packages='foreach') %dopar% {
    foreach(i=1:ncol(x)) %do% FUN(array(x[,i], d.call, dn.call), ...)
  }
}
applyKernel(matrix(1:16, 4), mean, 4, 4)


#
# Nested looping useing %:%
#

#
#

sim <- function(a, b) 10 * a + b
avec <- 1:2
bvec <- 1:4


x <- matrix(0, length(avec), length(bvec))
for (j in 1:length(bvec)) {
  for (i in 1:length(avec)) {
    x[i,j] <- sim(avec[i], bvec[j])
  }
}
x

#
# Using foreach
#
x <- foreach(b=bvec, .combine='cbind') %:%
  foreach(a=avec, .combine='c') %do% {
    sim(a, b)
  }
x