foreach/0000755000176200001440000000000013620065713011664 5ustar liggesusersforeach/NAMESPACE0000644000176200001440000000230213617101333013073 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method(accumulate,ifilteredforeach) S3method(accumulate,iforeach) S3method(accumulate,ixforeach) S3method(getErrorIndex,ifilteredforeach) S3method(getErrorIndex,iforeach) S3method(getErrorIndex,ixforeach) S3method(getErrorValue,ifilteredforeach) S3method(getErrorValue,iforeach) S3method(getErrorValue,ixforeach) S3method(getResult,ifilteredforeach) S3method(getResult,iforeach) S3method(getResult,ixforeach) S3method(iter,filteredforeach) S3method(iter,foreach) S3method(iter,xforeach) S3method(nextElem,ifilteredforeach) S3method(nextElem,iforeach) S3method(nextElem,ixforeach) export("%:%") export("%do%") export("%dopar%") export(accumulate) export(foreach) export(getDoParName) export(getDoParRegistered) export(getDoParVersion) export(getDoParWorkers) export(getDoSeqName) export(getDoSeqRegistered) export(getDoSeqVersion) export(getDoSeqWorkers) export(getErrorIndex) export(getErrorValue) export(getResult) export(getexports) export(makeAccum) export(registerDoSEQ) export(setDoPar) export(setDoSeq) export(times) export(when) import(iterators) importFrom(codetools,findGlobals) importFrom(utils,packageDescription) foreach/demo/0000755000176200001440000000000013612556305012613 5ustar liggesusersforeach/demo/sincSEQ.R0000644000176200001440000000165713612556305014254 0ustar liggesuserslibrary(foreach) # Define a function that creates an iterator that returns subvectors ivector <- function(x, chunks) { n <- length(x) i <- 1 nextEl <- 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 x[r] } obj <- list(nextElem=nextEl) class(obj) <- c('abstractiter', 'iter') obj } # Define the coordinate grid and figure out how to split up the work x <- seq(-10, 10, by=0.1) cat('Running sequentially\n') ntasks <- 4 # Compute the value of the sinc function at each point in the grid z <- foreach(y=ivector(x, ntasks), .combine=cbind) %do% { y <- rep(y, each=length(x)) r <- sqrt(x ^ 2 + y ^ 2) matrix(10 * sin(r) / r, length(x)) } # Plot the results as a perspective plot persp(x, x, z, ylab='y', theta=30, phi=30, expand=0.5, col="lightblue") foreach/demo/00Index0000644000176200001440000000006213612556305013743 0ustar liggesuserssincSEQ computation of the sinc function foreach/man/0000755000176200001440000000000013614034627012442 5ustar liggesusersforeach/man/foreach.Rd0000644000176200001440000001701513615517343014346 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/foreach.R, R/do.R, R/times.R \name{foreach} \alias{foreach} \alias{\%:\%} \alias{when} \alias{\%do\%} \alias{\%dopar\%} \alias{times} \title{foreach} \usage{ foreach( ..., .combine, .init, .final = NULL, .inorder = TRUE, .multicombine = FALSE, .maxcombine = if (.multicombine) 100 else 2, .errorhandling = c("stop", "remove", "pass"), .packages = NULL, .export = NULL, .noexport = NULL, .verbose = FALSE ) e1 \%:\% e2 when(cond) obj \%do\% ex obj \%dopar\% ex times(n) } \arguments{ \item{...}{one or more arguments that control how \code{ex} is evaluated. Named arguments specify the name and values of variables to be defined in the evaluation environment. An unnamed argument can be used to specify the number of times that \code{ex} should be evaluated. At least one argument must be specified in order to define the number of times \code{ex} should be executed. If multiple arguments are supplied, the number of times \code{ex} is evaluated is equal to the smallest number of iterations among the supplied arguments. See the examples.} \item{.combine}{function that is used to process the tasks results as they generated. This can be specified as either a function or a non-empty character string naming the function. Specifying 'c' is useful for concatenating the results into a vector, for example. The values 'cbind' and 'rbind' can combine vectors into a matrix. The values '+' and '*' can be used to process numeric data. By default, the results are returned in a list.} \item{.init}{initial value to pass as the first argument of the \code{.combine} function. This should not be specified unless \code{.combine} is also specified.} \item{.final}{function of one argument that is called to return final result.} \item{.inorder}{logical flag indicating whether the \code{.combine} function requires the task results to be combined in the same order that they were submitted. If the order is not important, then it setting \code{.inorder} to \code{FALSE} can give improved performance. The default value is `TRUE.} \item{.multicombine}{logical flag indicating whether the \code{.combine} function can accept more than two arguments. If an arbitrary \code{.combine} function is specified, by default, that function will always be called with two arguments. If it can take more than two arguments, then setting \code{.multicombine} to \code{TRUE} could improve the performance. The default value is \code{FALSE} unless the \code{.combine} function is \code{cbind}, \code{rbind}, or \code{c}, which are known to take more than two arguments.} \item{.maxcombine}{maximum number of arguments to pass to the combine function. This is only relevant if \code{.multicombine} is \code{TRUE}.} \item{.errorhandling}{specifies how a task evaluation error should be handled. If the value is "stop", then execution will be stopped via the \code{stop} function if an error occurs. If the value is "remove", the result for that task will not be returned, or passed to the \code{.combine} function. If it is "pass", then the error object generated by task evaluation will be included with the rest of the results. It is assumed that the combine function (if specified) will be able to deal with the error object. The default value is "stop".} \item{.packages}{character vector of packages that the tasks depend on. If \code{ex} requires a \code{R} package to be loaded, this option can be used to load that package on each of the workers. Ignored when used with \verb{\%do\%}.} \item{.export}{character vector of variables to export. This can be useful when accessing a variable that isn't defined in the current environment. The default value in \code{NULL}.} \item{.noexport}{character vector of variables to exclude from exporting. This can be useful to prevent variables from being exported that aren't actually needed, perhaps because the symbol is used in a model formula. The default value in \code{NULL}.} \item{.verbose}{logical flag enabling verbose messages. This can be very useful for trouble shooting.} \item{e1}{\code{foreach} object to merge.} \item{e2}{\code{foreach} object to merge.} \item{cond}{condition to evaluate.} \item{obj}{\code{foreach} object used to control the evaluation of \code{ex}.} \item{ex}{the \code{R} expression to evaluate.} \item{n}{number of times to evaluate the \code{R} expression.} } \description{ \verb{\%do\%} and \verb{\%dopar\%} are binary operators that operate on a \code{foreach} object and an \code{R} expression. The expression, \code{ex}, is evaluated multiple times in an environment that is created by the \code{foreach} object, and that environment is modified for each evaluation as specified by the \code{foreach} object. \verb{\%do\%} evaluates the expression sequentially, while \verb{\%dopar\%} evaluates it in parallel. The results of evaluating \code{ex} are returned as a list by default, but this can be modified by means of the \code{.combine} argument. } \details{ The \code{foreach} and \verb{\%do\%}/\verb{\%dopar\%} operators provide a looping construct that can be viewed as a hybrid of the standard \code{for} loop and \code{lapply} function. It looks similar to the \code{for} loop, and it evaluates an expression, rather than a function (as in \code{lapply}), but its purpose is to return a value (a list, by default), rather than to cause side-effects. This facilitates parallelization, but looks more natural to people that prefer \code{for} loops to \code{lapply}. The \verb{\%:\%} operator is the \emph{nesting} operator, used for creating nested foreach loops. Type \code{vignette("nested")} at the R prompt for more details. Parallel computation depends upon a \emph{parallel backend} that must be registered before performing the computation. The parallel backends available will be system-specific, but include \code{doParallel}, which uses R's built-in \pkg{parallel} package. Each parallel backend has a specific registration function, such as \code{registerDoParallel}. The \code{times} function is a simple convenience function that calls \code{foreach}. It is useful for evaluating an \code{R} expression multiple times when there are no varying arguments. This can be convenient for resampling, for example. } \examples{ # equivalent to rnorm(3) times(3) \%do\% rnorm(1) # equivalent to lapply(1:3, sqrt) foreach(i=1:3) \%do\% sqrt(i) # multiple ... arguments foreach(i=1:4, j=1:10) \%do\% sqrt(i+j) # equivalent to colMeans(m) m <- matrix(rnorm(9), 3, 3) foreach(i=1:ncol(m), .combine=c) \%do\% mean(m[,i]) # normalize the rows of a matrix in parallel, with parenthesis used to # force proper operator precedence # Need to register a parallel backend before this example will run # in parallel foreach(i=1:nrow(m), .combine=rbind) \%dopar\% (m[i,] / mean(m[i,])) # simple (and inefficient) parallel matrix multiply library(iterators) a <- matrix(1:16, 4, 4) b <- t(a) foreach(b=iter(b, by='col'), .combine=cbind) \%dopar\% (a \%*\% b) # split a data frame by row, and put them back together again without # changing anything d <- data.frame(x=1:10, y=rnorm(10)) s <- foreach(d=iter(d, by='row'), .combine=rbind) \%dopar\% d identical(s, d) # a quick sort function qsort <- function(x) { n <- length(x) if (n == 0) { x } else { p <- sample(n, 1) smaller <- foreach(y=x[-p], .combine=c) \%:\% when(y <= x[p]) \%do\% y larger <- foreach(y=x[-p], .combine=c) \%:\% when(y > x[p]) \%do\% y c(qsort(smaller), x[p], qsort(larger)) } } qsort(runif(12)) } \seealso{ \code{\link[iterators:iter]{iterators::iter}} } \keyword{utilities} foreach/man/foreach-ext.Rd0000644000176200001440000000440113615516467015145 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/foreach-ext.R, R/getsyms.R \name{foreach-ext} \alias{foreach-ext} \alias{makeAccum} \alias{accumulate} \alias{getResult} \alias{getErrorValue} \alias{getErrorIndex} \alias{accumulate.iforeach} \alias{getResult.iforeach} \alias{getErrorValue.iforeach} \alias{getErrorIndex.iforeach} \alias{accumulate.ixforeach} \alias{getResult.ixforeach} \alias{getErrorValue.ixforeach} \alias{getErrorIndex.ixforeach} \alias{accumulate.ifilteredforeach} \alias{getResult.ifilteredforeach} \alias{getErrorValue.ifilteredforeach} \alias{getErrorIndex.ifilteredforeach} \alias{getexports} \title{foreach extension functions} \usage{ makeAccum(it) accumulate(obj, result, tag, ...) getResult(obj, ...) getErrorValue(obj, ...) getErrorIndex(obj, ...) \method{accumulate}{iforeach}(obj, result, tag, ...) \method{getResult}{iforeach}(obj, ...) \method{getErrorValue}{iforeach}(obj, ...) \method{getErrorIndex}{iforeach}(obj, ...) \method{accumulate}{ixforeach}(obj, result, tag, ...) \method{getResult}{ixforeach}(obj, ...) \method{getErrorValue}{ixforeach}(obj, ...) \method{getErrorIndex}{ixforeach}(obj, ...) \method{accumulate}{ifilteredforeach}(obj, result, tag, ...) \method{getResult}{ifilteredforeach}(obj, ...) \method{getErrorValue}{ifilteredforeach}(obj, ...) \method{getErrorIndex}{ifilteredforeach}(obj, ...) getexports(ex, e, env, good = character(0), bad = character(0)) } \arguments{ \item{it}{foreach iterator.} \item{obj}{foreach iterator object.} \item{result}{task result to accumulate.} \item{tag}{tag of task result to accumulate.} \item{...}{unused.} \item{ex}{call object to analyze.} \item{e}{local environment of the call object.} \item{env}{exported environment in which call object will be evaluated.} \item{good}{names of symbols that are being exported.} \item{bad}{names of symbols that are not being exported.} } \description{ These functions are used to write parallel backends for the \code{foreach} package. They should not be used from normal scripts or packages that use the \code{foreach} package. } \section{Note}{ These functions are likely to change in future versions of the \code{foreach} package. When they become more stable, they will be documented. } \keyword{utilities} foreach/man/registerDoSEQ.Rd0000644000176200001440000000117713616332573015422 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/do.R \name{registerDoSEQ} \alias{registerDoSEQ} \title{registerDoSEQ} \usage{ registerDoSEQ() } \description{ The \code{registerDoSEQ} function is used to explicitly register a sequential parallel backend with the foreach package. This will prevent a warning message from being issued if the \verb{\%dopar\%} function is called and no parallel backend has been registered. } \examples{ # specify that \%dopar\% should run sequentially registerDoSEQ() } \seealso{ \code{\link[doParallel:registerDoParallel]{doParallel::registerDoParallel}} } \keyword{utilities} foreach/man/getDoSeqWorkers.Rd0000644000176200001440000000237713615516467016042 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/getDoSeq.R \name{getDoSeqWorkers} \alias{getDoSeqWorkers} \alias{getDoSeqRegistered} \alias{getDoSeqName} \alias{getDoSeqVersion} \title{Functions Providing Information on the doSeq Backend} \usage{ getDoSeqRegistered() getDoSeqWorkers() getDoSeqName() getDoSeqVersion() } \description{ The \code{getDoSeqWorkers} function returns the number of execution workers there are in the currently registered doSeq backend. A \code{1} is returned by default. The \code{getDoSeqRegistered} function returns TRUE if a doSeq backend has been registered, otherwise FALSE. The \code{getDoSeqName} function returns the name of the currently registered doSeq backend. A \code{NULL} is returned if no backend is registered. The \code{getDoSeqVersion} function returns the version of the currently registered doSeq backend. A \code{NULL} is returned if no backend is registered. } \examples{ cat(sprintf('\%s backend is registered\n', if(getDoSeqRegistered()) 'A' else 'No')) cat(sprintf('Running with \%d worker(s)\n', getDoSeqWorkers())) (name <- getDoSeqName()) (ver <- getDoSeqVersion()) if (getDoSeqRegistered()) cat(sprintf('Currently using \%s [\%s]\n', name, ver)) } \keyword{utilities} foreach/man/setDoPar.Rd0000644000176200001440000000143513615516467014465 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/setDoPar.R \name{setDoPar} \alias{setDoPar} \title{setDoPar} \usage{ setDoPar(fun, data = NULL, info = function(data, item) NULL) } \arguments{ \item{fun}{A function that implements the functionality of \verb{\%dopar\%}.} \item{data}{Data to be passed to the registered function.} \item{info}{Function that retrieves information about the backend.} } \description{ The \code{setDoPar} function is used to register a parallel backend with the foreach package. This isn't normally executed by the user. Instead, packages that provide a parallel backend provide a function named \code{registerDoPar} that calls \code{setDoPar} using the appropriate arguments. } \seealso{ \code{\link{\%dopar\%}} } \keyword{utilities} foreach/man/getDoParWorkers.Rd0000644000176200001440000000252713615516467016031 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/getDoPar.R \name{getDoParWorkers} \alias{getDoParWorkers} \alias{getDoParRegistered} \alias{getDoParName} \alias{getDoParVersion} \title{Functions Providing Information on the doPar Backend} \usage{ getDoParWorkers() getDoParRegistered() getDoParName() getDoParVersion() } \description{ The \code{getDoParWorkers} function returns the number of execution workers there are in the currently registered doPar backend. It can be useful when determining how to split up the work to be executed in parallel. A \code{1} is returned by default. The \code{getDoParRegistered} function returns TRUE if a doPar backend has been registered, otherwise FALSE. The \code{getDoParName} function returns the name of the currently registered doPar backend. A \code{NULL} is returned if no backend is registered. The \code{getDoParVersion} function returns the version of the currently registered doPar backend. A \code{NULL} is returned if no backend is registered. } \examples{ cat(sprintf('\%s backend is registered\n', if(getDoParRegistered()) 'A' else 'No')) cat(sprintf('Running with \%d worker(s)\n', getDoParWorkers())) (name <- getDoParName()) (ver <- getDoParVersion()) if (getDoParRegistered()) cat(sprintf('Currently using \%s [\%s]\n', name, ver)) } \keyword{utilities} foreach/man/setDoSeq.Rd0000644000176200001440000000144113615516467014470 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/setDoSeq.R \name{setDoSeq} \alias{setDoSeq} \title{setDoSeq} \usage{ setDoSeq(fun, data = NULL, info = function(data, item) NULL) } \arguments{ \item{fun}{A function that implements the functionality of \verb{\%dopar\%}.} \item{data}{Data to be passed to the registered function.} \item{info}{Function that retrieves information about the backend.} } \description{ The \code{setDoSeq} function is used to register a sequential backend with the foreach package. This isn't normally executed by the user. Instead, packages that provide a sequential backend provide a function named \code{registerDoSeq} that calls \code{setDoSeq} using the appropriate arguments. } \seealso{ \code{\link{\%dopar\%}} } \keyword{utilities} foreach/man/foreach-package.Rd0000644000176200001440000000356013616052666015742 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/foreach-pkg.R \docType{package} \name{foreach-package} \alias{foreach-package} \alias{_PACKAGE} \alias{foreach_package} \title{The Foreach Package} \description{ The foreach package provides a new looping construct for executing R code repeatedly. The main reason for using the foreach package is that it supports parallel execution. The foreach package can be used with a variety of different parallel computing systems, include NetWorkSpaces and snow. In addition, foreach can be used with iterators, which allows the data to specified in a very flexible way. } \details{ Further information is available in the following help topics: \tabular{ll}{ \code{foreach} \tab Specify the variables to iterate over\cr \verb{\%do\%} \tab Execute the R expression sequentially\cr \verb{\%dopar\%} \tab Execute the R expression using the currently registered backend } To see a tutorial introduction to the foreach package, use \code{vignette("foreach")}. To see a demo of foreach computing the sinc function, use \code{demo(sincSEQ)}. Some examples (in addition to those in the help pages) are included in the "examples" directory of the foreach package. To list the files in the examples directory, use \code{list.files(system.file("examples", package="foreach"))}. To run the bootstrap example, use \code{source(system.file("examples", "bootseq.R", package="foreach"))}. For a complete list of functions with individual help pages, use \code{library(help="foreach")}. } \seealso{ Useful links: \itemize{ \item \url{https://github.com/RevolutionAnalytics/foreach} \item Report bugs at \url{https://github.com/RevolutionAnalytics/foreach/issues} } } \author{ \strong{Maintainer}: Hong Ooi \email{hongooi@microsoft.com} Authors: \itemize{ \item Microsoft [copyright holder] \item Steve Weston } } \keyword{internal} foreach/DESCRIPTION0000644000176200001440000000306413620065713013375 0ustar liggesusersPackage: foreach Type: Package Title: Provides Foreach Looping Construct Version: 1.4.8 Authors@R: c(person("Hong", "Ooi", role="cre", email="hongooi@microsoft.com"), person("Microsoft", role=c("aut", "cph")), person("Steve", "Weston", role="aut")) Description: Support for the foreach looping construct. Foreach is an idiom that allows for iterating over elements in a collection, without the use of an explicit loop counter. This package in particular is intended to be used for its return value, rather than for its side effects. In that sense, it is similar to the standard lapply function, but doesn't require the evaluation of a function. Using foreach without side effects also facilitates executing the loop in parallel. License: Apache License (== 2.0) URL: https://github.com/RevolutionAnalytics/foreach BugReports: https://github.com/RevolutionAnalytics/foreach/issues Depends: R (>= 2.5.0) Imports: codetools, utils, iterators Suggests: randomForest, doMC, doParallel, testthat, knitr, rmarkdown VignetteBuilder: knitr RoxygenNote: 7.0.2 Collate: 'callCombine.R' 'foreach.R' 'do.R' 'foreach-ext.R' 'foreach-pkg.R' 'getDoPar.R' 'getDoSeq.R' 'getsyms.R' 'iter.R' 'nextElem.R' 'onLoad.R' 'setDoPar.R' 'setDoSeq.R' 'times.R' 'utils.R' NeedsCompilation: no Packaged: 2020-02-06 21:25:18 UTC; hongo Author: Hong Ooi [cre], Microsoft [aut, cph], Steve Weston [aut] Maintainer: Hong Ooi Repository: CRAN Date/Publication: 2020-02-09 20:30:03 UTC foreach/build/0000755000176200001440000000000013617102076012763 5ustar liggesusersforeach/build/vignette.rds0000644000176200001440000000032213617102076015317 0ustar liggesusersuM @Wִ/]":t]?B/F:|<Ra>U :[a%4-.Up#:Ƭ-rB+'{{>u0 pgdٕ>A'~]yb*-vF4lﮪ_ it0 CuaG }[5cP}foreach/tests/0000755000176200001440000000000013614346047013033 5ustar liggesusersforeach/tests/testthat/0000755000176200001440000000000013620065713014666 5ustar liggesusersforeach/tests/testthat/test_nested.R0000644000176200001440000000160413614335671017341 0ustar liggesuserscontext("Nesting") test_that("do x do works", { y <- foreach(j=seq(0, 90, by=10), .combine='c', .packages='foreach') %do% { foreach(k=seq(1, 10), .combine='c') %do% { (j+k) } } expect_equal(y, 1:100) }) test_that("do x dopar works", { y <- foreach(j=seq(0, 90, by=10), .combine='c', .packages='foreach') %do% { foreach(k=seq(1, 10), .combine='c') %dopar% { (j+k) } } expect_equal(y, 1:100) }) test_that("dopar x do works", { y <- foreach(j=seq(0, 90, by=10), .combine='c', .packages='foreach') %dopar% { foreach(k=seq(1, 10), .combine='c') %do% { (j+k) } } expect_equal(y, 1:100) }) test_that("dopar x dopar works", { y <- foreach(j=seq(0, 90, by=10), .combine='c', .packages='foreach') %dopar% { foreach(k=seq(1, 10), .combine='c') %dopar% { (j+k) } } expect_equal(y, 1:100) }) foreach/tests/testthat/test_foreach.R0000644000176200001440000000107713614446036017470 0ustar liggesuserscontext("Foreach") test_that("foreach works", { x <- 1:3 actual <- foreach(i=x) %do% i expect_identical(actual, as.list(x)) actual <- foreach(i=x, .combine='c') %do% i expect_identical(actual, x) }) test_that("foreach works 2", { x <- 1:101 actual <- foreach(i=x, .combine='+') %dopar% i expect_equal(actual, sum(x)) }) test_that("foreach works 3", { x <- 1:3 y <- 2:0 for (i in 1:3) { actual <- foreach(i=x, .combine='c', .inorder=TRUE) %dopar% { Sys.sleep(y[i]) i } expect_equal(actual, x) } }) foreach/tests/testthat/test_merge.R0000644000176200001440000000272413614335431017154 0ustar liggesuserscontext("Merge") test_that("packages works", { f <- foreach(i=1:3, .packages='foo') %:% foreach(j=1:3, .packages='bar') expect_equal(sort(f$packages), c('bar', 'foo')) f <- foreach(i=1:3, .packages='foo') %:% foreach(j=1:3, .packages=c('bar', 'foo')) expect_equal(sort(f$packages), c('bar', 'foo')) f <- foreach(i=1:3, .packages='foo') %:% foreach(j=1:3, .packages=c('bar', 'baz')) expect_equal(sort(f$packages), c('bar', 'baz', 'foo')) f <- foreach(i=1:3, .packages='foo') %:% foreach(j=1:3) expect_equal(sort(f$packages), c('foo')) }) test_that("export works", { f <- foreach(i=1:3, .export='foo') %:% foreach(j=1:3, .export='bar') expect_equal(sort(f$export), c('bar', 'foo')) f <- foreach(i=1:3, .export='foo') %:% foreach(j=1:3, .export=c('bar', 'foo')) expect_equal(sort(f$export), c('bar', 'foo')) f <- foreach(i=1:3, .export='foo') %:% foreach(j=1:3, .export=c('bar', 'baz')) expect_equal(sort(f$export), c('bar', 'baz', 'foo')) f <- foreach(i=1:3, .export='foo') %:% foreach(j=1:3) expect_equal(sort(f$export), c('foo')) f <- foreach(i=1:3, .noexport='foo') %:% foreach(j=1:3, .noexport=c('bar', 'foo')) expect_equal(sort(f$noexport), c('bar', 'foo')) f <- foreach(i=1:3, .noexport='foo') %:% foreach(j=1:3, .noexport=c('bar', 'baz')) expect_equal(sort(f$noexport), c('bar', 'baz', 'foo')) f <- foreach(i=1:3, .noexport='foo') %:% foreach(j=1:3) expect_equal(sort(f$noexport), c('foo')) }) foreach/tests/testthat/test_localdopar.R0000644000176200001440000000264513614530133020173 0ustar liggesuserscontext("Local dopar") opt <- getOption("foreachDoparLocal") backend <- Sys.getenv("FOREACH_BACKEND", "SEQ") if(backend == "SEQ") { cat(" Sequential backend") test_that("Global dopar works, sequential backend", { options(foreachDoparLocal=FALSE) a <- 0 foreach(i=1:10) %do% { a <- a + 1 } expect_identical(a, 10) b <- 0 foreach(i=1:10) %dopar% { b <- b + 1 } expect_identical(b, 10) }) test_that("Local dopar works, sequential backend", { options(foreachDoparLocal=TRUE) a <- 0 foreach(i=1:10) %do% { a <- a + 1 } expect_identical(a, 10) b <- 0 foreach(i=1:10) %dopar% { b <- b + 1 } expect_identical(b, 0) }) } else { cat(" Parallel backend") test_that("Global dopar works, parallel backend", { options(foreachDoparLocal=FALSE) a <- 0 foreach(i=1:10) %do% { a <- a + 1 } expect_identical(a, 10) b <- 0 foreach(i=1:10) %dopar% { b <- b + 1 } expect_identical(b, 0) }) test_that("Global dopar works, parallel backend", { options(foreachDoparLocal=TRUE) a <- 0 foreach(i=1:10) %do% { a <- a + 1 } expect_identical(a, 10) b <- 0 foreach(i=1:10) %dopar% { b <- b + 1 } expect_identical(b, 0) }) } teardown(options(foreachDoparLocal=opt)) foreach/tests/testthat/test_packages.R0000644000176200001440000000032113614332327017623 0ustar liggesuserscontext("Packages") test_that("Package loading works", { d <- foreach(1:10, .packages='splines', .combine='c') %dopar% xyVector(c(1:3), c(4:6))[[1]] expect_true(all(c(1:3) == d)) }) foreach/tests/testthat/test_exportbug.R0000644000176200001440000000062013614334324020065 0ustar liggesuserscontext("Object export bug test") test_that("do and dopar work", { mB <- c(1, 2, 1, 3, 4, 10) MO <- c("Full", "noYS", "noYZ", "noYSZS", "noS", "noZ", "noY", "justS", "justZ", "noSZ", "noYSZ") testouts <- foreach(i = seq_along(mB)) %do% { MO[mB[i]] } testouts2 <- foreach(i = seq_along(mB)) %dopar% { MO[mB[i]] } expect_identical(testouts, testouts2) })foreach/tests/testthat/setup_cluster.R0000644000176200001440000000060013616054457017716 0ustar liggesusersmethod <- Sys.getenv("FOREACH_BACKEND", "SEQ") if(method == "PAR") { cl <- parallel::makeCluster(2, type="PSOCK") .Last <- function() { parallel::stopCluster(cl) } doParallel::registerDoParallel(cl) } else if(method == 'MC') { doMC::registerDoMC() } else if(method == 'SEQ') { registerDoSEQ() } else { stop('illegal backend specified: ', method) } foreach/tests/testthat/test_stress.R0000644000176200001440000000051213614336047017375 0ustar liggesuserscontext("Stress testing") test_that("Large iteration counts work", { m <- 1000 # number of vectors for (n in c(100, 1000, 4000, 10000)) { r <- foreach(x=irnorm(n, mean=1000, count=m), .combine='+') %dopar% sqrt(x) expect_true(is.atomic(r)) expect_is(r, 'numeric') expect_true(length(r) == n) } })foreach/tests/testthat/test_when.R0000644000176200001440000000215413614336446017022 0ustar liggesuserscontext("When") test_that("when works", { actual <- foreach(i=1:5) %:% when(i %% 2 == 1) %:% foreach(j=1:5) %:% when(j %% 2 == 1 && i != j) %do% c(i, j) expected <- list(list(c(1, 3), c(1, 5)), list(c(3, 1), c(3, 5)), list(c(5, 1), c(5, 3))) expect_equal(actual, expected) actual <- foreach(i=1:5, .combine='c') %:% when(i %% 2 == 1) %:% foreach(j=1:5) %:% when(j %% 2 == 1 && i != j) %do% c(i, j) expected <- list(c(1, 3), c(1, 5), c(3, 1), c(3, 5), c(5, 1), c(5, 3)) expect_equal(actual, expected) }) test_that("when works 2", { qsort <- function(x) { n <- length(x) if (n == 0) { x } else { p <- sample(n, 1) smaller <- foreach(y=x[-p], .combine=c) %:% when(y <= x[p]) %do% y larger <- foreach(y=x[-p], .combine=c) %:% when(y > x[p]) %do% y c(qsort(smaller), x[p], qsort(larger)) } } x <- runif(100) a <- qsort(x) b <- sort(x) expect_identical(a, b) }) foreach/tests/testthat/test_combine.R0000644000176200001440000000261513614333044017466 0ustar liggesuserscontext("Combining") test_that("cbind and rbind work", { m <- matrix(rnorm(25 * 16), 25) x <- foreach(i=seq_len(ncol(m)), .combine='cbind') %do% m[, i] dimnames(x) <- NULL expect_identical(m, x) x <- foreach(i=seq_len(ncol(m)), .combine='cbind') %dopar% m[, i] dimnames(x) <- NULL expect_identical(m, x) x <- foreach(i=seq_len(nrow(m)), .combine='rbind') %do% m[i, ] dimnames(x) <- NULL expect_identical(m, x) x <- foreach(i=seq_len(nrow(m)), .combine='rbind') %dopar% m[i, ] dimnames(x) <- NULL expect_identical(m, x) }) test_that("Arithmetic ops work", { x <- rnorm(100) d <- foreach(i=x, .combine='+') %do% i expect_equal(d, sum(x)) d <- foreach(i=x, .combine='+') %dopar% i expect_equal(d, sum(x)) d <- foreach(i=x, .combine='*') %do% i expect_equal(d, prod(x)) d <- foreach(i=x, .combine='*') %dopar% i expect_equal(d, prod(x)) }) test_that("Custom combining function works", { x <- 1:10 adder <- function(...) { sum(...) } d <- foreach(i=x, .combine=adder, .multicombine=TRUE) %dopar% i expect_equal(d, sum(x)) d <- foreach(i=x, .combine=adder, .multicombine=FALSE) %dopar% i expect_equal(d, sum(x)) d <- foreach(i=x, .combine=adder, .multicombine=TRUE) %do% i expect_equal(d, sum(x)) d <- foreach(i=x, .combine=adder, .multicombine=FALSE) %do% i expect_equal(d, sum(x)) }) foreach/tests/testthat/test_loadfactor.R0000644000176200001440000000100113614335236020161 0ustar liggesuserscontext("Load factor") test_that("Nesting foreach works", { x <- c(1, 10, 100, 1000, 10000) y <- c(1, 10, 100, 1000, 10000) d <- expand.grid(x=x, y=y) foreach(i=seq_along(d$x), .combine='c') %do% { r <- foreach(icount(10), .combine='c') %do% (3 + 8) foreach(i=seq_along(r)) %do% expect_equal(r[i], 11L) } foreach(i=seq_along(d$x), .combine='c') %do% { r <- foreach(icount(10), .combine='c') %dopar% (3 + 8) foreach(i=seq_along(r)) %do% expect_equal(r[i], 11L) } }) foreach/tests/testthat/test_iterator.R0000644000176200001440000000176613614334614017715 0ustar liggesuserscontext("Iterators") test_that("Matrix iterator works", { m <- matrix(rnorm(25 * 16), 25) x <- foreach(col=iter(m, by='col'), .combine='cbind') %do% col expect_equal(m, x) x <- foreach(col=iter(m, by='col'), .combine='cbind') %dopar% col expect_equal(m, x) x <- foreach(row=iter(m, by='row'), .combine='rbind') %do% row expect_equal(m, x) x <- foreach(row=iter(m, by='row'), .combine='rbind') %dopar% row expect_equal(m, x) }) test_that("Data frame iterator works", { d <- data.frame(a=1:10, b=11:20, c=21:30) ed <- data.matrix(d) x <- foreach(col=iter(d, by='col'), .combine='cbind') %do% col colnames(x) <- colnames(ed) expect_equal(ed, x) x <- foreach(col=iter(d, by='col'), .combine='cbind') %dopar% col colnames(x) <- colnames(ed) expect_equal(ed, x) x <- foreach(row=iter(d, by='row'), .combine='rbind') %do% row expect_equal(d, x) x <- foreach(row=iter(d, by='row'), .combine='rbind') %dopar% row expect_equal(d, x) }) foreach/tests/testthat/test_error.R0000644000176200001440000000201313614335357017204 0ustar liggesuserscontext("Error handling") test_that("stop throws error", { x <- 1:3 expect_error(foreach(i=x) %do% if (i == 2) stop('error') else i) expect_error( foreach(i=x, .errorhandling='stop') %do% if (i == 2) stop('error') else i) }) test_that("remove removes error", { x <- 1:3 actual <- foreach(i=x, .errorhandling='remove') %do% if (i == 2) stop('error') else i expect_equal(actual, list(1L, 3L)) actual <- foreach(i=x, .errorhandling='remove') %do% stop('remove') expect_equal(actual, list()) }) test_that("pass returns condition object", { x <- 1:3 actual <- foreach(i=x, .errorhandling='pass') %do% if (i == 2) stop('error') else i expect_equal(1L, actual[[1]]) expect_is(actual[[2]], 'simpleError') expect_equal(3L, actual[[3]]) }) test_that("nested error handling works", { n <- 3 actual <- foreach(icount(n)) %:% foreach(icount(10), .errorhandling='remove') %do% stop('hello') expect_equal(actual, lapply(1:n, function(i) list())) }) foreach/tests/testthat.R0000644000176200001440000000023713614446344015021 0ustar liggesuserslibrary(testthat) library(foreach) Sys.setenv(FOREACH_BACKEND="SEQ") test_check("foreach") Sys.setenv(FOREACH_BACKEND="PAR") test_check("foreach") foreach/vignettes/0000755000176200001440000000000013617102076013674 5ustar liggesusersforeach/vignettes/foreach.Rmd0000644000176200001440000004405613615517321015761 0ustar liggesusers--- title: Using the `foreach` package author: Steve Weston output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{foreach} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{utf8} --- _Converted to RMarkdown by Hong Ooi_ ## Introduction One of R's most useful features is its interactive interpreter. This makes it very easy to learn and experiment with R. It allows you to use R like a calculator to perform arithmetic operations, display data sets, generate plots, and create models. Before too long, new R users will find a need to perform some operation repeatedly. Perhaps they want to run a simulation repeatedly in order to find the distribution of the results. Perhaps they need to execute a function with a variety a different arguments passed to it. Or maybe they need to create a model for many different data sets. Repeated executions can be done manually, but it becomes quite tedious to execute repeated operations, even with the use of command line editing. Fortunately, R is much more than an interactive calculator. It has its own built-in language that is intended to automate tedious tasks, such as repeatedly executing R calculations. R comes with various looping constructs that solve this problem. The `for` loop is one of the more common looping constructs, but the `repeat` and `while` statements are also quite useful. In addition, there is the family of "apply" functions, which includes `apply`, `lapply`, `sapply`, `eapply`, `mapply`, `rapply`, and others. The `foreach` package provides a new looping construct for executing R code repeatedly. With the bewildering variety of existing looping constructs, you may doubt that there is a need for yet another construct. The main reason for using the `foreach` package is that it supports _parallel execution_, that is, it can execute those repeated operations on multiple processors/cores on your computer, or on multiple nodes of a cluster. If each operation takes over a minute, and you want to execute it hundreds of times, the overall runtime can take hours. But using `foreach`, that operation can be executed in parallel on hundreds of processors on a cluster, reducing the execution time back down to minutes. But parallel execution is not the only reason for using the `foreach` package. There are other reasons that you might choose to use it to execute quick executing operations, as we will see later in the document. ## Getting Started Let's take a look at a simple example use of the `foreach` package. Assuming that you have the `foreach` package installed, you first need to load it: ```{r loadLibs} library(foreach) ``` Note that all of the packages that `foreach` depends on will be loaded as well. Now I can use `foreach` to execute the `sqrt` function repeatedly, passing it the values 1 through 3, and returning the results in a list, called `x`. (Of course, `sqrt` is a vectorized function, so you would never really do this. But later, we'll see how to take advantage of vectorized functions with `foreach`.) ```{r ex1} x <- foreach(i=1:3) %do% sqrt(i) x ``` This is a bit odd looking, because it looks vaguely like a `for` loop, but is implemented using a binary operator, called `%do%`. Also, unlike a `for` loop, it returns a value. This is quite important. The purpose of this statement is to compute the list of results. Generally, `foreach` with `%do%` is used to execute an R expression repeatedly, and return the results in some data structure or object, which is a list by default. You will note in the previous example that we used a variable `i` as the argument to the `sqrt` function. We specified the values of the `i` variable using a named argument to the `foreach` function. We could have called that variable anything we wanted, for example, `a`, or `b`. We could also specify other variables to be used in the R expression, as in the following example: ```{r ex2} x <- foreach(a=1:3, b=rep(10, 3)) %do% (a + b) x ``` Note that parentheses are needed here. We can also use braces: ```{r ex3} x <- foreach(a=1:3, b=rep(10, 3)) %do% { a + b } x ``` We call `a` and `b` the _iteration variables_, since those are the variables that are changing during the multiple executions. Note that we are iterating over them in parallel, that is, they are both changing at the same time. In this case, the same number of values are being specified for both iteration variables, but that need not be the case. If we only supplied two values for `b`, the result would be a list of length two, even if we specified a thousand values for `a`: ```{r ex4} x <- foreach(a=1:1000, b=rep(10, 2)) %do% { a + b } x ``` Note that you can put multiple statements between the braces, and you can use assignment statements to save intermediate values of computations. However, if you use an assignment as a way of communicating between the different executions of your loop, then your code won't work correctly in parallel, which we will discuss later. \section{The `.combine` Option} So far, all of our examples have returned a list of results. This is a good default, since a list can contain any R object. But sometimes we'd like the results to be returned in a numeric vector, for example. This can be done by using the `.combine` option to `foreach`: ```{r ex5} x <- foreach(i=1:3, .combine='c') %do% exp(i) x ``` The result is returned as a numeric vector, because the standard R `c` function is being used to concatenate all the results. Since the `exp` function returns numeric values, concatenating them with the `c` function will result in a numeric vector of length three. What if the R expression returns a vector, and we want to combine those vectors into a matrix? One way to do that is with the `cbind` function: ```{r ex6} x <- foreach(i=1:4, .combine='cbind') %do% rnorm(4) x ``` This generates four vectors of four random numbers, and combines them by column to produce a 4 by 4 matrix. We can also use the `"+"` or `"*"` functions to combine our results: ```{r ex7} x <- foreach(i=1:4, .combine='+') %do% rnorm(4) x ``` You can also specify a user-written function to combine the results. Here's an example that throws away the results: ```{r ex7.1} cfun <- function(a, b) NULL x <- foreach(i=1:4, .combine='cfun') %do% rnorm(4) x ``` Note that this `cfun` function takes two arguments. The `foreach` function knows that the functions `c`, `cbind`, and `rbind` take many arguments, and will call them with up to 100 arguments (by default) in order to improve performance. But if any other function is specified (such as `"+"`), it assumes that it only takes two arguments. If the function does allow many arguments, you can specify that using the `.multicombine` argument: ```{r ex7.2} cfun <- function(...) NULL x <- foreach(i=1:4, .combine='cfun', .multicombine=TRUE) %do% rnorm(4) x ``` If you want the combine function to be called with no more than 10 arguments, you can specify that using the `.maxcombine` option: ```{r ex7.3} cfun <- function(...) NULL x <- foreach(i=1:4, .combine='cfun', .multicombine=TRUE, .maxcombine=10) %do% rnorm(4) x ``` The `.inorder` option is used to specify whether the order in which the arguments are combined is important. The default value is `TRUE`, but if the combine function is `"+"`, you could specify `.inorder` to be `FALSE`. Actually, this option is important only when executing the R expression in parallel, since results are always computed in order when running sequentially. This is not necessarily true when executing in parallel, however. In fact, if the expressions take very different lengths of time to execute, the results could be returned in any order. Here's a contrived example, that executes the tasks in parallel to demonstrate the difference. The example uses the `Sys.sleep` function to cause the earlier tasks to take longer to execute: ```{r ex7.4} foreach(i=4:1, .combine='c') %dopar% { Sys.sleep(3 * i) i } foreach(i=4:1, .combine='c', .inorder=FALSE) %dopar% { Sys.sleep(3 * i) i } ``` The results of the first of these two examples is guaranteed to be the vector `c(4, 3, 2, 1)`. The second example will return the same values, but they will probably be in a different order. ## Iterators The values for the iteration variables don't have to be specified with only vectors or lists. They can be specified with an _iterator_, many of which come with the `iterators` package. An iterator is an abstract source of data. A vector isn't itself an iterator, but the `foreach` function automatically creates an iterator from a vector, list, matrix, or data frame, for example. You can also create an iterator from a file or a data base query, which are natural sources of data. The `iterators` package supplies a function called `irnorm` which can return a specified number of random numbers for each time it is called. For example: ```{r ex8} library(iterators) x <- foreach(a=irnorm(4, count=4), .combine='cbind') %do% a x ``` This becomes useful when dealing with large amounts of data. Iterators allow the data to be generated on-the-fly, as it is needed by your operations, rather than requiring all of the data to be generated at the beginning. For example, let's say that we want to sum together a thousand random vectors: ```{r ex9} set.seed(123) x <- foreach(a=irnorm(4, count=1000), .combine='+') %do% a x ``` This uses very little memory, since it is equivalent to the following `while` loop: ```{r ex10} set.seed(123) x <- numeric(4) i <- 0 while (i < 1000) { x <- x + rnorm(4) i <- i + 1 } x ``` This could have been done using the `icount` function, which generates the values from one to 1000: ```{r ex11} set.seed(123) x <- foreach(icount(1000), .combine='+') %do% rnorm(4) x ``` but sometimes it's preferable to generate the actual data with the iterator (as we'll see later when we execute in parallel). In addition to introducing the `icount` function from the `iterators` package, the last example also used an unnamed argument to the `foreach` function. This can be useful when we're not intending to generate variable values, but only controlling the number of times that the R expression is executed. There's a lot more that I could say about iterators, but for now, let's move on to parallel execution. ## Parallel Execution Although `foreach` can be a useful construct in its own right, the real point of the `foreach` package is to do parallel computing. To make any of the previous examples run in parallel, all you have to do is to replace `%do%` with `%dopar%`. But for the kinds of quick running operations that we've been doing, there wouldn't be much point to executing them in parallel. Running many tiny tasks in parallel will usually take more time to execute than running them sequentially, and if it already runs fast, there's no motivation to make it run faster anyway. But if the operation that we're executing in parallel takes a minute or longer, there starts to be some motivation. ### Parallel Random Forest Let's take random forest as an example of an operation that can take a while to execute. Let's say our inputs are the matrix `x`, and the factor `y`: ```{r ex12.data} x <- matrix(runif(500), 100) y <- gl(2, 50) ``` We've already loaded the `foreach` package, but we'll also need to load the `randomForest` package: ```{r ex12.load} library(randomForest) ``` If we want want to create a random forest model with a 1000 trees, and our computer has four cores in it, we can split up the problem into four pieces by executing the `randomForest` function four times, with the `ntree` argument set to 250. Of course, we have to combine the resulting `randomForest` objects, but the `randomForest` package comes with a function called `combine` that does just that. Let's do that, but first, we'll do the work sequentially: ```{r ex12.seq} rf <- foreach(ntree=rep(250, 4), .combine=combine) %do% randomForest(x, y, ntree=ntree) rf ``` To run this in parallel, we need to change `\%do\%`, but we also need to use another `foreach` option called `.packages` to tell the `foreach` package that the R expression needs to have the `randomForest` package loaded in order to execute successfully. Here's the parallel version: ```{r ex12.par} rf <- foreach(ntree=rep(250, 4), .combine=combine, .packages='randomForest') %dopar% randomForest(x, y, ntree=ntree) rf ``` If you've done any parallel computing, particularly on a cluster, you may wonder why I didn't have to do anything special to handle `x` and `y`. The reason is that the `dopar` function noticed that those variables were referenced, and that they were defined in the current environment. In that case `%dopar%` will automatically export them to the parallel execution workers once, and use them for all of the expression evaluations for that `foreach` execution. That is true for functions that are defined in the current environment as well, but in this case, the function is defined in a package, so we had to specify the package to load with the `.packages` option instead. ### Parallel Apply Now let's take a look at how to make a parallel version of the standard R `apply` function. The `apply` function is written in R, and although it's only about 100 lines of code, it's a bit difficult to understand on a first reading. However, it all really comes down two `for` loops, the slightly more complicated of which looks like: ```{r ex13.orig} applyKernel <- function(newX, FUN, d2, d.call, dn.call=NULL, ...) { ans <- vector("list", d2) for(i in 1:d2) { tmp <- FUN(array(newX[,i], d.call, dn.call), ...) if(!is.null(tmp)) ans[[i]] <- tmp } ans } applyKernel(matrix(1:16, 4), mean, 4, 4) ``` I've turned this into a function, because otherwise, R will complain that I'm using `...` in an invalid context. This could be executed using `foreach` as follows: ```{r ex13.first} 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 this approach will cause the entire `newX` array to be sent to each of the parallel execution workers. Since each task needs only one column of the array, we'd like to avoid this extra data communication. One way to solve this problem is to use an iterator that iterates over the matrix by column: ```{r ex13.second} 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) ``` Now we're only sending any given column of the matrix to one parallel execution worker. But it would be even more efficient if we sent the matrix in bigger chunks. To do that, we use a function called `iblkcol` that returns an iterator that will return multiple columns of the original matrix. That means that the R expression will need to execute the user's function once for every column in its submatrix. ```{r ex13.iter, results="hide"} 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() ``` ```{r ex13.third} 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) ``` Note the use of the `%do%` inside the `%dopar%` to call the function on the columns of the submatrix `x`. Now that we're using `%do%` again, it makes sense for the iterator to be an index into the matrix `x`, since `%do%` doesn't need to copy `x` the way that `%dopar%` does. ## List Comprehensions If you're familiar with the Python programming language, it may have occurred to you that the `foreach` package provides something that is not too different from Python's _list comprehensions_. In fact, the `foreach` package also includes a function called `when` which can prevent some of the evaluations from happening, very much like the "if" clause in Python's list comprehensions. For example, you could filter out negative values of an iterator using `when` as follows: ```{r when} x <- foreach(a=irnorm(1, count=10), .combine='c') %:% when(a >= 0) %do% sqrt(a) x ``` I won't say much on this topic, but I can't help showing how `foreach` with `when` can be used to write a simple quick sort function, in the classic Haskell fashion: ```{r qsort} qsort <- function(x) { n <- length(x) if (n == 0) { x } else { p <- sample(n, 1) smaller <- foreach(y=x[-p], .combine=c) %:% when(y <= x[p]) %do% y larger <- foreach(y=x[-p], .combine=c) %:% when(y > x[p]) %do% y c(qsort(smaller), x[p], qsort(larger)) } } qsort(runif(12)) ``` Not that I recommend this over the standard R `sort` function. But it's a pretty interesting example use of `foreach`. ## Conclusion Much of parallel computing comes to doing three things: splitting the problem into pieces, executing the pieces in parallel, and combining the results back together. Using the `foreach` package, the iterators help you to split the problem into pieces, the `%dopar%` function executes the pieces in parallel, and the specified `.combine` function puts the results back together. We've demonstrated how simple things can be done in parallel quite easily using the `foreach` package, and given some ideas about how more complex problems can be solved. But it's a fairly new package, and we will continue to work on ways of making it a more powerful system for doing parallel computing. foreach/vignettes/nested.Rmd0000644000176200001440000002567513614562752015651 0ustar liggesusers--- title: Nesting `foreach` loops author: Steve Weston output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{nested} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{utf8} --- _Converted to RMarkdown by Hong Ooi_ ## Introduction ```{r loadLibs, echo=FALSE, results="hide"} library(foreach) registerDoSEQ() ``` The `foreach` package provides a looping construct for executing R code repeatedly. It is similar to the standard `for` loop, which makes it easy to convert a `for` loop to a `foreach` loop. Unlike many parallel programming packages for R, `foreach` doesn't require the body of the `for` loop to be turned into a function. `foreach` differs from a `for` loop in that its return is a list of values, whereas a `for` loop has no value and uses side effects to convey its result. Because of this, `foreach` loops have a few advantages over `for` loops when the purpose of the loop is to create a data structure such as a vector, list, or matrix: First, there is less code duplication, and hence, less chance for an error because the initialization of the vector or matrix is unnecessary. Second, a `foreach` loop may be easily parallelized by changing only a single keyword. ## The nesting operator: `%:%` An important feature of `foreach` is the `%:%` operator. I call this the _nesting_ operator because it is used to create nested `foreach` loops. Like the `%do%` and `%dopar%` operators, it is a binary operator, but it operates on two `foreach` objects. It also returns a `foreach` object, which is essentially a special merger of its operands. Let's say that we want to perform a Monte Carlo simulation using a function called `sim`. (Remember that `sim` needs to be rather compute intensive to be worth executing in parallel.) The `sim` function takes two arguments, and we want to call it with all combinations of the values that are stored in the vectors `avec` and `bvec`. The following doubly-nested `for` loop does that. For testing purposes, the `sim` function is defined to return $10 a + b$. (Of course, an operation this trivial is not worth executing in parallel.) ```{r init1,echo=FALSE,results="hide"} sim <- function(a, b) 10 * a + b avec <- 1:2 bvec <- 1:4 ``` ```{r for1} 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 ``` In this case, it makes sense to store the results in a matrix, so we create one of the proper size called `x`, and assign the return value of `sim` to the appropriate element of `x` each time through the inner loop. When using `foreach`, we don't create a matrix and assign values into it. Instead, the inner loop returns the columns of the result matrix as vectors, which are combined in the outer loop into a matrix. Here's how to do that using the `%:%` operator. Due to operator precedence, you cannot put braces around the inner `foreach` loop. ```{r foreach1} x <- foreach(b=bvec, .combine='cbind') %:% foreach(a=avec, .combine='c') %do% { sim(a, b) } x ``` This is structured very much like the nested `for` loop. The outer `foreach` is iterating over the values in `bvec`, passing them to the inner `foreach`, which iterates over the values in `avec` for each value of `bvec`. Thus, the `sim` function is called in the same way in both cases. The code is slightly cleaner in this version, and has the advantage of being easily parallelized. ## Using `%:%` with `%dopar%` When parallelizing nested `for` loops, there is always a question of which loop to parallelize. The standard advice is to parallelize the outer loop. This results in larger individual tasks, and larger tasks can often be performed more efficiently than smaller tasks. However, if the outer loop doesn't have many iterations and the tasks are already large, parallelizing the outer loop results in a small number of huge tasks, which may not allow you to use all of your processors, and can also result in load balancing problems. You could parallelize an inner loop instead, but that could be inefficient because you're repeatedly waiting for all the results to be returned every time through the outer loop. And if the tasks and number of iterations vary in size, then it's really hard to know which loop to parallelize. But in our Monte Carlo example, all of the tasks are completely independent of each other, and so they can all be executed in parallel. You really want to think of the loops as specifying a single stream of tasks. You just need to be careful to process all of the results correctly, depending on which iteration of the inner loop they came from. That is exactly what the `%:%` operator does: it turns multiple `foreach` loops into a single loop. That is why there is only one `%do%` operator in the example above. And when we parallelize that nested `foreach` loop by changing the `%do%` into a `%dopar%`, we are creating a single stream of tasks that can all be executed in parallel: ```{r foreach2} x <- foreach(b=bvec, .combine='cbind') %:% foreach(a=avec, .combine='c') %dopar% { sim(a, b) } x ``` Of course, we'll actually only run as many tasks in parallel as we have processors, but the parallel backend takes care of all that. The point is that the `%:%` operator makes it easy to specify the stream of tasks to be executed, and the `.combine` argument to `foreach` allows us to specify how the results should be processed. The backend handles executing the tasks in parallel. ## Chunking tasks Of course, there has to be a snag to this somewhere. What if the tasks are quite small, so that you really might want to execute the entire inner loop as a single task? Well, small tasks are a problem even for a singly-nested loop. The solution to this problem, whether you have a single loop or nested loops, is to use _task chunking_. Task chunking allows you to send multiple tasks to the workers at once. This can be much more efficient, especially for short tasks. Currently, only the `doNWS` backend supports task chunking. Here's how it's done with `doNWS`: ```{r foreach3} opts <- list(chunkSize=2) x <- foreach(b=bvec, .combine='cbind', .options.nws=opts) %:% foreach(a=avec, .combine='c') %dopar% { sim(a, b) } x ``` If you're not using `doNWS`, then this argument is ignored, which allows you to write code that is backend-independent. You can also specify options for multiple backends, and only the option list that matches the registered backend will be used. It would be nice if the chunk size could be picked automatically, but I haven't figured out a good, safe way to do that. So for now, you need to specify the chunk size manually. The point is that by using the `%:%` operator, you can convert a nested `for` loop to a nested `foreach` loop, use `%dopar%` to run in parallel, and then tune the size of the tasks using the `chunkSize` option so that they are big enough to be executed efficiently, but not so big that they cause load balancing problems. You don't have to worry about which loop to parallelize, because you're turning the nested loops into a single stream of tasks that can all be executed in parallel by the parallel backend. ## Another example Now let's imagine that the `sim` function returns a object that includes an error estimate. We want to return the result with the lowest error for each value of b, along with the arguments that generated that result. Here's how that might be done with nested `for` loops: ```{r init2, echo=FALSE, results="hide"} sim <- function(a, b) { x <- 10 * a + b err <- abs(a - b) list(x=x, err=err) } ``` ```{r for2} n <- length(bvec) d <- data.frame(x=numeric(n), a=numeric(n), b=numeric(n), err=numeric(n)) for (j in 1:n) { err <- Inf best <- NULL for (i in 1:length(avec)) { obj <- sim(avec[i], bvec[j]) if (obj$err < err) { err <- obj$err best <- data.frame(x=obj$x, a=avec[i], b=bvec[j], err=obj$err) } } d[j,] <- best } d ``` This is also quite simple to convert to `foreach`. We just need to supply the appropriate `.combine` functions. For the outer `foreach`, we can use the standard `rbind` function which can be used with data frames. For the inner `foreach`, we write a function that compares two data frames, each with a single row, returning the one with a smaller error estimate: ```{r innercombine} comb <- function(d1, d2) if (d1$err < d2$err) d1 else d2 ``` Now we specify it with the `.combine` argument to the inner `foreach`: ```{r foreach4} opts <- list(chunkSize=2) d <- foreach(b=bvec, .combine='rbind', .options.nws=opts) %:% foreach(a=avec, .combine='comb', .inorder=FALSE) %dopar% { obj <- sim(a, b) data.frame(x=obj$x, a=a, b=b, err=obj$err) } d ``` Note that since the order of the arguments to the `comb` function is unimportant, I have set the `.inorder` argument to `FALSE`. This reduces the number of results that need to be saved on the master before they can be combined in case they are returned out of order. But even with niceties such as parallelization, backend-specific options, and the `.inorder` argument, the nested `foreach` version is quite readable. But what if we would like to return the indices into `avec` and `bvec`, rather than the data itself? A simple way to do that is to create a couple of counting iterators that we pass to the `foreach` functions: ```{r foreach5} library(iterators) opts <- list(chunkSize=2) d <- foreach(b=bvec, j=icount(), .combine='rbind', .options.nws=opts) %:% foreach(a=avec, i=icount(), .combine='comb', .inorder=FALSE) %dopar% { obj <- sim(a, b) data.frame(x=obj$x, i=i, j=j, err=obj$err) } d ``` Note that it's very important that the call to icount is passed as the argument to `foreach`. If the iterators were created and passed to `foreach` using a variable, for example, we would not get the desired effect. This is not a bug or a limitation, but an important aspect of the design of the `foreach` function. These new iterators are infinite iterators, but that's no problem since we have `bvec` and `avec` to control the number of iterations of the loops. Making them infinite means we don't have to keep them in sync with `bvec` and `avec`. ## Conclusion Nested `for` loops are a common construct, and are often the most time consuming part of R scripts, so they are prime candidates for parallelization. The usual approach is to parallelize the outer loop, but as we've seen, that can lead to suboptimal performance due to an imbalance between the size and the number of tasks. By using the `%:%` operator with `foreach`, and by using chunking techniques, many of these problems can be overcome. The resulting code is often clearer and more readable than the original R code, since `foreach` was designed to deal with exactly this kind of problem. foreach/R/0000755000176200001440000000000013614273227012071 5ustar liggesusersforeach/R/foreach.R0000644000176200001440000003102413615517270013623 0ustar liggesusers# # Copyright (c) Microsoft. All rights reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # #' @title foreach #' @description #' `%do%` and `%dopar%` are binary operators that operate #' on a `foreach` object and an `R` expression. #' The expression, `ex`, is evaluated multiple times in an environment #' that is created by the `foreach` object, and that environment is #' modified for each evaluation as specified by the `foreach` object. #' `%do%` evaluates the expression sequentially, while `%dopar%` #' evaluates it in parallel. #' The results of evaluating `ex` are returned as a list by default, #' but this can be modified by means of the `.combine` argument. #' #' @param ... one or more arguments that control how `ex` is #' evaluated. Named arguments specify the name and values of variables #' to be defined in the evaluation environment. #' An unnamed argument can be used to specify the number of times that #' `ex` should be evaluated. #' At least one argument must be specified in order to define the #' number of times `ex` should be executed. #' #' If multiple arguments are supplied, the number of times `ex` is #' evaluated is equal to the smallest number of iterations among the supplied #' arguments. See the examples. #' @param .combine function that is used to process the tasks results as #' they generated. This can be specified as either a function or #' a non-empty character string naming the function. #' Specifying 'c' is useful for concatenating the results into #' a vector, for example. The values 'cbind' and 'rbind' can combine #' vectors into a matrix. The values '+' and '*' can be used to #' process numeric data. #' By default, the results are returned in a list. #' @param .init initial value to pass as the first argument of the #' `.combine` function. #' This should not be specified unless `.combine` is also specified. #' @param .final function of one argument that is called to return final result. #' @param .inorder logical flag indicating whether the `.combine` #' function requires the task results to be combined in the same order #' that they were submitted. If the order is not important, then it #' setting `.inorder` to `FALSE` can give improved performance. #' The default value is `TRUE. #' @param .multicombine logical flag indicating whether the `.combine` #' function can accept more than two arguments. #' If an arbitrary `.combine` function is specified, by default, #' that function will always be called with two arguments. #' If it can take more than two arguments, then setting `.multicombine` #' to `TRUE` could improve the performance. #' The default value is `FALSE` unless the `.combine` #' function is `cbind`, `rbind`, or `c`, which are known #' to take more than two arguments. #' @param .maxcombine maximum number of arguments to pass to the combine function. #' This is only relevant if `.multicombine` is `TRUE`. #' @param .errorhandling specifies how a task evaluation error should be handled. #' If the value is "stop", then execution will be stopped via #' the `stop` function if an error occurs. #' If the value is "remove", the result for that task will not be #' returned, or passed to the `.combine` function. #' If it is "pass", then the error object generated by task evaluation #' will be included with the rest of the results. It is assumed that #' the combine function (if specified) will be able to deal with the #' error object. #' The default value is "stop". #' @param .packages character vector of packages that the tasks depend on. #' If `ex` requires a `R` package to be loaded, this option #' can be used to load that package on each of the workers. #' Ignored when used with `%do%`. #' @param .export character vector of variables to export. #' This can be useful when accessing a variable that isn't defined in the #' current environment. #' The default value in `NULL`. #' @param .noexport character vector of variables to exclude from exporting. #' This can be useful to prevent variables from being exported that aren't #' actually needed, perhaps because the symbol is used in a model formula. #' The default value in `NULL`. #' @param .verbose logical flag enabling verbose messages. This can be #' very useful for trouble shooting. #' @param obj `foreach` object used to control the evaluation #' of `ex`. #' @param e1 `foreach` object to merge. #' @param e2 `foreach` object to merge. #' @param ex the `R` expression to evaluate. #' @param cond condition to evaluate. #' @param n number of times to evaluate the `R` expression. #' #' @details #' The `foreach` and `%do%`/`%dopar%` operators provide #' a looping construct that can be viewed as a hybrid of the standard #' `for` loop and `lapply` function. #' It looks similar to the `for` loop, and it evaluates an expression, #' rather than a function (as in `lapply`), but its purpose is to #' return a value (a list, by default), rather than to cause side-effects. #' This facilitates parallelization, but looks more natural to people that #' prefer `for` loops to `lapply`. #' #' The `%:%` operator is the _nesting_ operator, used for creating #' nested foreach loops. Type `vignette("nested")` at the R prompt for #' more details. #' #' Parallel computation depends upon a _parallel backend_ that must be #' registered before performing the computation. The parallel backends available #' will be system-specific, but include `doParallel`, which uses R's built-in #' \pkg{parallel} package. Each parallel backend has a specific registration function, #' such as `registerDoParallel`. #' #' The `times` function is a simple convenience function that calls #' `foreach`. It is useful for evaluating an `R` expression multiple #' times when there are no varying arguments. This can be convenient for #' resampling, for example. #' #' @seealso #' [`iterators::iter`] #' @examples #' # equivalent to rnorm(3) #' times(3) %do% rnorm(1) #' #' # equivalent to lapply(1:3, sqrt) #' foreach(i=1:3) %do% #' sqrt(i) #' #' # multiple ... arguments #' foreach(i=1:4, j=1:10) %do% #' sqrt(i+j) #' #' # equivalent to colMeans(m) #' m <- matrix(rnorm(9), 3, 3) #' foreach(i=1:ncol(m), .combine=c) %do% #' mean(m[,i]) #' #' # normalize the rows of a matrix in parallel, with parenthesis used to #' # force proper operator precedence #' # Need to register a parallel backend before this example will run #' # in parallel #' foreach(i=1:nrow(m), .combine=rbind) %dopar% #' (m[i,] / mean(m[i,])) #' #' # simple (and inefficient) parallel matrix multiply #' library(iterators) #' a <- matrix(1:16, 4, 4) #' b <- t(a) #' foreach(b=iter(b, by='col'), .combine=cbind) %dopar% #' (a %*% b) #' #' # split a data frame by row, and put them back together again without #' # changing anything #' d <- data.frame(x=1:10, y=rnorm(10)) #' s <- foreach(d=iter(d, by='row'), .combine=rbind) %dopar% d #' identical(s, d) #' #' # a quick sort function #' qsort <- function(x) { #' n <- length(x) #' if (n == 0) { #' x #' } else { #' p <- sample(n, 1) #' smaller <- foreach(y=x[-p], .combine=c) %:% when(y <= x[p]) %do% y #' larger <- foreach(y=x[-p], .combine=c) %:% when(y > x[p]) %do% y #' c(qsort(smaller), x[p], qsort(larger)) #' } #' } #' qsort(runif(12)) #' #' @keywords utilities #' @export #' @rdname foreach foreach <- function(..., .combine, .init, .final=NULL, .inorder=TRUE, .multicombine=FALSE, .maxcombine=if (.multicombine) 100 else 2, .errorhandling=c('stop', 'remove', 'pass'), .packages=NULL, .export=NULL, .noexport=NULL, .verbose=FALSE) { if (missing(.combine)) { if (!missing(.init)) stop('if .init is specified, then .combine must also be specified') .combine <- defcombine hasInit <- TRUE init <- quote(list()) } else { .combine <- match.fun(.combine) if (missing(.init)) { hasInit <- FALSE init <- NULL } else { hasInit <- TRUE init <- substitute(.init) } } # .multicombine defaults to TRUE if the .combine function is known to # take multiple arguments if (missing(.multicombine) && (identical(.combine, cbind) || identical(.combine, rbind) || identical(.combine, c) || identical(.combine, defcombine))) .multicombine <- TRUE # sanity check the arguments if (!is.null(.final) && !is.function(.final)) stop('.final must be a function') if (!is.logical(.inorder) || length(.inorder) > 1) stop('.inorder must be a logical value') if (!is.logical(.multicombine) || length(.multicombine) > 1) stop('.multicombine must be a logical value') if (!is.numeric(.maxcombine) || length(.maxcombine) > 1 || .maxcombine < 2) stop('.maxcombine must be a numeric value >= 2') if (!is.character(.errorhandling)) stop('.errorhandling must be a character string') if (!is.null(.packages) && !is.character(.packages)) stop('.packages must be a character vector') if (!is.null(.export) && !is.character(.export)) stop('.export must be a character vector') if (!is.null(.noexport) && !is.character(.noexport)) stop('.noexport must be a character vector') if (!is.logical(.verbose) || length(.verbose) > 1) stop('.verbose must be a logical value') specified <- c('errorHandling', 'verbose') specified <- specified[c(!missing(.errorhandling), !missing(.verbose))] args <- substitute(list(...))[-1] if (length(args) == 0) stop('no iteration arguments specified') argnames <- names(args) if (is.null(argnames)) argnames <- rep('', length(args)) # check for backend-specific options options <- list() opts <- grep('^\\.options\\.[A-Za-z][A-Za-z]*$', argnames) if (length(opts) > 0) { # put the specified options objects into the options list for (i in opts) { bname <- substr(argnames[i], 10, 100) options[[bname]] <- list(...)[[i]] } # remove the specified options objects from args and argnames args <- args[-opts] argnames <- argnames[-opts] } # check for arguments that start with a '.', and issue an error, # assuming that these are misspelled options unrecog <- grep('^\\.', argnames) if (length(unrecog) > 0) stop(sprintf('unrecognized argument(s): %s', paste(argnames[unrecog], collapse=', '))) # check for use of old-style arguments, and issue an error oldargs <- c('COMBINE', 'INIT', 'INORDER', 'MULTICOMBINE', 'MAXCOMBINE', 'ERRORHANDLING', 'PACKAGES', 'VERBOSE', 'EXPORT', 'NOEXPORT', 'LOADFACTOR', 'CHUNKSIZE') oldused <- argnames %in% oldargs if (any(oldused)) stop(sprintf('old style argument(s) specified: %s', paste(argnames[oldused], collapse=', '))) .errorhandling <- match.arg(.errorhandling) combineInfo <- list(fun=.combine, in.order=.inorder, has.init=hasInit, init=init, final=.final, multi.combine=.multicombine, max.combine=.maxcombine) iterable <- list(args=args, argnames=argnames, evalenv=parent.frame(), specified=specified, combineInfo=combineInfo, errorHandling=.errorhandling, packages=.packages, export=.export, noexport=.noexport, options=options, verbose=.verbose) class(iterable) <- 'foreach' iterable } #' @export #' @rdname foreach '%:%' <- function(e1, e2) { if (!inherits(e1, 'foreach')) stop('"%:%" was passed an illegal right operand') if (inherits(e2, 'foreach')) makeMerged(e1, e2) else if (inherits(e2, 'foreachCondition')) makeFiltered(e1, e2) else stop('"%:%" was passed an illegal right operand') } #' @export #' @rdname foreach when <- function(cond) { obj <- list(qcond=substitute(cond), evalenv=parent.frame()) class(obj) <- 'foreachCondition' obj } foreach/R/getDoPar.R0000644000176200001440000000676013614150331013720 0ustar liggesusers# # Copyright (c) Microsoft. All rights reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # #' @name getDoParWorkers #' @title Functions Providing Information on the doPar Backend #' @description #' The `getDoParWorkers` function returns the number of #' execution workers there are in the currently registered doPar backend. #' It can be useful when determining how to split up the work to be executed #' in parallel. A `1` is returned by default. #' #' The `getDoParRegistered` function returns TRUE if a doPar backend #' has been registered, otherwise FALSE. #' #' The `getDoParName` function returns the name of the currently #' registered doPar backend. A `NULL` is returned if no backend is #' registered. #' #' The `getDoParVersion` function returns the version of the currently #' registered doPar backend. A `NULL` is returned if no backend is #' registered. #' #' @examples #' cat(sprintf('%s backend is registered\n', #' if(getDoParRegistered()) 'A' else 'No')) #' cat(sprintf('Running with %d worker(s)\n', getDoParWorkers())) #' (name <- getDoParName()) #' (ver <- getDoParVersion()) #' if (getDoParRegistered()) #' cat(sprintf('Currently using %s [%s]\n', name, ver)) #' #' @keywords utilities # this returns the number of workers used by the currently registered # parallel backend #' @export #' @rdname getDoParWorkers getDoParWorkers <- function() { wc <- if (exists('info', where=.foreachGlobals, inherits=FALSE)) .foreachGlobals$info(.foreachGlobals$data, 'workers') else NULL # interpret a NULL as a single worker, but the backend # can return NA without interference if (is.null(wc)) 1L else wc } # this returns a logical value indicating if a parallel backend # has been registered or not #' @export #' @rdname getDoParWorkers getDoParRegistered <- function() { exists('fun', where=.foreachGlobals, inherits=FALSE) } # this returns the name of the currently registered parallel backend #' @export #' @rdname getDoParWorkers getDoParName <- function() { if (exists('info', where=.foreachGlobals, inherits=FALSE)) .foreachGlobals$info(.foreachGlobals$data, 'name') else NULL } # this returns the version of the currently registered parallel backend #' @export #' @rdname getDoParWorkers getDoParVersion <- function() { if (exists('info', where=.foreachGlobals, inherits=FALSE)) .foreachGlobals$info(.foreachGlobals$data, 'version') else NULL } # used internally to get the currently registered parallel backend getDoPar <- function() { if (exists('fun', where=.foreachGlobals, inherits=FALSE)) { list(fun=.foreachGlobals$fun, data=.foreachGlobals$data) } else { if (!exists('parWarningIssued', where=.foreachGlobals, inherits=FALSE)) { warning('executing %dopar% sequentially: no parallel backend registered', call.=FALSE) assign('parWarningIssued', TRUE, pos=.foreachGlobals, inherits=FALSE) } list(fun=doSEQ, data=NULL) } } foreach/R/foreach-ext.R0000644000176200001440000001361213614272633014424 0ustar liggesusers# # Copyright (c) Microsoft. All rights reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # #' foreach extension functions #' #' These functions are used to write parallel backends for the `foreach` #' package. They should not be used from normal scripts or packages that use #' the `foreach` package. #' @param it foreach iterator. #' @param ex call object to analyze. #' @param e local environment of the call object. #' @param env exported environment in which call object will be evaluated. #' @param good names of symbols that are being exported. #' @param bad names of symbols that are not being exported. #' @param obj foreach iterator object. #' @param result task result to accumulate. #' @param tag tag of task result to accumulate. #' @param ... unused. #' #' @section Note: #' These functions are likely to change in future versions of the #' `foreach` package. When they become more stable, they will #' be documented. #' #' @name foreach-ext #' @keywords utilities #' @export #' @rdname foreach-ext makeAccum <- function(it) { # define and return the accumulator function that will be # passed to eachElem function(results, tags) { if (identical(it$error.handling, 'stop') && !is.null(it$state$errorValue)) return(invisible(NULL)) for (i in seq(along.with=tags)) { if (it$verbose) cat(sprintf('got results for task %d\n', tags[i])) accumulate(it, results[[i]], tags[i]) } } } #' @export #' @rdname foreach-ext accumulate <- function(obj, result, tag, ...) { UseMethod('accumulate') } #' @export #' @rdname foreach-ext getResult <- function(obj, ...) { UseMethod('getResult') } #' @export #' @rdname foreach-ext getErrorValue <- function(obj, ...) { UseMethod('getErrorValue') } #' @export #' @rdname foreach-ext getErrorIndex <- function(obj, ...) { UseMethod('getErrorIndex') } #' @export #' @rdname foreach-ext accumulate.iforeach <- function(obj, result, tag, ...) { obj$state$numResults <- obj$state$numResults + 1L # we can't receive more results than the number of tasks that we've fired stopifnot(obj$state$numResults <= obj$state$numValues) if (inherits(result, 'error') && is.null(obj$state$errorValue) && obj$errorHandling %in% c('stop', 'remove')) { if (obj$verbose) cat('accumulate got an error result\n') obj$state$errorValue <- result obj$state$errorIndex <- tag } # we can already tell what our status is going to be status <- complete(obj) # put the result in our buffer cache name <- paste('result', tag, sep='.') assign(name, result, obj$state, inherits=FALSE) ibuf <- if (obj$combineInfo$in.order) { tag - obj$state$buf.off } else { obj$state$nbuf <- obj$state$nbuf + 1L } # make sure we always have trailing NA's blen <- length(obj$state$buffered) while (ibuf >= blen) { length(obj$state$buffered) <- 2 * blen blen <- length(obj$state$buffered) } obj$state$buffered[ibuf] <- if (inherits(result, 'error') && obj$errorHandling %in% c('stop', 'remove')) -tag else tag # do any combining that needs to be done callCombine(obj, status) # return with apprpriate status if (obj$verbose) cat(sprintf('returning status %s\n', status)) status } #' @export #' @rdname foreach-ext getResult.iforeach <- function(obj, ...) { if (is.null(obj$combineInfo$final)) obj$state$accum else obj$combineInfo$final(obj$state$accum) } #' @export #' @rdname foreach-ext getErrorValue.iforeach <- function(obj, ...) { obj$state$errorValue } #' @export #' @rdname foreach-ext getErrorIndex.iforeach <- function(obj, ...) { obj$state$errorIndex } #' @export #' @rdname foreach-ext accumulate.ixforeach <- function(obj, result, tag, ...) { if (obj$verbose) { cat(sprintf('accumulating result with tag %d\n', tag)) cat('fired:\n') print(obj$state$fired) } s <- cumsum(obj$state$fired) j <- 1L while (tag > s[[j]]) j <- j + 1L i <- if (j > 1) as.integer(tag) - s[[j - 1]] else as.integer(tag) ie2 <- obj$state$ie2[[j]] if (accumulate(ie2, result, i)) { if (is.null(obj$state$errorValue)) { obj$state$errorValue <- getErrorValue(ie2) obj$state$errorIndex <- getErrorIndex(ie2) } accum <- getResult(ie2) if (obj$verbose) { cat('propagating accumulated result up to the next level from accumulate\n') print(accum) } accumulate(obj$ie1, accum, j) # XXX error handling? } } #' @export #' @rdname foreach-ext getResult.ixforeach <- function(obj, ...) { getResult(obj$ie1, ...) } #' @export #' @rdname foreach-ext getErrorValue.ixforeach <- function(obj, ...) { obj$state$errorValue } #' @export #' @rdname foreach-ext getErrorIndex.ixforeach <- function(obj, ...) { obj$state$errorIndex } #' @export #' @rdname foreach-ext accumulate.ifilteredforeach <- function(obj, result, tag, ...) { accumulate(obj$ie1, result, tag, ...) } #' @export #' @rdname foreach-ext getResult.ifilteredforeach <- function(obj, ...) { getResult(obj$ie1, ...) } #' @export #' @rdname foreach-ext getErrorValue.ifilteredforeach <- function(obj, ...) { getErrorValue(obj$ie1, ...) } #' @export #' @rdname foreach-ext getErrorIndex.ifilteredforeach <- function(obj, ...) { getErrorIndex(obj$ie1, ...) } foreach/R/utils.R0000644000176200001440000000422013614273414013350 0ustar liggesusers# # Copyright (c) Microsoft. All rights reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # # miscellaneous foreach helper functions # default combiner function: returns a list defcombine <- function(a, ...) c(a, list(...)) makeMerged <- function(e1, e2) { specified <- union(e1$specified, e2$specified) argnames <- union(e1$argnames, e2$argnames) packages <- union(e1$packages, e2$packages) export <- union(e1$export, e2$export) noexport <- union(e1$noexport, e2$noexport) options <- c(e1$options, e2$options) iterable <- list(e1=e1, e2=e2, specified=specified, argnames=argnames, packages=packages, export=export, noexport=noexport, options=options) # this gives precedence to the outer foreach inherit <- c('errorHandling', 'verbose') iterable[inherit] <- e2[inherit] iterable[e1$specified] <- e1[e1$specified] class(iterable) <- c('xforeach', 'foreach') iterable } makeFiltered <- function(e1, cond) { iterable <- c(list(e1=e1), cond) inherit <- c('argnames', 'specified', 'errorHandling', 'packages', 'export', 'noexport', 'options', 'verbose') iterable[inherit] <- e1[inherit] class(iterable) <- c('filteredforeach', 'foreach') iterable } # XXX make this a method? complete <- function(obj) { stopifnot(class(obj)[1] == 'iforeach') if (obj$verbose) cat(sprintf('numValues: %d, numResults: %d, stopped: %s\n', obj$state$numValues, obj$state$numResults, obj$state$stopped)) obj$state$stopped && obj$state$numResults == obj$state$numValues } '%if%' <- function(e1, cond) { stop('obsolete') } foreach/R/getsyms.R0000644000176200001440000000602413614034623013704 0ustar liggesusers# # Copyright (c) Microsoft. All rights reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # getsyms <- function(ex) { fun <- function(x) { if (is.symbol(x)) as.character(x) else if (is.call(x)) getsyms(x) else NULL } unlist(lapply(ex, fun)) } gather <- function(x) { fun <- function(a, b) unique(c(a, b)) accum <- list(good=character(0), bad=character(0)) for (e in x) { accum <- mapply(fun, e, accum, SIMPLIFY=FALSE) } accum } expandsyms <- function(syms, env, good, bad) { fun <- function(sym, good, bad) { if (sym %in% c(good, bad)) { # we already saw this symbol list(good=good, bad=bad) } else if (!nzchar(sym)) { # apparently a symbol can be converted into an empty string, # but it's an error to call "exists" with an empty string, # so we just declare it to be bad here list(good=good, bad=c(sym, bad)) } else if (exists(sym, env, mode='function', inherits=FALSE)) { # this is a function defined in this environment good <- c(sym, good) f <- get(sym, env, mode='function', inherits=FALSE) if (identical(environment(f), env)) { # it's a local function globs <- findGlobals(f) if (length(globs) > 0) { # it's got free variables, so let's check them out gather(lapply(globs, fun, good, bad)) } else { # it doesn't have free variables, so we're done list(good=good, bad=bad) } } else { # it's not a local function, so we're done list(good=good, bad=bad) } } else if (exists(sym, env, inherits=FALSE)) { # it's not a function, but it's defined in this environment list(good=c(sym, good), bad=bad) } else { # it's not defined in this environment list(good=good, bad=c(sym, bad)) } } gather(lapply(syms, fun, good, bad))$good } #' @export #' @rdname foreach-ext getexports <- function(ex, e, env, good=character(0), bad=character(0)) { syms <- getsyms(ex) syms <- expandsyms(syms, env, good, bad) for (s in syms) { if (s != '...') { val <- get(s, env, inherits=FALSE) # if this is a function, check if we should change the # enclosing environment to be this new environment fenv <- environment(val) if (is.function(val) && (identical(fenv, env) || identical(fenv, .GlobalEnv))) environment(val) <- e assign(s, val, e) } } invisible(NULL) } foreach/R/iter.R0000644000176200001440000000550513614150374013161 0ustar liggesusers# # Copyright (c) Microsoft. All rights reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # #' @export iter.foreach <- function(obj, ..., extra=list()) { # evaluate the quoted iteration variables, and turn them into iterators iargs <- lapply(obj$args, function(a) iter(eval(a, envir=extra, enclos=obj$evalenv), ...)) # create the environment that will contain our dynamic state state <- new.env(parent=emptyenv()) # iterator state state$stopped <- FALSE state$numValues <- 0L # number of values that we've fired # accumulator state combineInfo <- obj$combineInfo if (combineInfo$has.init) { state$accum <- eval(combineInfo$init, envir=extra, enclos=obj$evalenv) state$first.time <- FALSE } else { state$accum <- NULL state$first.time <- TRUE } state$fun <- combineInfo$fun state$buffered <- rep(as.integer(NA), 2 * combineInfo$max.combine) state$next.tag <- 1L # only used when in.order is TRUE state$buf.off <- 0L # only used when in.order is TRUE state$nbuf <- 0L # only used when in.order is FALSE state$numResults <- 0L # number of results that we've received back state$errorValue <- NULL state$errorIndex <- -1L # package and return the iterator object iterator <- list(state=state, iargs=iargs, argnames=obj$argnames, combineInfo=combineInfo, errorHandling=obj$errorHandling, verbose=obj$verbose) class(iterator) <- c('iforeach', 'iter') iterator } #' @export iter.xforeach <- function(obj, ...) { state <- new.env(parent=emptyenv()) state$stopped <- FALSE state$fired <- integer(0) state$ie2 <- list() state$errorValue <- NULL state$errorIndex <- -1L ie1 <- iter(obj$e1, ...) iterator <- list(state=state, ie1=ie1, e2=obj$e2, argnames=obj$argnames, errorHandling=obj$errorHandling, verbose=obj$verbose) class(iterator) <- c('ixforeach', 'iter') iterator } #' @export iter.filteredforeach <- function(obj, ...) { ie1 <- iter(obj$e1, ...) iterator <- list(ie1=ie1, qcond=obj$qcond, evalenv=obj$evalenv, argnames=obj$argnames, errorHandling=obj$errorHandling, verbose=obj$verbose) class(iterator) <- c('ifilteredforeach', 'iter') iterator } foreach/R/setDoPar.R0000644000176200001440000000362213614272537013743 0ustar liggesusers# # Copyright (c) Microsoft. All rights reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # # this is called to register a parallel backend #' @title setDoPar #' @description #' The `setDoPar` function is used to register a parallel backend with the #' foreach package. This isn't normally executed by the user. Instead, packages #' that provide a parallel backend provide a function named `registerDoPar` #' that calls `setDoPar` using the appropriate arguments. #' @param fun A function that implements the functionality of `%dopar%`. #' @param data Data to be passed to the registered function. #' @param info Function that retrieves information about the backend. #' @seealso #' [`%dopar%`] #' @keywords utilities #' @export setDoPar <- function(fun, data=NULL, info=function(data, item) NULL) { tryCatch( { assign('fun', fun, pos=.foreachGlobals, inherits=FALSE) assign('data', data, pos=.foreachGlobals, inherits=FALSE) assign('info', info, pos=.foreachGlobals, inherits=FALSE) }, error = function(e) { if (exists('fun', where=.foreachGlobals, inherits=FALSE)) remove('fun', envir=.foreachGlobals) if (exists('data', where=.foreachGlobals, inherits=FALSE)) remove('data', envir=.foreachGlobals) if (exists('info', where=.foreachGlobals, inherits=FALSE)) remove('info', envir=.foreachGlobals) e }) } foreach/R/times.R0000644000176200001440000000160613613666600013340 0ustar liggesusers# # Copyright (c) Microsoft. All rights reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # # a simple convenience function for use with %do% and %dopar% # inspired by Daniel Kaplan of Macalester College #' @export #' @rdname foreach times <- function(n) { if (!is.numeric(n) || length(n) != 1) stop('n must be a numeric value') foreach(icount(n), .combine='c') } foreach/R/foreach-pkg.R0000644000176200001440000000432513614151340014375 0ustar liggesusers# # Copyright (c) Microsoft. All rights reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # #' @name foreach-package #' @title The Foreach Package #' @aliases foreach-package foreach_package #' @description #' The foreach package provides a new looping construct for executing #' R code repeatedly. The main reason for using the foreach package #' is that it supports parallel execution. The foreach package can #' be used with a variety of different parallel computing systems, #' include NetWorkSpaces and snow. In addition, foreach can be #' used with iterators, which allows the data to specified in a very #' flexible way. #' #' @details #' Further information is available in the following help topics: #' \tabular{ll}{ #' `foreach` \tab Specify the variables to iterate over\cr #' `%do%` \tab Execute the R expression sequentially\cr #' `%dopar%` \tab Execute the R expression using the currently registered backend #' } #' #' To see a tutorial introduction to the foreach package, #' use `vignette("foreach")`. #' #' To see a demo of foreach computing the sinc function, #' use `demo(sincSEQ)`. #' #' Some examples (in addition to those in the help pages) are included in #' the "examples" directory of the foreach package. To list the files in #' the examples directory, #' use `list.files(system.file("examples", package="foreach"))`. #' To run the bootstrap example, use #' `source(system.file("examples", "bootseq.R", package="foreach"))`. #' #' For a complete list of functions with individual help pages, #' use `library(help="foreach")`. #' #' @keywords internal "_PACKAGE" #' @import iterators #' @importFrom codetools findGlobals #' @importFrom utils packageDescription NULL foreach/R/setDoSeq.R0000644000176200001440000000364413614272571013753 0ustar liggesusers# # Copyright (c) Microsoft. All rights reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # # this is called to register a sequential backend #' @title setDoSeq #' @description #' The `setDoSeq` function is used to register a sequential backend with the #' foreach package. This isn't normally executed by the user. Instead, packages #' that provide a sequential backend provide a function named `registerDoSeq` #' that calls `setDoSeq` using the appropriate arguments. #' @param fun A function that implements the functionality of `%dopar%`. #' @param data Data to be passed to the registered function. #' @param info Function that retrieves information about the backend. #' @seealso #' [`%dopar%`] #' @keywords utilities #' @export setDoSeq <- function(fun, data=NULL, info=function(data, item) NULL) { tryCatch( { assign('seqFun', fun, pos=.foreachGlobals, inherits=FALSE) assign('seqData', data, pos=.foreachGlobals, inherits=FALSE) assign('seqInfo', info, pos=.foreachGlobals, inherits=FALSE) }, error = function(e) { if (exists('fun', where=.foreachGlobals, inherits=FALSE)) remove('fun', envir = .foreachGlobals) if (exists('data', where=.foreachGlobals, inherits=FALSE)) remove('data', envir = .foreachGlobals) if (exists('info', where=.foreachGlobals, inherits=FALSE)) remove('info', envir = .foreachGlobals) e }) } foreach/R/callCombine.R0000644000176200001440000001200413614150337014415 0ustar liggesusers# # Copyright (c) Microsoft. All rights reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # callCombine <- function(obj, status) { if (obj$combineInfo$in.order) { repeat { needed <- obj$combineInfo$max.combine if (!obj$state$first.time) needed <- needed - 1 n <- which(is.na(obj$state$buffered))[1] - 1L stopifnot(!is.na(n)) n <- min(n, needed) if (n == needed || (status && n > 0)) { # get the names of the objects to be combined ind <- 1:n # filter out any errors (if error handling isn't 'pass') b <- obj$state$buffered[ind] allsyms <- paste('result', abs(b), sep='.') args <- b[b > 0] args <- if (length(args) > 0) paste('result', args, sep='.') else character(0) # XXX these operations won't be efficient for small values of max.combine blen <- length(obj$state$buffered) obj$state$buffered <- obj$state$buffered[(n+1):blen] length(obj$state$buffered) <- blen # XXX put this off? obj$state$buf.off <- obj$state$buf.off + n # create the call object to call the combine function callobj <- if (obj$state$first.time) { if (length(args) > 0) { if (obj$verbose) cat('first call to combine function\n') # not always true obj$state$first.time <- FALSE if (length(args) > 1) as.call(lapply(c('fun', args), as.name)) else as.name(args) # this evaluates to the value of the result } else { if (obj$verbose) cat('not calling combine function due to errors\n') NULL } } else { if (length(args) > 0) { if (obj$verbose) cat('calling combine function\n') as.call(lapply(c('fun', 'accum', args), as.name)) } else { if (obj$verbose) cat('not calling combine function due to errors\n') NULL } } # call the combine function if (!is.null(callobj)) { if (obj$verbose) { cat('evaluating call object to combine results:\n ') print(callobj) } obj$state$accum <- eval(callobj, obj$state) } # remove objects from buffer cache that we just processed # and all error objects remove(list=allsyms, pos=obj$state) } else { break } } } else { needed <- obj$combineInfo$max.combine if (!obj$state$first.time) needed <- needed - 1 stopifnot(obj$state$nbuf <= needed) # check if it's time to combine if (obj$state$nbuf == needed || (status && obj$state$nbuf > 0)) { # get the names of the objects to be combined ind <- 1:obj$state$nbuf # filter out any errors (if error handling isn't 'pass') b <- obj$state$buffered[ind] allsyms <- paste('result', abs(b), sep='.') args <- b[b > 0] args <- if (length(args) > 0) paste('result', args, sep='.') else character(0) obj$state$buffered[ind] <- as.integer(NA) obj$state$nbuf <- 0L # create the call object to call the combine function callobj <- if (obj$state$first.time) { if (length(args) > 0) { if (obj$verbose) cat('first call to combine function\n') obj$state$first.time <- FALSE if (length(args) > 1) as.call(lapply(c('fun', args), as.name)) else as.name(args) # this evaluates to the value of the result } else { if (obj$verbose) cat('not calling combine function due to errors\n') NULL } } else { if (length(args) > 0) { if (obj$verbose) cat('calling combine function\n') as.call(lapply(c('fun', 'accum', args), as.name)) } else { if (obj$verbose) cat('not calling combine function due to errors\n') NULL } } # call the combine function if (!is.null(callobj)) { if (obj$verbose) { cat('evaluating call object to combine results:\n ') print(callobj) } obj$state$accum <- eval(callobj, obj$state) } # remove objects from buffer cache that we just processed remove(list=allsyms, pos=obj$state) } } } foreach/R/onLoad.R0000644000176200001440000000156013614275405013432 0ustar liggesusers# # Copyright (c) Microsoft. All rights reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # .foreachGlobals <- new.env(parent=emptyenv()) .onLoad <- function(libname, pkgname) { local <- as.logical(Sys.getenv("R_FOREACH_DOPAR_LOCAL", "FALSE")) local <- getOption("foreachDoparLocal", local) options(foreachDoparLocal=local) invisible(NULL) } foreach/R/getDoSeq.R0000644000176200001440000000626313614150324013726 0ustar liggesusers# # Copyright (c) Microsoft. All rights reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # #' @name getDoSeqWorkers #' @title Functions Providing Information on the doSeq Backend #' @description #' The `getDoSeqWorkers` function returns the number of #' execution workers there are in the currently registered doSeq backend. #' A `1` is returned by default. #' #' The `getDoSeqRegistered` function returns TRUE if a doSeq backend #' has been registered, otherwise FALSE. #' #' The `getDoSeqName` function returns the name of the currently #' registered doSeq backend. A `NULL` is returned if no backend is #' registered. #' #' The `getDoSeqVersion` function returns the version of the currently #' registered doSeq backend. A `NULL` is returned if no backend is #' registered. #' #' @examples #' cat(sprintf('%s backend is registered\n', #' if(getDoSeqRegistered()) 'A' else 'No')) #' cat(sprintf('Running with %d worker(s)\n', getDoSeqWorkers())) #' (name <- getDoSeqName()) #' (ver <- getDoSeqVersion()) #' if (getDoSeqRegistered()) #' cat(sprintf('Currently using %s [%s]\n', name, ver)) #' #' @keywords utilities # this returns a logical value indicating if a sequential backend # has been registered or not #' @export #' @rdname getDoSeqWorkers getDoSeqRegistered <- function() { exists('seqFun', where=.foreachGlobals, inherits=FALSE) } # this returns the number of workers used by the currently registered # sequential backend #' @export #' @rdname getDoSeqWorkers getDoSeqWorkers <- function() { wc <- if (exists('seqInfo', where=.foreachGlobals, inherits=FALSE)) .foreachGlobals$seqInfo(.foreachGlobals$seqData, 'workers') else NULL # interpret a NULL as a single worker, but the backend # can return NA without interference if (is.null(wc)) 1L else wc } # this returns the name of the currently registered sequential backend #' @export #' @rdname getDoSeqWorkers getDoSeqName <- function() { if (exists('seqInfo', where=.foreachGlobals, inherits=FALSE)) .foreachGlobals$seqInfo(.foreachGlobals$seqData, 'name') else NULL } # this returns the version of the currently registered sequential backend #' @export #' @rdname getDoSeqWorkers getDoSeqVersion <- function() { if (exists('seqInfo', where=.foreachGlobals, inherits=FALSE)) .foreachGlobals$seqInfo(.foreachGlobals$seqData, 'version') else NULL } # used internally to get the currently registered parallel backend getDoSeq <- function() { if (exists('seqFun', where=.foreachGlobals, inherits=FALSE)) { list(fun=.foreachGlobals$seqFun, data=.foreachGlobals$seqdata) } else { list(fun=doSEQ, data=NULL) } } foreach/R/nextElem.R0000644000176200001440000000664413614150346014003 0ustar liggesusers# # Copyright (c) Microsoft. All rights reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # #' @export nextElem.iforeach <- function(obj, ..., redo=FALSE) { if (redo) obj$state$numValues <- obj$state$numValues - 1L tryCatch({ # XXX this shouldn't be recomputed repeatedly ix <- which(!nzchar(obj$argnames)) elem <- if (length(ix) > 0) { lapply(obj$iargs[ix], nextElem) ix <- which(nzchar(obj$argnames)) if (length(ix) > 0) lapply(obj$iargs[ix], nextElem) else list() } else { lapply(obj$iargs, nextElem) } }, error=function(e) { if (identical(conditionMessage(e), 'StopIteration')) { obj$state$stopped <- TRUE if (complete(obj)) callCombine(obj, TRUE) } stop(e) }) obj$state$numValues <- obj$state$numValues + 1L elem } #' @export nextElem.ixforeach <- function(obj, ..., redo=FALSE) { if (obj$verbose) cat(sprintf('nextElem.ixforeach called with redo %s\n', redo)) if (redo) { i <- length(obj$state$fired) if (obj$verbose) { cat('refiring iterator - fired was:\n') print(obj$state$fired) } obj$state$fired[i] <- obj$state$fired[i] - 1L if (obj$verbose) { cat('fired is now:\n') print(obj$state$fired) } } repeat { if (!exists('nextval', obj$state, inherits=FALSE)) { tryCatch({ obj$state$nextval <- nextElem(obj$ie1) }, error=function(e) { if (identical(conditionMessage(e), 'StopIteration')) obj$state$stopped <- TRUE stop(e) }) obj$state$ie2 <- c(obj$state$ie2, list(iter(obj$e2, extra=obj$state$nextval))) obj$state$fired <- c(obj$state$fired, 0L) } tryCatch({ i <- length(obj$state$fired) v2 <- nextElem(obj$state$ie2[[i]], redo=redo) obj$state$fired[i] <- obj$state$fired[i] + 1L break }, error=function(e) { if (!identical(conditionMessage(e), 'StopIteration')) stop(e) remove('nextval', pos=obj$state) if (complete(obj$state$ie2[[i]])) { callCombine(obj$state$ie2[[i]], TRUE) if (is.null(obj$state$errorValue)) { obj$state$errorValue <- getErrorValue(obj$state$ie2[[i]]) obj$state$errorIndex <- getErrorIndex(obj$state$ie2[[i]]) } accum <- getResult(obj$state$ie2[[i]]) if (obj$verbose) { cat('propagating accumulated result up to the next level from nextElem\n') print(accum) } accumulate(obj$ie1, accum, i) # XXX error handling? } }) redo <- FALSE } c(obj$state$nextval, v2) } #' @export nextElem.ifilteredforeach <- function(obj, ..., redo=FALSE) { repeat { elem <- nextElem(obj$ie1, ..., redo=redo) if (eval(obj$qcond, envir=elem, enclos=obj$evalenv)) break redo <- TRUE } elem } foreach/R/do.R0000644000176200001440000001002313616332540012606 0ustar liggesusers# # Copyright (c) Microsoft. All rights reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # #' @include foreach.R NULL # this explicitly registers a sequential backend for do and dopar. #' @title registerDoSEQ #' @description #' The `registerDoSEQ` function is used to explicitly register #' a sequential parallel backend with the foreach package. #' This will prevent a warning message from being issued if the #' `%dopar%` function is called and no parallel backend has #' been registered. #' #' @seealso #' [`doParallel::registerDoParallel`] #' @examples #' # specify that %dopar% should run sequentially #' registerDoSEQ() #' @keywords utilities #' @export registerDoSEQ <- function() { setDoPar(doSEQ, NULL, info) setDoSeq(doSEQ, NULL, info) } # passed to setDoPar via registerDoSEQ, and called by getDoSeqWorkers, etc info <- function(data, item) { switch(item, workers=1L, name='doSEQ', version=packageDescription('foreach', fields='Version'), NULL) } #' @export #' @rdname foreach '%do%' <- function(obj, ex) { e <- getDoSeq() # set a marker that we are calling the iterator from %do%, rather than %dopar% # this is required to let %dopar% eval its expr in a local env environment(e$fun) <- new.env(parent=environment(e$fun)) environment(e$fun)$.foreach_do <- TRUE e$fun(obj, substitute(ex), parent.frame(), e$data) } #' @export #' @rdname foreach '%dopar%' <- function(obj, ex) { e <- getDoPar() e$fun(obj, substitute(ex), parent.frame(), e$data) } comp <- if (getRversion() < "2.13.0") { function(expr, ...) expr } else { compiler::compile } doSEQ <- function(obj, expr, envir, data) { # check for a marker that this is called from %do%, not %dopar% # if the marker does not exist, we are in a %dopar% call if(is.null(parent.env(environment())$.foreach_do) && getOption("foreachDoparLocal")) envir <- new.env(parent=envir) # note that the "data" argument isn't used if (!inherits(obj, 'foreach')) stop('obj must be a foreach object') it <- iter(obj) accumulator <- makeAccum(it) for (p in obj$packages) library(p, character.only=TRUE) # compile the expression if we're using R 2.13.0 or greater xpr <- comp(expr, env=envir, options=list(suppressUndefined=TRUE)) i <- 1 tryCatch({ repeat { # get the next set of arguments args <- nextElem(it) if (obj$verbose) { cat(sprintf('evaluation # %d:\n', i)) print(args) } # assign arguments to local environment for (a in names(args)) assign(a, args[[a]], pos=envir, inherits=FALSE) # evaluate the expression r <- tryCatch(eval(xpr, envir=envir), error=function(e) e) if (obj$verbose) { cat('result of evaluating expression:\n') print(r) } # process the results tryCatch(accumulator(list(r), i), error=function(e) { cat('error calling combine function:\n') print(e) NULL }) i <- i + 1 } }, error=function(e) { if (!identical(conditionMessage(e), 'StopIteration')) stop(simpleError(conditionMessage(e), expr)) }) errorValue <- getErrorValue(it) errorIndex <- getErrorIndex(it) if (identical(obj$errorHandling, 'stop') && !is.null(errorValue)) { msg <- sprintf('task %d failed - "%s"', errorIndex, conditionMessage(errorValue)) stop(simpleError(msg, call=expr)) } else { getResult(it) } } foreach/NEWS.md0000644000176200001440000000576113616046710012774 0ustar liggesusers## 1.4.8 (2020-02-04) ## 1.4.7 (2019-07-27) - Maintainer change (Hong Ooi; hongooi@microsoft.com). ## 1.4.4 (2017-12-08) - Changed test report path for compliance with CRAN policies. - Removed startup message. - Changed `seq(along=tags)` call in `makeAccum` to `seq(along.with=tags)`; request of Henrik Bengtsson. - Updated `foreach` help to describe effect of multiple arguments; request of David Winsemius. ## 1.4.3 (2015-10-12) - Updated maintainer address ## 1.4.2 (2014-04-10) - Unwound circular dependency chain with iterators package. ## 1.4.1 (2013-05-29) - Improved handling of implicitly exported objects, courtesy of Steve Weston. ## 1.4.0 (2012-04-11) - Removed spurious warning from `getDoSEQ`. Bug report from Ben Barnes. - Moved welcome message from `.onLoad` to `.onAttach`. Bug report from Benilton Carvalho. - Modified `setDoPar` and `setDoSeq` to undo changes to .foreachGlobals on error. Bug report from Benilton Carvalho. - Moved vignettes from `inst/doc` to `vignettes`. - Modified `DESCRIPTION` file by moving codetools, iterators, and utils from Depends to Imports. Bug report from Suraj Gupta. ## 1.3.5 (2012-03-14) - Cleanup from previous patch. Bug report from Brian Ripley. ## 1.3.4 (2012-03-12) - Added support for multiple sequential backends. (Idea and patch from Tyler Pirtle, Matt Furia, and Joseph Hellerstein.) - Modified `doRUnit.R` to use no more than two cores during R CMD check. ## 1.3.2 (2011-05-08) - Regularized unit tests so they can run through R CMD check - Added support for compiler package of 2.13.0 and later. ## 1.3.1 (2010-11-22) - First R-forge release. foreach/MD50000644000176200001440000001000413620065713012167 0ustar liggesusersf0ee68db096af025986f063b9ce44640 *DESCRIPTION 25b251c1fbb5b23dd56341c9fba7046a *NAMESPACE db9697d99cb7ee8de1e529f2ae36e150 *NEWS.md ecf3cabd0b12c9cb4a6fcdbe4fc90675 *R/callCombine.R c08b411808259893b91f32a5e8fae14a *R/do.R fa45910a2c08388f217c019d6850bc66 *R/foreach-ext.R c46cc9993db688a61db115d26bc9e27b *R/foreach-pkg.R dbefb40b8cf7e14694ed3cd91e718675 *R/foreach.R 6757934602a7a64464d138f31409372e *R/getDoPar.R 7750647921e33cdc57ea1f2b640dd2ec *R/getDoSeq.R 03f1b92a536bff63cc54fdbb8568e328 *R/getsyms.R bcd8c9d1bad0e28356a457b7db7e70bb *R/iter.R 783a7dff9098496dd6f53fc20b743ec0 *R/nextElem.R 9899942dcc8fb16ae28d63ce5275049e *R/onLoad.R d9169823a141c7f17fd509d27da27232 *R/setDoPar.R 184f5d6cd810f6ce79e6917a6502f609 *R/setDoSeq.R 3cebd8886b3c27482bb165aa289bc21f *R/times.R 0cb9bccef92ff9e9d9de97247305dda2 *R/utils.R 7839fba45aa07ffe14dda35b3a905ce7 *build/vignette.rds c579ade425b18a72c31a5b8ebfa0babd *demo/00Index 17a85db43805f123aa75798659de8741 *demo/sincSEQ.R cdb007b54c7a8c30c6a3c0a5d47ec511 *inst/doc/foreach.R bb9adb7b804cf67cdd268e4996711e59 *inst/doc/foreach.Rmd cf1e1197de5c9beeaf88ac265780f5c6 *inst/doc/foreach.html 76e657bf2a5439cdc6c8649872033005 *inst/doc/nested.R 533ad19d28eb363bbab44edeaa9591a7 *inst/doc/nested.Rmd 0ddda26747ff79706a1689ac7b16a76d *inst/doc/nested.html 99787f027fd9c86157496490f2d5b194 *inst/examples/apply.R 691db78db867ff8ff7eb78de3241ee8f *inst/examples/bigmax.R 8f20162e5c6bee3f1743368faa542f95 *inst/examples/bigmean.R e11b0091240a4966818b15bd08e773f9 *inst/examples/bigmean2.R 4ff4c574dfabd32695acffe671fc4026 *inst/examples/bootpar.R 660ea8456d4994d9be8af2d2b57efd68 *inst/examples/bootpar2.R 9db01bc9eeb16028c5c92fc590ff8f7c *inst/examples/bootseq.R 9a9512a257362697ccc7e5dd66083158 *inst/examples/colMeans.R 7bcc927faf00d71884991b4ea6850176 *inst/examples/comprehensions.R ed1165815016d58516163f1ce96b1df9 *inst/examples/cross.R 9cdfb14b41c3dd5708c46668c6678675 *inst/examples/feapply.R 9fb665a40cb6d8a2e8116c96b79169c3 *inst/examples/for.R fafd45ac526e14168ddc000e3d0144ff *inst/examples/germandata.txt 3177aaf0fcb25bf157250f512f45da5b *inst/examples/isplit.R 7b0d786b7672d6e8920a18bfe676fe46 *inst/examples/matmul.R 6e810682adfe09f99856f5b4ec3fee3b *inst/examples/matmul2.R 7747d26301d4ec9abc74273d5c94dc80 *inst/examples/output.R fb26fbf8ac20212e34b2b96b098a335a *inst/examples/pi.R fd775cb6fb1ab6800b6f2e2a1a4381d7 *inst/examples/qsort.R 5fdf83fd9b1751b2f1abd7c430a76e1d *inst/examples/rf.R 766919ed69b3eeba8cc4c9810a59b968 *inst/examples/sinc.R e4a12f47d6448aca6450662d1e79ed6f *inst/examples/sinc2.R 2dfea8d0ed3da086fb322663b804e1ad *inst/examples/sqlite.R c53681484b1c0cc3465761d78b6e6a9a *inst/examples/tuneRF.R 330b4feb7dd92b552d4c964d1b396b57 *man/foreach-ext.Rd d7815d0ede087f035df20c04269fa1a2 *man/foreach-package.Rd 6def37361268264b121c3285395a2142 *man/foreach.Rd a2931059de2699e1aff3ec1ba74395ac *man/getDoParWorkers.Rd c2257ea2aa9ca0397d0e9e816ab44549 *man/getDoSeqWorkers.Rd 3e5453b71511068dcf565b1fbf5ae796 *man/registerDoSEQ.Rd a578e292da0c3c4ec2273d7d90163779 *man/setDoPar.Rd 3f5fe2d451e14d2ac28eeb149d8a0bf0 *man/setDoSeq.Rd b46aa8cf6b531e438321718f41b75bcc *tests/testthat.R 6847b3f3da556bc5a1bdd7111b43f160 *tests/testthat/setup_cluster.R 7c5df100e42051e213e3a50952c94d3e *tests/testthat/test_combine.R e1b642e7aae94edda1bf06281b69c1bd *tests/testthat/test_error.R 1fb7524fa51660f65ec00f36cb13695c *tests/testthat/test_exportbug.R 3295889eee9cbbb195b9239d5295c569 *tests/testthat/test_foreach.R 46de12d52c87c7f4652189ead1cd2da1 *tests/testthat/test_iterator.R be9de7a7f7aeb1d6375cada62d499255 *tests/testthat/test_loadfactor.R db211fd764645333fa4cc6cea51bc5fb *tests/testthat/test_localdopar.R 4076414f6b646094bf1be48310bf26ea *tests/testthat/test_merge.R cd89311cb197bc02fe0f73e5378908f3 *tests/testthat/test_nested.R d962ededf79c0999170ada27e8baca0a *tests/testthat/test_packages.R 549adfdc2e28bd6070186bb6341ad95b *tests/testthat/test_stress.R 5f3b5befe3045fd92563ab7c9eb4699b *tests/testthat/test_when.R bb9adb7b804cf67cdd268e4996711e59 *vignettes/foreach.Rmd 533ad19d28eb363bbab44edeaa9591a7 *vignettes/nested.Rmd foreach/inst/0000755000176200001440000000000013617102076012641 5ustar liggesusersforeach/inst/examples/0000755000176200001440000000000013612556305014462 5ustar liggesusersforeach/inst/examples/bigmean.R0000644000176200001440000000264113612556305016212 0ustar liggesuserslibrary(foreach) library(RSQLite) # Define a simple iterator for a query result, which is # just a wrapper around the fetch function iquery <- function(con, statement, ..., n=1) { rs <- dbSendQuery(con, statement, ...) nextEl <- function() { d <- fetch(rs, n) if (nrow(d) == 0) { dbClearResult(rs) stop('StopIteration') } d } obj <- list(nextElem=nextEl) class(obj) <- c('abstractiter', 'iter') obj } # Create an SQLite instance m <- dbDriver('SQLite') # Initialize a new database to a tempfile and copy a data frame # into it repeatedly to get more data to process tfile <- tempfile() con <- dbConnect(m, dbname=tfile) data(USArrests) dbWriteTable(con, 'USArrests', USArrests) for (i in 1:99) dbWriteTable(con, 'USArrests', USArrests, append=TRUE) # Create an iterator to issue the query, selecting the fields of interest qit <- iquery(con, 'select Murder, Assault, Rape from USArrests', n=50) # Define a combine function for the partial results comb <- function(...) { n <- foreach(a=list(...), .combine='+') %do% a$n means <- foreach(a=list(...), .combine='+') %do% ((a$n / n) * a$means) list(n=n, means=means) } # Compute the mean of each of those fields, 50 records at a time r <- foreach(d=qit, .combine=comb, .multicombine=TRUE) %dopar% list(n=nrow(d), means=mean(d)) print(r) # Clean up dbDisconnect(con) file.remove(tfile) foreach/inst/examples/bigmax.R0000644000176200001440000000234413612556305016057 0ustar liggesuserslibrary(foreach) library(RSQLite) # Define a simple iterator for a query result, which is # just a wrapper around the fetch function. iquery <- function(con, statement, ..., n=1) { rs <- dbSendQuery(con, statement, ...) nextEl <- function() { d <- fetch(rs, n) if (nrow(d) == 0) { dbClearResult(rs) stop('StopIteration') } d } obj <- list(nextElem=nextEl) class(obj) <- c('abstractiter', 'iter') obj } # Create an SQLite instance. m <- dbDriver('SQLite') # Initialize a new database to a tempfile and copy a data frame # into it repeatedly to get more data to process. tfile <- tempfile() con <- dbConnect(m, dbname=tfile) data(USArrests) dbWriteTable(con, 'USArrests', USArrests) for (i in 1:99) dbWriteTable(con, 'USArrests', USArrests, append=TRUE) # Create an iterator to issue the query, selecting the fields of interest. # We then compute the maximum of each of those fields, 100 records at a time. qit <- iquery(con, 'select Murder, Assault, Rape from USArrests', n=100) r <- foreach(d=qit, .combine='pmax', .packages='foreach') %dopar% { foreach(x=iter(d, by='col'), .combine='c') %do% max(x) } print(r) # Clean up dbDisconnect(con) file.remove(tfile) foreach/inst/examples/pi.R0000644000176200001440000000033313612556305015214 0ustar liggesuserslibrary(foreach) w <- getDoParWorkers() n <- 10000000 h <- 1 / n pi <- foreach(i=1:w, .combine='+') %dopar% { x <- h * (seq(i, n, by=w) - 0.5) h * sum(4 / (1 + x * x)) } cat(sprintf('pi = %f\n', pi)) foreach/inst/examples/germandata.txt0000644000176200001440000031113013612556305017325 0ustar liggesusers 1 6 4 12 5 5 3 4 1 67 3 2 1 2 1 0 0 1 0 0 1 0 0 1 1 2 48 2 60 1 3 2 2 1 22 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 4 12 4 21 1 4 3 3 1 49 3 1 2 1 1 0 0 1 0 0 1 0 1 0 1 1 42 2 79 1 4 3 4 2 45 3 1 2 1 1 0 0 0 0 0 0 0 0 1 1 1 24 3 49 1 3 3 4 4 53 3 2 2 1 1 1 0 1 0 0 0 0 0 1 2 4 36 2 91 5 3 3 4 4 35 3 1 2 2 1 0 0 1 0 0 0 0 1 0 1 4 24 2 28 3 5 3 4 2 53 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 2 36 2 69 1 3 3 2 3 35 3 1 1 2 1 0 1 1 0 1 0 0 0 0 1 4 12 2 31 4 4 1 4 1 61 3 1 1 1 1 0 0 1 0 0 1 0 1 0 1 2 30 4 52 1 1 4 2 3 28 3 2 1 1 1 1 0 1 0 0 1 0 0 0 2 2 12 2 13 1 2 2 1 3 25 3 1 1 1 1 1 0 1 0 1 0 0 0 1 2 1 48 2 43 1 2 2 4 2 24 3 1 1 1 1 0 0 1 0 1 0 0 0 1 2 2 12 2 16 1 3 2 1 3 22 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 1 24 4 12 1 5 3 4 3 60 3 2 1 1 1 1 0 1 0 0 1 0 1 0 2 1 15 2 14 1 3 2 4 3 28 3 1 1 1 1 1 0 1 0 1 0 0 0 1 1 1 24 2 13 2 3 2 2 3 32 3 1 1 1 1 0 0 1 0 0 1 0 1 0 2 4 24 4 24 5 5 3 4 2 53 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 1 30 0 81 5 2 3 3 3 25 1 3 1 1 1 0 0 1 0 0 1 0 0 1 1 2 24 2 126 1 5 2 2 4 44 3 1 1 2 1 0 1 1 0 0 0 0 0 0 2 4 24 2 34 3 5 3 2 3 31 3 1 2 2 1 0 0 1 0 0 1 0 0 1 1 4 9 4 21 1 3 3 4 3 48 3 3 1 2 1 1 0 1 0 0 1 0 0 1 1 1 6 2 26 3 3 3 3 1 44 3 1 2 1 1 0 0 1 0 1 0 0 0 1 1 1 10 4 22 1 2 3 3 1 48 3 2 2 1 2 1 0 1 0 1 0 0 1 0 1 2 12 4 18 2 2 3 4 2 44 3 1 1 1 1 0 1 1 0 0 1 0 0 1 1 4 10 4 21 5 3 4 1 3 26 3 2 1 1 2 0 0 1 0 0 1 0 0 1 1 1 6 2 14 1 3 3 2 1 36 1 1 1 2 1 0 0 1 0 0 1 0 1 0 1 4 6 0 4 1 5 4 4 3 39 3 1 1 1 1 0 0 1 0 0 1 0 1 0 1 3 12 1 4 4 3 2 3 1 42 3 2 1 1 1 0 0 1 0 1 0 0 0 1 1 2 7 2 24 1 3 3 2 1 34 3 1 1 1 1 0 0 0 0 0 1 0 0 1 1 1 60 3 68 1 5 3 4 4 63 3 2 1 2 1 0 0 1 0 0 1 0 0 1 2 2 18 2 19 4 2 4 3 1 36 1 1 1 2 1 0 0 1 0 0 1 0 0 1 1 1 24 2 40 1 3 3 2 3 27 2 1 1 1 1 0 0 1 0 0 1 0 0 1 1 2 18 2 59 2 3 3 2 3 30 3 2 1 2 1 1 0 1 0 0 1 0 0 1 1 4 12 4 13 5 5 3 4 4 57 3 1 1 1 1 0 0 1 0 1 0 0 1 0 1 3 12 2 15 1 2 2 1 2 33 1 1 1 2 1 0 0 1 0 0 1 0 0 0 1 2 45 4 47 1 2 3 2 2 25 3 2 1 1 1 0 0 1 0 0 1 0 1 0 2 4 48 4 61 1 3 3 3 4 31 1 1 1 2 1 0 0 1 0 0 0 0 0 1 1 3 18 2 21 1 3 3 2 1 37 2 1 1 1 1 0 0 0 1 0 1 0 0 1 2 3 10 2 12 1 3 3 2 3 37 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 2 9 2 5 1 3 3 3 1 24 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 30 2 23 3 5 3 2 3 30 1 1 1 1 1 0 0 1 0 0 1 0 0 0 1 2 12 2 12 3 3 1 1 3 26 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 2 18 3 62 1 3 3 4 1 44 3 1 2 2 1 0 0 1 0 0 1 0 1 0 1 1 30 4 62 2 4 4 4 3 24 3 2 1 1 1 0 1 1 0 1 0 0 0 1 1 1 48 4 61 1 5 2 4 4 58 2 2 1 1 1 0 1 1 0 0 0 0 1 0 2 4 11 4 14 1 2 2 4 3 35 3 2 1 1 1 1 0 1 0 0 1 0 0 0 1 4 36 2 23 3 5 3 4 3 39 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 6 2 14 3 1 2 2 2 23 3 1 1 2 1 0 1 1 0 1 0 1 0 0 1 4 11 4 72 1 3 3 4 2 39 3 2 1 1 1 1 0 1 0 0 1 0 1 0 1 4 12 2 21 2 3 2 2 1 28 3 1 1 1 1 0 0 0 1 0 1 0 0 1 1 2 24 3 23 5 2 3 2 2 29 1 1 1 1 1 0 0 1 0 0 1 0 1 0 1 2 27 3 60 1 5 3 2 3 30 3 2 1 2 1 0 1 1 0 0 1 0 0 0 1 4 12 2 13 1 3 3 2 3 25 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 18 2 34 5 3 3 1 2 31 3 1 1 2 1 0 1 1 0 0 1 0 0 1 1 2 36 3 22 1 5 3 4 4 57 1 2 1 2 1 1 0 1 0 0 0 0 0 1 2 4 6 1 8 5 3 3 2 1 26 2 1 2 1 1 1 0 0 0 0 1 0 1 0 1 2 12 2 65 5 1 3 1 4 52 3 1 1 2 1 0 0 1 0 0 1 0 0 0 2 4 36 4 96 1 3 2 2 3 31 2 2 1 1 1 0 0 1 0 0 1 0 0 1 1 3 18 2 20 1 5 2 2 3 23 3 1 1 1 1 1 0 1 0 0 1 0 0 0 1 1 36 4 62 1 2 2 4 4 23 3 2 1 2 1 0 0 0 1 1 0 0 1 0 2 2 9 2 14 1 3 4 1 1 27 1 1 1 2 1 0 0 1 0 0 1 0 0 1 1 2 15 4 15 5 5 3 4 1 50 3 2 1 2 1 0 0 0 0 0 1 0 0 1 1 2 36 0 20 1 5 3 4 4 61 3 1 1 2 1 0 0 1 0 0 0 0 0 0 2 2 48 0 144 1 3 3 2 3 25 3 1 1 2 1 0 0 1 0 0 1 0 0 1 2 4 24 2 32 1 2 2 4 2 26 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 4 27 2 52 5 5 3 4 2 48 3 4 2 2 1 0 0 1 0 0 1 0 0 1 1 4 12 2 22 1 2 2 2 3 29 1 1 1 1 1 0 0 1 0 0 1 0 0 1 1 2 12 2 10 4 3 4 1 1 22 3 1 1 1 1 1 0 1 0 0 1 0 0 1 1 4 36 2 18 1 3 3 4 4 37 2 1 1 2 1 0 0 1 0 0 0 0 0 1 2 4 36 2 24 5 3 2 4 3 25 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 36 2 81 1 3 2 2 2 30 1 1 1 1 1 0 1 1 0 0 1 0 0 1 1 4 7 4 7 5 5 3 2 2 46 3 2 1 2 1 0 0 1 0 1 0 0 1 0 1 1 8 4 12 1 5 3 4 4 51 1 2 2 2 1 0 0 1 0 0 0 0 0 0 1 2 42 4 60 1 4 2 1 1 41 1 2 1 1 1 0 0 1 0 0 1 0 1 0 1 1 36 2 20 5 5 3 4 4 40 3 1 1 2 1 0 0 1 0 0 1 0 0 0 2 1 12 4 15 1 5 3 4 4 66 3 2 1 1 1 0 1 1 0 0 0 0 0 0 1 1 42 2 40 1 2 3 3 3 34 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 2 11 3 48 1 4 3 4 2 51 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 54 0 94 5 3 3 2 2 39 3 1 2 1 1 0 1 1 0 0 1 0 1 0 1 2 30 2 38 1 2 4 1 2 22 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 24 2 59 5 2 2 1 3 44 3 2 1 2 1 0 0 1 0 0 1 0 0 1 2 4 15 2 12 3 5 3 3 2 47 2 1 1 2 1 0 0 1 0 0 1 0 0 1 1 4 18 2 16 2 3 2 4 2 24 3 1 1 1 1 0 0 1 0 1 0 0 1 0 1 1 24 2 18 1 5 2 4 1 58 3 1 1 2 1 0 0 0 0 0 1 0 1 0 1 1 10 2 23 1 5 3 4 1 52 3 1 1 1 1 0 0 1 0 0 1 0 1 0 1 4 12 4 14 1 3 2 2 1 29 3 2 1 2 1 0 0 0 0 0 1 0 0 0 1 2 18 4 13 1 2 2 1 2 27 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 2 36 2 126 2 3 3 4 4 47 3 1 2 2 1 0 0 1 0 0 0 0 0 1 2 1 18 2 22 2 4 3 3 3 30 3 1 2 2 1 1 0 1 0 0 1 0 0 0 1 1 12 0 11 1 4 3 3 1 28 3 2 1 1 1 0 0 1 0 0 1 0 0 1 2 4 12 4 6 1 5 3 4 1 56 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 12 4 14 1 5 3 3 1 54 3 1 1 1 1 0 1 1 0 0 1 0 0 1 1 4 12 4 8 5 5 2 3 2 33 1 1 2 1 1 0 0 1 0 0 1 0 1 0 2 3 24 4 36 5 5 3 4 4 20 3 2 1 1 1 0 0 0 1 1 0 0 0 1 1 2 12 2 13 4 5 3 4 1 54 3 1 1 2 1 1 0 1 0 0 1 0 0 1 1 2 54 0 159 1 2 3 4 4 58 3 1 1 2 1 0 0 1 0 1 0 0 0 1 2 4 12 4 20 5 4 2 2 3 61 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 2 18 2 26 2 3 3 4 3 34 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 2 36 4 23 1 5 3 4 1 36 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 2 20 3 71 5 4 3 4 2 36 1 2 2 2 1 0 1 1 0 1 0 0 0 0 1 4 24 2 15 2 5 4 4 1 41 3 1 1 1 1 1 0 1 0 1 0 0 1 0 1 2 36 2 23 1 4 3 4 3 24 3 1 1 1 1 0 0 1 0 1 0 0 0 1 1 4 6 3 9 1 3 2 2 1 24 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 2 9 4 19 1 4 3 3 3 35 3 1 1 2 1 0 0 1 0 1 0 0 0 1 1 4 12 2 24 5 2 4 4 3 26 3 1 1 2 1 0 1 1 0 1 0 0 0 1 1 2 24 4 119 1 3 3 3 3 39 3 2 2 2 1 0 0 0 1 0 1 0 0 0 2 4 18 1 65 1 5 3 4 4 39 1 2 2 2 1 1 0 1 0 0 1 0 0 0 2 2 12 2 61 1 4 3 2 3 32 3 1 1 1 1 1 0 1 0 0 1 0 0 1 1 1 24 2 77 5 2 2 2 2 30 3 1 1 2 2 0 0 1 0 0 1 0 0 1 1 2 14 2 14 3 5 4 2 1 35 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 2 6 3 14 2 5 1 2 3 31 1 2 2 1 1 0 0 1 0 0 1 0 0 1 1 3 15 2 4 1 2 2 4 2 23 3 1 1 2 1 0 0 1 0 1 0 0 0 1 1 2 18 2 63 1 4 3 3 1 28 3 1 1 1 1 1 0 1 0 1 0 0 1 0 1 4 36 4 79 1 3 2 2 1 25 2 2 1 2 1 1 0 1 0 0 1 0 0 1 2 1 12 2 17 3 5 4 1 1 35 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 48 4 36 5 5 3 1 1 47 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 1 42 2 72 5 4 2 3 3 30 3 1 1 2 1 0 0 1 0 0 1 0 0 0 2 1 10 4 21 5 2 2 3 1 27 3 2 1 1 2 0 0 0 1 1 0 0 0 1 1 1 33 4 43 3 3 2 4 3 23 3 2 1 1 1 0 0 1 0 0 1 0 0 1 2 2 12 4 24 3 4 1 3 3 36 3 1 1 2 1 1 0 1 0 0 1 0 0 0 1 1 21 2 18 1 3 2 2 1 25 3 2 1 2 1 0 0 1 0 0 1 0 0 1 2 4 24 4 39 1 5 2 2 3 41 3 2 1 2 1 0 1 1 0 1 0 0 0 0 1 4 12 2 18 1 3 3 2 1 24 3 1 1 1 1 0 0 1 0 1 0 0 1 0 1 3 10 4 8 1 5 3 4 4 63 3 2 1 2 1 1 0 1 0 0 0 0 0 1 1 2 18 2 19 5 2 2 3 1 27 3 1 1 1 1 0 0 1 0 1 0 0 0 1 2 1 12 4 21 1 3 3 2 2 30 3 2 1 1 1 1 0 1 0 0 1 0 0 1 1 1 12 2 7 1 3 4 2 1 40 3 1 1 1 1 0 0 1 0 0 1 0 1 0 1 2 12 2 6 1 3 3 2 3 30 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 2 12 4 19 1 1 3 2 3 34 3 2 1 2 1 0 1 1 0 0 1 0 0 0 1 1 12 4 35 1 3 2 2 1 29 3 2 1 1 1 1 0 0 1 0 1 0 0 1 2 2 48 2 85 5 4 2 2 3 24 3 1 1 1 1 1 0 1 0 0 1 0 0 1 1 1 36 3 69 1 3 3 3 2 29 2 1 1 2 1 0 0 1 0 0 1 0 0 1 2 4 15 2 27 1 2 3 3 2 27 1 2 1 1 1 0 0 1 0 0 1 0 1 0 1 4 18 2 20 1 3 3 4 4 47 1 2 1 1 1 0 0 1 0 0 0 0 0 1 1 4 60 2 101 2 4 2 4 1 21 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 4 12 4 12 5 5 2 2 1 38 3 2 1 2 1 0 0 1 0 0 1 0 0 1 1 4 27 3 86 4 3 3 2 3 27 3 2 1 1 1 0 1 1 0 0 1 0 0 1 1 2 12 2 8 3 3 3 3 1 66 3 1 1 1 1 0 0 1 0 0 1 0 1 0 2 2 15 4 27 5 4 3 2 1 35 1 3 1 2 1 0 0 0 0 0 1 0 0 1 1 3 12 2 19 1 3 2 2 3 44 3 1 1 2 1 0 0 1 0 1 0 0 1 0 1 3 6 2 7 4 2 4 2 1 27 3 1 1 1 2 1 0 1 0 0 1 1 0 0 1 2 36 2 48 1 2 2 1 4 30 3 1 1 2 1 0 0 1 0 0 1 0 0 0 1 1 27 2 34 1 3 3 2 3 27 3 1 1 1 1 0 0 1 0 0 1 0 0 0 1 1 18 2 25 1 3 3 2 3 22 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 4 21 4 23 1 2 2 4 2 23 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 2 48 1 36 2 4 3 2 3 30 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 6 4 9 1 5 2 4 4 39 3 2 1 2 1 1 0 1 0 0 1 0 0 1 1 4 12 4 7 2 4 2 3 3 51 3 2 1 2 1 1 0 1 0 0 1 0 0 1 1 1 36 4 54 1 3 3 2 2 28 3 2 1 1 1 0 0 0 0 0 1 0 0 1 1 4 18 4 16 4 5 3 4 3 46 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 4 6 2 13 2 5 3 4 4 42 1 1 2 2 1 0 0 1 0 0 0 0 0 1 1 4 10 2 19 1 3 3 4 2 38 3 1 1 2 2 0 0 1 0 0 1 0 0 1 1 3 36 2 58 1 3 3 1 3 24 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 2 24 4 78 4 5 2 4 4 29 3 1 1 1 1 0 1 1 0 1 0 0 0 1 1 2 24 3 70 2 4 3 4 3 36 3 1 1 2 1 0 0 1 0 1 0 0 0 0 1 1 12 2 13 1 3 2 4 3 20 3 1 1 1 1 0 0 1 0 1 0 0 0 1 2 1 9 4 13 2 5 3 4 1 48 3 2 2 1 2 0 0 0 0 0 1 0 0 1 1 1 12 1 3 1 5 4 1 3 45 1 1 1 1 1 0 0 1 0 0 1 0 1 0 1 2 24 2 35 2 4 3 3 3 38 1 2 1 2 1 1 0 1 0 0 1 0 0 1 1 4 6 4 19 5 3 3 2 1 34 3 2 2 1 1 0 0 1 0 0 1 0 1 0 1 4 24 4 29 2 5 3 4 1 36 3 1 2 2 1 0 0 1 0 0 1 0 0 1 1 4 18 4 11 1 2 2 1 2 30 3 2 1 1 1 1 0 1 0 0 1 0 0 1 1 4 15 2 13 3 4 3 3 2 36 3 2 1 2 1 0 0 1 0 0 1 0 0 1 1 2 10 2 73 1 1 3 4 4 70 1 1 1 2 1 1 0 1 0 0 0 0 0 0 1 4 36 2 9 3 5 3 4 2 36 3 1 1 1 1 1 0 1 0 0 1 0 0 1 1 4 6 2 30 3 3 3 2 3 32 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 1 18 2 11 1 1 2 2 3 33 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 2 11 2 16 4 2 2 1 1 20 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 24 2 40 1 4 2 4 2 25 3 1 1 2 1 0 0 1 0 1 0 0 0 1 1 2 24 4 19 1 5 1 4 1 31 3 2 1 2 1 0 0 1 0 0 1 0 0 1 2 1 15 0 10 1 5 3 3 3 33 3 2 2 1 1 1 0 1 0 1 0 0 0 1 2 4 12 2 8 1 3 2 1 1 26 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 2 24 3 21 1 1 2 2 2 34 3 1 1 2 1 0 0 1 0 0 1 0 0 0 2 2 8 2 14 1 3 3 2 1 33 3 1 1 1 2 0 0 0 0 0 1 0 0 1 1 1 21 3 34 1 2 3 1 2 26 3 2 1 1 1 0 0 1 0 0 1 0 0 1 2 4 30 1 75 5 1 2 1 1 53 1 1 1 2 1 0 1 1 0 0 1 0 0 0 2 1 12 2 26 1 3 1 1 3 42 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 6 4 3 3 5 3 4 3 52 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 4 12 2 20 1 4 3 2 3 31 3 2 2 2 1 0 0 1 0 1 0 0 0 0 1 1 21 4 6 1 5 3 4 1 65 3 2 1 1 1 1 0 1 0 0 1 0 0 1 1 4 36 3 96 1 2 1 1 3 28 3 2 1 1 1 0 0 1 0 0 1 0 0 1 2 2 36 3 45 1 3 1 2 1 30 2 2 1 2 1 0 0 1 0 0 1 0 0 0 2 1 21 1 16 5 3 3 2 2 40 3 2 2 1 1 1 0 1 0 0 1 0 1 0 2 4 24 4 38 4 3 3 4 1 50 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 2 18 4 9 1 5 3 4 3 36 1 1 2 2 1 1 0 1 0 0 1 0 0 1 2 4 15 4 14 1 3 3 2 2 31 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 2 9 1 51 1 5 2 4 4 74 1 1 2 2 1 0 1 1 0 0 0 0 0 0 2 2 16 4 12 1 1 3 3 3 68 3 3 1 2 1 1 0 1 0 0 0 1 0 0 1 1 12 2 7 2 4 4 1 2 20 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 2 18 0 32 1 3 2 4 3 33 1 2 1 2 1 0 0 1 0 0 1 0 0 1 1 4 24 2 46 4 3 3 3 2 54 3 3 1 2 1 0 0 1 0 0 1 0 0 0 2 2 48 0 38 2 4 3 4 4 34 3 1 2 1 1 0 0 1 0 0 0 0 1 0 2 2 27 2 39 1 3 3 2 3 36 3 1 2 2 1 0 0 1 0 0 1 0 0 1 2 4 6 2 21 1 4 4 2 1 29 3 1 1 1 1 0 0 1 0 1 0 0 0 1 1 2 45 2 30 2 3 3 4 2 21 3 1 1 1 1 0 0 0 0 1 0 0 0 1 2 2 9 4 15 1 5 2 3 3 34 3 2 1 2 1 0 0 1 0 0 1 0 0 0 2 4 6 4 14 1 3 2 1 3 28 3 2 1 2 1 0 0 1 0 0 1 0 0 1 1 2 12 2 10 2 2 2 4 3 27 1 4 1 1 1 0 0 1 0 1 0 0 0 1 2 2 24 2 28 5 5 3 4 4 36 1 1 1 2 1 0 1 1 0 0 0 0 0 1 1 2 18 3 43 1 5 1 3 4 40 3 1 1 2 1 0 0 1 0 0 1 0 0 0 2 4 9 4 9 3 5 3 2 3 52 3 2 1 2 1 0 0 1 0 0 1 0 0 1 1 1 12 2 12 1 3 4 3 1 27 3 1 1 1 1 1 0 1 0 0 1 0 1 0 1 4 27 3 51 1 4 3 4 3 26 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 1 12 2 9 1 4 4 4 2 21 3 1 1 1 1 0 0 1 0 1 0 0 0 1 2 4 12 4 15 1 5 3 1 1 38 3 2 2 1 1 1 0 1 0 0 1 0 1 0 1 1 30 4 106 1 5 3 4 4 38 3 3 2 2 1 0 1 1 0 0 0 0 0 0 1 4 12 4 19 1 5 3 4 1 43 3 3 1 2 1 0 0 1 0 0 1 0 0 1 1 2 12 4 14 1 4 3 3 2 26 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 24 2 66 1 3 4 2 3 21 2 1 1 1 1 0 0 1 0 0 1 0 1 0 1 4 12 2 14 4 4 3 2 2 55 3 1 1 1 2 0 1 1 0 0 1 0 0 1 1 4 9 4 31 5 3 3 2 1 33 3 2 2 1 1 0 0 1 0 0 1 0 0 1 1 4 36 2 38 5 5 2 4 1 45 3 1 1 2 1 0 0 1 0 0 1 0 1 0 1 1 27 0 53 1 1 3 4 2 50 2 2 1 2 1 0 0 1 0 0 1 0 0 1 2 3 30 3 19 1 5 3 4 1 66 3 1 1 2 1 0 0 1 0 0 1 0 0 0 2 4 36 4 33 5 5 3 2 3 51 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 2 6 4 9 5 4 2 3 2 39 3 2 1 1 1 0 0 1 0 0 1 0 1 0 1 1 18 0 31 1 4 3 1 2 31 1 1 1 2 1 0 0 1 0 0 1 0 0 1 1 3 36 2 39 1 3 3 2 1 23 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 1 24 2 30 1 3 1 2 1 24 3 1 1 1 1 0 0 1 0 1 0 0 1 0 1 4 10 2 14 1 3 2 4 3 64 3 1 1 2 1 1 0 1 0 0 1 0 0 1 1 2 12 2 6 1 2 4 1 1 26 1 1 1 1 1 0 0 0 0 0 1 0 1 0 1 1 12 2 12 5 3 2 4 2 23 1 1 1 2 1 0 0 1 0 1 0 0 0 1 1 4 12 2 7 1 3 3 2 1 30 1 2 1 1 1 0 0 1 0 0 1 0 0 1 1 4 24 3 30 5 3 3 4 1 32 3 2 2 2 1 0 0 1 0 0 1 0 0 1 1 4 15 2 47 1 3 3 2 3 30 3 1 1 2 1 0 1 1 0 0 1 0 0 1 1 4 36 0 26 1 3 3 2 3 27 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 2 48 2 110 4 4 3 2 4 27 1 2 1 2 1 0 0 0 1 0 1 0 0 1 2 1 12 2 79 1 5 3 4 4 53 3 1 1 2 1 0 0 1 0 0 0 0 0 0 2 4 9 2 15 1 4 3 2 3 22 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 1 24 2 31 1 2 3 1 4 22 1 1 1 1 1 0 0 1 0 0 0 0 0 1 1 3 36 2 42 1 3 3 2 3 26 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 4 9 2 25 3 5 3 4 4 51 3 1 1 1 1 1 0 1 0 0 0 0 1 0 1 4 12 2 21 2 4 3 1 4 35 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 2 18 2 9 1 3 4 2 1 25 3 1 1 1 1 0 0 0 0 0 1 0 1 0 1 4 4 4 15 1 4 3 1 1 42 3 3 2 1 1 0 0 1 0 0 1 0 1 0 1 1 24 2 18 1 1 3 2 3 30 2 1 2 1 1 0 0 1 0 0 1 0 0 0 2 2 6 2 146 5 1 3 2 2 23 3 1 1 2 1 1 0 1 0 0 1 1 0 0 2 2 21 2 28 2 5 1 2 3 61 1 2 1 1 1 0 0 1 0 1 0 0 1 0 2 4 12 4 13 1 3 2 2 2 35 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 1 30 2 25 1 5 3 3 2 39 3 1 2 1 1 0 0 0 0 0 1 0 0 1 1 1 24 2 9 5 5 2 2 3 29 1 1 1 1 1 1 0 1 0 0 1 0 0 1 2 4 6 2 16 1 4 3 2 2 51 3 1 2 1 1 0 0 1 0 0 1 0 0 1 1 1 48 0 46 1 5 3 4 4 24 3 2 2 1 1 0 1 1 0 0 0 0 0 1 2 4 12 4 12 1 3 2 2 1 27 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 4 12 1 34 3 3 2 3 1 35 3 1 2 1 1 0 0 1 0 0 1 0 1 0 1 4 24 2 13 1 4 3 1 1 25 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 4 12 4 7 1 5 3 4 1 52 3 3 1 1 1 0 0 1 0 0 1 0 0 1 1 4 6 0 12 2 3 3 1 4 35 1 1 1 1 2 1 0 1 0 1 0 0 0 1 1 3 24 2 19 1 3 3 2 1 26 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 18 2 4 1 1 2 4 1 22 3 1 1 1 1 0 0 0 1 1 0 0 0 1 2 1 6 4 7 4 4 2 4 1 39 3 2 1 2 1 1 0 1 0 0 1 0 1 0 1 3 12 2 23 1 3 2 2 3 46 3 1 1 1 1 0 0 1 0 0 1 0 1 0 1 2 30 2 22 1 3 2 2 4 24 1 1 1 1 1 1 0 0 0 0 1 0 0 1 2 4 24 3 42 2 3 3 3 2 35 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 2 9 2 20 5 4 3 1 3 24 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 2 60 3 74 5 3 3 1 1 27 3 1 1 1 1 0 0 1 0 0 1 0 1 0 1 4 24 4 27 1 3 3 2 1 35 3 2 1 1 1 0 0 1 0 0 1 0 1 0 1 1 12 1 21 1 3 1 1 4 29 3 1 1 1 1 0 0 1 0 0 0 0 0 1 2 4 15 2 38 2 2 2 4 3 23 3 1 1 2 1 0 1 1 0 0 1 0 0 1 1 4 11 4 12 2 1 2 4 1 57 3 3 1 1 1 0 0 1 0 0 1 0 1 0 1 1 12 2 17 1 3 3 2 1 27 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 24 2 16 1 5 2 4 3 55 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 18 4 53 1 5 3 4 4 36 3 3 1 2 1 1 0 1 0 0 0 0 0 0 1 4 12 4 27 1 5 2 4 4 57 1 3 1 1 1 0 0 1 0 0 0 0 1 0 1 4 10 4 12 1 5 3 4 1 32 3 2 2 1 2 1 0 1 0 0 1 0 1 0 1 2 15 2 8 1 5 3 3 3 37 3 1 2 1 1 0 0 1 0 0 1 0 0 1 2 4 36 4 63 5 5 3 4 1 36 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 4 24 2 15 1 2 2 3 3 38 2 1 1 2 1 0 0 1 0 0 1 0 0 1 1 1 14 2 90 1 5 1 4 2 45 3 1 1 2 2 1 0 1 0 0 1 0 0 0 2 4 24 2 10 5 5 3 2 3 25 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 4 18 2 27 5 4 3 3 2 32 3 1 1 1 2 1 0 1 0 0 1 0 0 1 1 4 12 4 14 3 4 2 4 3 37 3 1 1 2 1 0 0 1 0 1 0 0 0 1 1 2 48 1 122 5 1 3 4 4 36 3 1 1 2 1 1 0 0 1 0 0 0 0 0 1 2 48 2 31 1 4 3 4 1 28 3 2 1 1 1 0 0 1 0 0 1 0 0 1 2 1 30 2 120 1 2 1 1 4 34 3 1 1 2 1 0 0 1 0 0 1 0 1 0 2 4 9 2 27 1 3 3 2 1 32 3 1 2 1 1 0 0 1 0 0 1 0 0 1 1 4 18 4 24 1 3 2 2 3 26 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 1 12 2 13 5 5 1 4 2 49 3 1 1 2 1 0 0 1 0 0 1 0 1 0 1 4 6 2 46 1 2 2 4 2 32 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 4 24 2 19 2 3 3 4 3 29 3 1 1 2 1 0 0 1 0 1 0 0 0 0 1 4 15 4 34 4 5 3 4 4 23 3 2 1 2 1 0 1 1 0 1 0 0 0 1 1 4 12 2 16 1 3 3 2 1 50 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 3 18 1 14 5 4 3 4 3 49 1 1 1 1 1 0 0 1 0 0 1 0 1 0 1 4 15 4 15 5 5 3 4 2 63 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 2 24 4 39 2 2 1 2 3 37 3 1 1 2 1 1 0 1 0 0 1 0 0 1 1 1 47 2 107 1 2 2 1 1 35 3 1 1 2 1 1 0 1 0 0 1 0 1 0 1 1 48 2 48 1 4 3 3 2 26 3 1 2 1 1 0 1 1 0 0 1 0 0 1 1 2 48 3 76 2 1 3 4 4 31 3 1 1 2 1 0 0 1 0 0 0 0 0 0 1 2 12 2 11 1 3 2 4 1 49 3 2 1 2 1 0 0 0 0 0 1 0 0 1 1 1 24 3 10 1 2 4 4 1 48 2 1 1 1 1 0 0 1 0 0 1 0 0 1 2 4 12 2 11 1 3 4 2 1 26 3 1 1 2 2 0 0 1 0 0 1 0 0 1 1 2 36 2 94 1 2 4 4 3 28 3 1 1 2 1 0 1 1 0 1 0 0 0 0 2 1 24 4 64 1 5 2 4 4 44 3 2 2 2 1 0 1 1 0 0 0 0 0 0 1 3 42 4 48 1 5 3 4 4 56 3 1 1 1 1 0 1 1 0 0 0 0 0 1 1 4 48 4 76 5 5 1 2 3 46 1 2 2 1 1 0 0 1 0 0 1 0 0 0 1 2 48 2 100 1 2 2 2 3 26 3 1 1 2 1 0 0 1 0 0 1 0 0 1 2 4 12 2 47 5 2 2 4 3 20 3 1 1 1 1 0 1 1 0 1 0 0 0 1 1 4 10 2 13 5 5 3 2 2 45 3 1 1 1 2 1 0 0 1 0 1 0 1 0 1 4 18 2 25 1 3 3 4 1 43 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 2 21 4 27 4 4 3 2 3 32 3 2 1 2 1 0 0 1 0 0 1 0 0 1 1 4 6 2 7 1 1 2 4 1 54 3 1 1 2 1 1 0 1 0 0 1 1 0 0 1 2 36 0 38 1 3 2 1 3 42 3 1 1 2 1 0 0 1 0 0 1 0 0 1 2 3 24 4 13 5 4 3 2 1 37 1 2 2 1 1 1 0 1 0 0 1 0 1 0 2 1 10 4 10 1 4 3 3 2 49 3 2 1 2 1 1 0 0 1 0 1 0 0 1 1 4 48 4 101 3 3 3 2 4 44 1 1 1 1 1 1 0 1 0 0 0 0 0 1 2 4 6 2 15 4 3 1 2 1 33 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 30 2 48 5 4 2 4 2 24 2 1 1 1 1 0 1 1 0 1 0 0 1 0 1 1 12 2 7 2 2 4 3 4 33 3 1 1 2 1 0 0 1 0 0 1 0 1 0 2 2 8 2 12 1 3 2 4 1 24 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 2 9 2 3 1 3 4 4 1 22 3 1 1 1 1 1 0 1 0 1 0 0 1 0 1 2 48 2 54 5 1 3 4 4 40 1 1 1 2 1 0 0 1 0 0 0 1 0 0 1 4 24 2 55 2 3 3 1 3 25 2 1 1 1 1 0 0 1 0 0 1 0 0 1 1 3 24 2 37 1 2 2 4 3 26 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 2 12 2 7 1 4 4 3 3 25 1 1 1 1 1 1 0 1 0 0 1 0 1 0 2 3 4 2 15 5 2 3 2 1 29 3 1 2 1 2 1 0 1 0 0 1 0 1 0 1 1 36 1 27 1 5 3 4 3 31 1 1 1 1 1 0 0 1 0 0 1 0 0 1 2 1 12 2 7 1 3 3 3 2 38 3 1 2 1 1 0 0 0 0 0 1 0 1 0 1 2 24 2 44 5 3 2 4 2 48 3 1 1 2 1 0 0 1 0 0 1 0 1 0 1 4 12 4 7 1 3 3 2 3 32 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 1 15 3 36 1 5 2 4 2 27 3 2 1 1 1 0 0 1 0 0 1 0 1 0 1 2 30 4 42 1 1 4 2 3 28 3 2 1 1 1 1 0 1 0 0 1 0 0 0 2 1 24 2 19 1 2 1 3 2 32 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 1 24 2 29 1 4 3 1 4 34 3 1 1 2 1 0 1 1 0 0 0 0 0 0 1 1 18 2 27 4 3 3 2 3 28 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 18 4 10 1 3 2 3 1 36 3 2 1 1 1 1 0 1 0 0 1 0 0 1 1 1 8 4 34 1 4 3 4 1 39 3 2 1 1 2 1 0 1 0 0 1 0 1 0 1 4 12 4 58 5 5 3 4 2 49 3 1 1 2 1 0 0 1 0 1 0 0 0 1 1 4 24 2 15 4 4 2 3 3 34 3 1 2 2 1 1 0 1 0 0 1 0 0 1 1 3 36 2 45 1 5 3 2 3 31 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 2 6 2 11 1 5 3 4 3 28 3 1 2 1 1 0 0 1 0 0 1 0 0 1 1 1 24 4 66 1 1 3 4 4 75 3 2 1 2 1 0 1 1 0 0 0 0 0 0 1 4 18 4 19 2 3 2 2 1 30 3 2 1 1 1 0 0 1 0 0 1 0 0 1 2 2 60 2 74 2 2 2 2 2 24 3 1 1 1 1 1 0 1 0 0 1 0 0 0 2 4 48 4 116 2 3 2 4 3 24 1 2 1 1 1 0 1 1 0 1 0 0 1 0 2 1 24 0 41 1 5 3 4 4 23 1 2 2 1 1 0 0 1 0 1 0 0 0 1 2 1 6 4 34 1 3 1 4 1 44 3 1 1 2 1 0 0 1 0 1 0 0 0 0 2 2 13 2 21 1 2 2 4 2 23 3 1 1 1 1 0 0 0 0 0 1 0 1 0 1 1 15 2 13 5 3 2 2 3 24 3 1 1 1 1 0 0 1 0 1 0 0 0 1 2 1 24 2 42 1 3 3 4 2 28 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 2 10 2 15 1 3 1 2 3 31 3 1 1 1 1 0 0 1 0 0 1 0 1 0 1 2 24 4 57 1 2 2 4 4 24 3 2 1 2 1 0 0 1 0 0 0 0 0 1 1 1 21 2 36 1 4 2 4 3 26 3 1 1 1 1 0 0 1 0 1 0 0 1 0 1 2 18 2 32 3 2 4 3 1 25 3 1 1 1 1 0 0 1 0 1 0 0 0 1 1 2 18 2 44 1 5 3 1 1 33 1 1 1 2 1 0 0 0 1 0 1 0 0 0 1 3 10 2 39 1 2 3 1 2 37 3 1 2 1 1 1 0 0 0 0 1 0 1 0 1 4 15 4 15 1 3 2 2 3 43 3 1 1 1 1 0 0 1 0 0 1 0 1 0 1 2 13 4 9 1 2 3 4 1 23 3 2 1 1 1 0 0 0 0 0 1 0 0 1 1 2 24 2 38 3 1 2 4 4 23 3 1 1 1 1 0 0 1 0 1 0 1 0 0 1 4 6 3 17 2 3 3 2 1 34 3 2 1 1 1 0 0 1 0 0 1 0 1 0 1 2 9 4 11 4 5 3 3 4 32 3 2 2 1 1 0 0 1 0 0 0 0 0 1 2 4 9 2 12 1 2 2 4 1 23 3 1 1 2 1 0 0 1 0 1 0 0 0 1 1 2 9 2 10 1 3 2 2 3 29 3 1 1 1 2 0 0 1 0 0 1 0 0 1 2 4 18 4 32 5 1 3 4 4 38 3 1 1 2 1 0 1 1 0 0 1 0 0 0 1 1 12 0 62 1 3 3 2 2 28 3 2 1 2 1 0 0 1 0 1 0 0 0 1 2 4 10 2 7 3 5 3 4 4 46 3 1 1 2 1 0 0 1 0 0 0 0 0 1 1 2 24 2 12 1 2 3 2 1 23 2 1 1 1 1 1 0 1 0 0 1 0 1 0 2 4 12 4 23 5 5 3 4 1 49 3 1 1 2 1 0 0 0 1 0 1 0 0 1 1 4 36 3 45 1 3 3 2 3 26 3 2 1 2 1 0 0 1 0 0 1 0 0 0 2 4 12 2 8 1 3 4 2 1 28 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 30 2 24 1 4 2 4 1 23 3 1 1 1 1 0 0 1 0 1 0 0 0 1 2 2 18 2 12 5 3 3 4 4 61 3 1 1 1 1 0 0 1 0 0 0 0 0 1 1 3 12 2 34 5 5 3 3 3 37 3 1 1 1 1 0 0 1 0 0 1 0 0 0 1 3 12 3 22 1 3 2 2 3 36 2 2 1 2 1 1 0 1 0 0 1 0 0 1 1 4 6 2 18 1 3 4 2 2 21 3 1 1 1 1 0 0 1 0 1 0 0 0 1 1 1 18 2 25 1 1 3 1 3 25 3 1 1 1 1 0 0 1 0 0 1 1 0 0 2 4 12 2 15 1 4 3 4 3 36 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 4 18 4 38 1 4 3 1 3 27 3 2 1 1 1 0 1 1 0 0 1 0 0 1 1 1 18 2 36 1 2 2 4 3 22 3 1 1 1 1 0 0 1 0 1 0 0 0 1 1 1 36 2 34 1 5 3 2 3 42 3 1 2 1 1 0 0 1 0 0 1 0 0 1 2 2 18 2 30 1 4 2 4 1 40 3 1 1 1 1 0 0 1 0 1 0 0 0 1 1 4 36 2 31 5 3 3 4 1 36 3 1 1 1 1 1 0 1 0 0 1 0 0 1 1 4 18 4 61 1 5 3 4 3 33 3 2 1 2 1 0 0 1 0 0 1 0 0 1 1 4 10 4 21 1 2 2 3 1 23 3 2 1 1 1 0 0 1 0 1 0 0 0 1 1 4 60 4 138 5 5 3 4 4 63 1 1 1 2 1 1 0 1 0 0 0 0 0 0 1 2 60 1 148 2 5 2 4 4 60 1 2 1 2 1 0 0 1 0 0 0 0 0 0 2 1 48 1 77 1 4 2 4 3 37 3 1 1 1 1 0 0 0 0 1 0 0 0 1 2 4 18 3 23 1 1 4 3 1 34 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 4 7 3 8 5 5 3 4 4 36 3 1 1 1 1 0 0 1 0 0 0 0 0 1 1 2 36 2 143 1 5 3 2 4 57 3 1 1 2 1 1 0 1 0 0 0 0 0 0 2 4 6 4 4 2 3 2 4 3 52 3 2 1 1 1 1 0 1 0 0 1 0 1 0 1 1 20 2 22 5 4 3 4 3 39 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 2 18 2 130 1 1 2 4 4 38 3 1 1 2 1 0 1 1 0 0 0 0 0 0 2 4 22 2 13 5 4 2 4 2 25 3 1 1 1 1 1 0 1 0 1 0 0 0 1 1 3 12 2 13 1 2 3 1 1 26 3 1 1 1 1 1 0 1 0 0 1 0 0 1 1 4 30 3 43 2 3 3 2 2 26 3 2 1 1 1 0 0 1 0 0 1 0 1 0 1 4 18 4 22 1 3 2 1 3 25 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 4 18 2 11 5 2 2 2 1 21 3 1 1 2 1 0 0 1 0 1 0 0 0 1 1 2 18 4 74 1 1 3 4 2 40 2 2 1 2 1 0 0 1 0 0 1 0 0 0 1 2 15 4 23 3 3 3 4 3 27 1 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 9 2 14 1 4 2 2 3 27 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 4 18 2 18 1 3 4 2 2 30 3 1 1 2 1 1 0 1 0 0 1 0 0 0 1 2 12 2 10 4 2 2 4 1 19 3 1 1 1 1 0 0 1 0 1 0 0 1 0 1 1 36 2 32 1 4 3 4 4 39 1 1 2 2 1 1 0 1 0 0 0 0 0 0 1 1 6 4 20 1 4 2 4 3 31 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 9 4 24 1 1 3 3 3 31 3 1 1 1 1 0 0 1 0 0 1 0 0 0 1 2 39 3 118 2 4 3 3 4 32 3 1 1 2 1 0 0 1 0 1 0 0 0 1 1 1 12 2 26 1 1 2 4 4 55 3 1 1 1 1 0 0 1 0 0 0 0 0 0 1 1 36 4 23 1 3 4 2 2 46 3 2 1 2 1 0 0 1 0 0 1 0 0 1 1 2 12 2 12 1 5 1 1 1 46 3 2 1 1 1 1 0 1 0 1 0 0 0 1 2 4 24 4 15 4 3 2 1 1 43 3 2 1 1 1 0 0 1 0 0 1 0 1 0 1 4 18 2 15 1 2 4 4 1 39 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 2 18 4 19 5 3 4 4 1 28 1 2 1 1 1 0 0 1 0 0 1 0 0 1 1 4 24 3 86 1 2 3 2 3 27 1 2 1 2 1 0 0 1 0 0 1 0 0 1 2 4 14 3 8 1 3 3 2 3 27 3 2 1 1 1 1 0 1 0 0 1 0 1 0 1 2 18 3 29 5 5 3 4 3 43 3 1 2 1 1 1 0 1 0 0 1 0 0 1 1 2 24 2 20 1 2 4 1 2 22 3 1 1 2 1 0 0 1 0 0 1 0 0 1 2 4 24 4 22 5 4 3 4 3 43 3 2 2 2 1 0 1 1 0 0 1 0 0 1 1 1 15 2 11 1 2 4 2 1 27 3 1 1 1 2 0 0 1 0 0 1 0 0 1 1 4 24 2 32 3 5 1 2 3 26 3 1 1 2 1 0 0 1 0 0 1 0 0 0 1 3 12 4 9 3 4 4 2 1 28 3 3 1 2 1 1 0 1 0 0 1 0 0 1 2 2 24 2 20 1 5 2 4 3 20 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 4 33 4 73 1 4 3 2 3 35 3 2 1 2 1 0 1 1 0 0 1 0 0 0 1 4 12 4 23 1 1 3 2 3 42 2 2 1 2 1 0 0 1 0 0 1 0 0 0 2 4 10 2 16 3 3 3 2 4 40 3 1 2 1 2 1 0 1 0 1 0 0 1 0 1 1 24 2 14 5 3 2 2 2 35 3 1 1 1 1 1 0 1 0 0 1 0 0 1 2 4 36 4 58 1 5 3 2 2 35 3 2 2 2 1 0 1 1 0 0 1 0 0 1 1 1 12 2 26 1 2 3 1 1 33 3 1 2 1 1 1 0 1 0 0 1 0 1 0 2 1 18 3 85 5 3 2 2 3 23 3 2 1 2 1 0 0 1 0 1 0 0 0 1 1 4 21 2 28 3 4 2 2 3 31 1 1 1 1 1 1 0 1 0 0 1 0 0 0 1 2 18 2 10 5 3 2 2 2 33 3 1 1 1 1 1 0 1 0 0 1 0 0 1 2 4 15 2 32 4 4 2 3 3 20 3 1 1 1 1 1 0 1 0 1 0 0 0 1 1 2 12 2 20 5 3 3 2 3 30 3 1 1 1 1 0 1 1 0 0 1 0 0 1 1 2 12 4 10 1 4 3 3 1 47 3 2 2 1 1 1 0 1 0 0 1 0 1 0 1 4 21 3 16 2 4 3 3 1 34 3 2 1 1 1 0 0 1 0 0 1 0 0 0 1 2 12 2 28 5 5 2 2 2 25 1 1 1 2 1 0 0 1 0 0 1 0 0 1 2 2 18 2 28 1 3 4 3 3 21 3 1 1 2 1 0 1 1 0 1 0 0 0 1 1 4 28 4 27 1 5 3 2 3 29 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 4 18 4 11 4 3 3 3 1 46 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 4 9 2 13 1 5 3 4 3 20 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 18 4 12 1 1 2 4 4 55 3 3 2 1 1 0 0 1 0 0 0 1 0 0 2 4 5 2 34 1 4 3 4 1 74 3 1 1 1 1 0 0 1 0 0 1 0 1 0 1 2 24 2 113 1 3 3 3 3 29 1 2 1 2 1 0 0 0 1 0 1 0 0 0 2 1 6 4 19 1 1 3 4 4 36 3 3 1 2 1 0 0 1 0 0 0 0 0 0 1 4 24 4 21 1 3 1 2 1 33 3 2 1 2 1 0 0 1 0 0 1 0 0 1 1 1 9 2 21 1 3 3 2 1 25 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 2 12 2 15 5 3 4 1 1 25 3 1 1 2 1 0 0 1 0 0 1 0 0 1 2 4 6 2 7 3 4 4 4 1 23 3 1 1 1 1 0 0 1 0 1 0 0 1 0 1 4 24 4 13 4 5 2 4 1 37 3 2 1 2 1 1 0 1 0 0 1 0 0 1 1 1 42 4 34 1 1 3 4 3 65 3 2 1 1 1 0 0 0 1 0 1 1 0 0 1 3 12 1 6 1 2 2 1 1 26 3 1 1 1 1 0 0 1 0 0 1 1 0 0 2 4 12 2 19 1 5 3 4 3 39 3 1 1 2 1 1 0 1 0 0 1 0 0 0 1 1 12 2 16 1 3 2 3 2 30 3 1 1 1 1 0 0 0 1 0 1 0 0 1 1 2 20 3 26 1 3 3 3 3 29 1 2 1 2 1 0 0 1 0 0 1 0 0 1 1 4 12 2 7 1 5 3 4 3 41 1 1 2 1 1 0 0 1 0 0 1 0 1 0 2 2 48 4 51 1 3 2 3 3 30 3 1 1 2 1 0 0 1 0 0 1 0 0 0 2 4 9 4 12 5 5 2 4 2 41 3 2 1 1 1 0 0 1 0 1 0 0 1 0 1 1 36 2 18 1 2 2 4 3 34 3 1 1 2 1 1 0 1 0 0 1 0 0 1 2 2 7 2 26 1 3 3 2 1 35 3 1 1 1 1 0 0 0 0 0 1 0 0 1 1 3 12 2 14 5 5 2 4 1 55 3 1 1 2 1 0 0 1 0 0 1 0 0 0 1 2 15 3 15 4 3 4 3 2 61 2 2 1 1 1 0 0 1 0 0 1 0 0 1 2 4 36 4 111 5 3 3 2 3 30 3 1 1 2 1 0 1 1 0 0 1 0 0 0 1 4 6 2 5 1 3 2 1 1 29 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 12 0 28 1 5 3 4 2 34 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 4 24 2 27 1 5 3 4 3 35 3 1 1 2 1 0 1 1 0 0 1 0 0 0 1 1 24 2 48 1 4 3 3 2 31 3 1 1 2 1 1 0 0 1 0 1 0 0 1 2 4 24 2 27 1 2 2 1 4 29 3 1 1 2 1 0 1 1 0 0 1 0 0 0 1 1 11 4 39 1 3 3 2 1 36 3 2 2 1 1 1 0 1 0 1 0 0 0 1 1 1 12 2 34 1 5 3 4 4 35 3 1 1 2 1 0 1 1 0 0 0 0 0 1 2 1 6 2 3 1 2 2 1 1 27 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 18 2 46 1 2 3 2 3 32 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 1 36 2 36 1 3 3 2 2 37 3 1 2 1 1 0 0 0 0 0 1 0 0 1 1 1 15 2 17 1 2 3 3 1 36 3 1 1 1 1 1 0 1 0 0 1 0 0 1 1 2 12 2 30 1 2 2 1 1 34 3 1 1 1 1 0 0 1 0 1 0 0 0 0 1 2 12 2 8 5 5 3 4 2 38 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 4 18 2 20 1 4 3 1 3 34 2 2 1 2 1 0 0 1 0 0 1 0 0 1 1 1 24 2 29 1 3 3 4 4 63 1 1 2 2 1 0 1 0 0 0 1 0 0 1 1 1 24 3 17 1 2 2 2 3 29 3 1 1 2 1 0 0 1 0 1 0 0 1 0 2 4 48 3 72 5 5 3 3 3 32 1 2 2 1 1 0 0 1 0 0 1 0 0 1 1 4 33 3 28 1 3 2 2 3 26 3 2 1 2 1 0 0 1 0 0 1 0 0 1 1 4 24 3 47 1 4 3 3 3 35 3 2 1 2 1 0 1 1 0 0 1 0 1 0 1 2 24 2 31 2 2 4 2 3 22 3 1 1 2 1 0 0 1 0 1 0 0 0 1 2 1 6 2 4 1 2 2 4 2 23 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 1 9 2 7 1 3 3 3 3 28 3 1 1 1 1 1 0 1 0 0 1 0 1 0 2 4 6 2 12 5 1 3 4 2 36 3 1 2 2 1 0 0 1 0 0 1 0 0 0 1 2 18 4 12 1 3 4 2 3 33 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 1 18 0 31 1 2 2 4 2 26 3 1 1 1 1 0 0 1 0 1 0 0 0 1 2 4 39 2 26 3 3 3 4 3 24 3 1 1 1 1 0 1 1 0 0 1 0 0 1 1 3 24 2 52 1 4 3 2 3 25 1 1 1 1 1 0 0 1 0 0 1 0 0 1 1 2 12 2 10 2 4 3 4 1 39 3 1 1 1 1 0 0 1 0 0 1 0 1 0 1 1 15 4 15 1 5 3 4 3 44 3 2 2 2 1 0 0 1 0 0 1 0 0 1 1 2 12 4 36 1 3 2 1 1 23 3 1 1 1 1 0 0 1 0 0 1 0 1 0 1 2 24 2 12 1 2 3 1 2 26 3 1 1 1 1 1 0 1 0 0 1 0 0 1 1 1 30 2 36 4 5 2 4 2 57 3 2 1 2 1 0 0 1 0 1 0 0 0 1 1 4 15 3 10 4 4 2 2 2 30 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 4 12 4 12 3 3 3 4 1 44 3 1 1 2 1 1 0 1 0 0 1 0 0 1 1 2 6 3 12 1 1 3 4 2 47 3 1 1 2 1 1 0 1 0 0 1 0 0 0 2 4 12 2 31 1 3 3 4 3 52 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 4 24 2 38 1 5 2 4 4 62 3 1 1 2 1 1 0 0 1 0 0 0 0 1 1 4 10 2 14 2 3 3 2 1 35 3 1 1 1 2 1 0 1 0 1 0 0 1 0 1 4 6 2 35 1 3 3 3 2 26 3 1 1 1 1 1 0 0 0 1 0 0 0 1 1 4 12 4 19 1 5 3 2 4 26 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 2 27 0 83 1 5 2 4 4 42 3 2 1 2 1 0 0 1 0 0 0 0 0 0 2 4 6 4 12 2 3 2 1 2 27 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 2 6 2 4 5 5 3 4 2 38 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 12 4 21 1 3 3 2 1 39 3 2 2 1 2 1 0 1 0 1 0 0 1 0 1 1 24 2 30 5 3 4 4 3 20 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 2 36 2 90 2 2 3 1 4 29 3 1 1 2 1 0 0 0 1 1 0 0 0 0 2 4 24 4 16 1 4 3 3 2 40 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 2 18 2 13 1 5 4 2 1 32 3 1 1 1 1 0 0 0 0 0 1 0 1 0 1 3 6 4 13 2 5 1 4 3 28 3 2 2 2 1 1 0 1 0 0 1 0 0 1 1 1 24 2 31 1 2 2 1 2 27 3 1 1 1 1 1 0 1 0 0 1 0 0 1 2 1 36 2 55 1 5 3 4 4 42 3 1 2 1 1 0 1 1 0 0 0 0 0 1 1 3 9 2 11 2 5 1 4 1 49 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 2 24 4 12 2 2 3 4 4 38 1 2 2 1 1 0 0 1 0 0 1 0 0 1 2 1 24 2 12 1 2 2 4 2 24 3 1 1 1 1 1 0 1 0 1 0 0 0 1 2 4 10 2 13 5 3 3 4 2 27 3 1 1 1 1 1 0 0 0 0 1 0 1 0 2 3 15 4 24 3 3 3 2 3 36 3 1 1 2 1 0 1 1 0 0 1 0 0 1 1 2 15 1 68 2 1 3 2 2 34 3 1 2 2 1 1 0 1 0 0 1 0 0 0 2 4 24 2 14 1 3 4 2 2 28 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 39 2 86 2 5 3 2 3 45 3 1 1 2 1 0 1 1 0 0 1 0 0 0 1 1 12 2 8 1 4 3 2 1 26 3 1 1 1 1 1 0 1 0 0 1 0 0 1 2 4 36 2 47 1 3 3 2 4 32 3 1 1 2 1 0 1 1 0 0 0 0 0 0 1 3 15 2 27 1 4 3 4 2 26 3 1 1 2 1 0 0 1 0 1 0 0 0 1 1 2 12 3 6 1 3 4 4 1 20 3 2 1 1 1 0 0 0 1 1 0 0 0 1 1 4 24 2 23 5 2 3 1 2 54 3 1 1 1 1 1 0 1 0 0 1 0 0 1 1 1 6 4 6 1 4 2 3 2 37 3 2 1 1 2 1 0 1 0 0 1 0 0 1 1 1 6 4 14 1 2 3 4 1 40 3 1 2 1 2 1 0 1 0 0 1 0 1 0 1 4 36 4 71 1 2 2 4 2 23 3 2 1 2 1 0 0 1 0 1 0 0 0 1 2 1 6 2 12 2 5 3 2 2 43 3 1 1 2 1 1 0 1 0 0 1 0 0 1 1 4 6 4 7 5 5 3 4 4 36 3 2 1 1 1 0 0 1 0 0 0 0 0 1 1 4 24 4 55 1 5 3 4 4 44 3 2 1 1 1 0 0 1 0 0 0 0 0 1 1 1 18 2 32 1 3 2 2 1 24 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 1 48 0 71 1 3 3 4 4 53 3 2 2 1 1 0 0 1 0 0 0 0 0 1 2 4 24 2 35 2 4 2 4 3 23 3 1 1 1 1 0 1 1 0 0 1 0 0 1 1 2 18 2 11 1 3 2 4 1 26 3 1 2 1 1 0 0 0 0 0 1 0 1 0 1 2 26 2 80 1 2 3 3 3 30 3 2 1 1 1 0 1 1 0 0 1 0 0 1 1 4 15 4 15 2 3 2 3 3 31 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 4 4 15 1 4 3 1 1 42 3 2 2 1 1 0 0 1 0 0 1 0 1 0 1 1 36 2 23 1 3 1 4 3 31 3 1 1 1 1 0 0 1 0 1 0 0 0 1 2 1 6 2 7 1 2 3 4 1 41 3 1 2 2 1 1 0 1 0 0 1 0 1 0 1 2 36 2 23 1 4 3 1 3 32 3 2 2 1 1 0 0 1 0 0 1 0 0 1 1 2 15 2 26 2 3 2 4 3 28 3 2 1 2 1 1 0 1 0 1 0 0 0 1 2 4 12 3 15 1 3 4 4 1 41 3 1 1 1 1 0 1 1 0 1 0 0 0 1 1 4 24 2 13 2 4 4 3 2 26 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 4 24 2 31 5 2 3 2 3 25 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 3 21 4 23 1 2 1 1 3 33 3 1 1 1 1 0 0 1 0 1 0 0 0 1 2 1 6 2 14 5 1 2 3 2 75 3 1 1 2 1 1 0 1 0 0 1 0 0 0 1 2 18 4 36 1 5 2 4 2 37 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 1 48 2 78 1 5 3 4 4 42 1 1 1 1 1 1 0 1 0 0 0 0 0 0 2 3 18 2 30 1 2 2 1 2 45 2 1 1 1 1 0 0 1 0 0 1 0 1 0 1 2 12 2 15 1 2 4 1 1 23 3 1 1 1 1 0 0 1 0 1 0 0 0 1 2 4 24 3 20 1 5 3 4 4 60 3 2 1 2 1 1 0 1 0 0 0 0 0 1 1 1 30 2 64 5 5 3 4 2 31 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 3 18 2 29 1 3 3 1 1 34 3 1 2 1 1 0 0 1 0 0 1 0 1 0 2 4 12 4 13 1 5 3 4 1 61 3 2 1 1 1 1 0 1 0 0 1 0 1 0 1 1 24 3 13 1 1 3 2 1 43 3 2 2 1 1 1 0 1 0 0 0 0 0 1 2 4 24 4 20 1 3 2 4 3 37 3 1 1 2 1 1 0 1 0 0 1 0 0 1 1 4 24 2 16 1 4 3 1 3 32 1 1 2 1 1 0 0 1 0 0 1 0 0 1 1 1 12 1 6 1 3 2 4 1 24 1 1 1 1 1 0 0 1 0 0 1 0 1 0 2 4 48 4 89 5 4 3 1 4 35 3 2 1 2 1 0 1 1 0 0 0 0 0 1 1 4 12 4 10 5 4 2 4 1 23 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 4 6 1 18 3 5 3 4 2 45 1 1 2 1 1 0 0 1 0 0 1 0 1 0 1 1 48 2 70 1 4 4 1 1 34 3 2 1 2 1 0 0 0 0 0 1 0 0 1 2 2 12 4 20 2 2 3 1 3 27 3 1 1 1 1 1 0 1 0 0 1 0 0 1 1 2 9 2 12 1 4 2 4 2 67 3 2 1 2 1 0 0 1 0 0 1 0 0 0 1 2 12 2 13 1 2 3 1 3 22 2 1 1 1 1 0 0 1 0 0 1 0 0 1 2 2 18 0 23 2 2 2 3 3 28 3 2 1 1 1 1 0 1 0 0 1 0 0 1 2 4 21 0 50 5 3 2 4 2 29 1 2 1 2 1 1 0 1 0 0 1 0 0 1 2 1 24 1 36 1 4 3 4 3 27 1 1 1 1 1 0 0 1 0 0 1 0 0 1 2 2 18 4 19 1 2 3 2 1 31 3 2 1 1 1 0 0 1 0 0 1 0 1 0 2 1 24 2 30 5 5 3 4 4 49 1 1 2 2 1 0 1 1 0 0 0 0 0 1 1 1 24 1 15 1 4 3 4 3 24 1 1 1 1 1 0 0 0 0 1 0 0 1 0 2 3 6 3 7 1 2 2 1 2 29 1 1 1 1 1 0 0 1 0 0 1 0 0 1 1 2 36 2 124 5 3 3 4 4 37 3 1 1 2 1 1 0 1 0 0 0 0 0 1 2 2 24 3 47 5 3 3 2 2 37 1 2 1 2 1 0 0 1 0 0 1 0 0 0 1 2 24 3 16 2 4 2 2 2 23 3 2 1 2 1 0 0 1 0 1 0 0 0 1 1 1 12 2 14 1 4 1 3 3 36 3 1 1 1 1 1 0 1 0 0 1 0 0 1 2 4 24 4 26 4 5 3 2 3 34 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 2 48 2 40 5 4 3 1 3 41 3 2 2 2 1 0 0 1 0 0 1 0 0 1 1 1 48 2 68 1 3 2 2 3 31 3 1 1 2 1 0 0 1 0 0 1 0 0 1 2 1 24 2 32 1 2 2 4 1 23 3 1 1 2 1 0 0 1 0 1 0 0 1 0 2 4 30 4 60 1 4 3 2 3 38 3 1 1 1 1 0 0 0 1 0 1 0 0 1 1 4 24 2 54 5 1 2 4 2 26 3 1 1 2 1 0 1 1 0 1 0 0 0 0 1 1 15 2 8 1 3 2 4 2 22 3 1 1 1 1 0 0 1 0 0 1 0 1 0 1 2 9 2 11 1 5 3 4 3 27 3 2 1 1 1 0 0 1 0 0 1 0 1 0 1 4 15 4 28 1 4 2 3 3 24 1 2 1 1 1 0 0 0 1 0 1 0 0 1 1 2 12 2 29 1 4 2 1 1 27 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 24 4 19 5 3 2 2 3 33 3 2 1 2 1 0 0 1 0 0 1 0 0 1 1 2 36 4 28 1 2 1 4 3 27 3 2 1 1 1 1 0 1 0 0 1 0 0 1 2 4 24 2 9 1 2 4 3 3 27 3 2 1 1 1 0 0 1 0 0 1 0 1 0 1 2 18 4 11 1 5 3 3 1 30 1 2 1 1 1 1 0 0 0 0 1 0 0 1 2 2 12 4 31 1 2 3 3 1 49 1 2 2 1 1 1 0 1 0 0 1 0 1 0 1 4 9 2 14 1 3 2 2 1 26 3 1 1 1 1 0 0 1 0 1 0 0 0 1 1 2 36 2 24 1 2 3 1 4 33 3 1 1 1 1 0 0 1 0 1 0 0 1 0 2 4 12 2 21 5 5 2 4 4 52 3 1 1 2 1 1 0 1 0 0 0 0 0 0 1 1 18 2 20 1 3 2 4 1 20 1 1 1 1 1 0 0 1 0 1 0 0 0 1 2 1 9 4 28 1 3 3 2 1 36 3 2 2 1 1 1 0 1 0 1 0 0 0 1 1 1 12 2 13 1 3 3 1 2 21 3 1 1 1 1 0 0 0 0 0 1 0 1 0 1 1 18 2 12 1 3 4 3 1 47 3 1 1 2 1 0 0 1 0 0 1 0 1 0 2 1 12 4 22 1 5 3 3 2 60 3 2 1 1 1 0 0 1 0 0 1 0 0 1 2 1 12 4 4 1 4 2 3 1 58 3 4 1 2 1 0 0 1 0 0 1 0 1 0 1 2 24 3 20 5 3 2 4 3 42 3 2 1 2 1 1 0 1 0 1 0 0 0 1 1 4 21 2 16 4 5 2 4 1 36 1 1 1 1 1 0 0 1 0 0 1 0 1 0 1 2 24 2 27 1 3 2 4 2 20 3 1 1 2 1 1 0 1 0 1 0 0 1 0 2 1 24 1 14 5 5 3 3 3 40 2 1 1 2 1 0 0 1 0 0 1 0 0 0 2 2 6 1 9 2 2 2 1 2 32 2 1 1 1 1 1 0 1 0 0 1 0 1 0 2 1 24 2 14 1 4 2 4 3 23 3 2 1 1 1 1 0 1 0 1 0 0 0 1 2 2 24 0 42 1 3 3 4 1 36 3 3 1 2 1 0 0 1 0 0 1 0 1 0 2 4 18 4 28 1 4 3 2 2 31 1 2 1 1 1 1 0 1 0 0 1 0 0 1 2 4 24 3 39 1 3 3 2 4 32 3 1 1 1 1 0 0 1 0 0 0 0 0 1 1 2 7 2 23 1 2 2 1 1 45 3 1 1 1 1 0 0 0 0 0 1 0 0 1 1 2 9 2 9 1 3 2 1 2 30 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 2 24 1 18 1 4 2 4 4 34 1 1 1 1 1 0 0 1 0 0 0 0 1 0 2 4 36 2 33 1 3 2 2 3 28 3 1 1 2 1 0 0 1 0 0 1 0 0 0 2 3 10 2 13 1 2 2 2 2 23 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 24 1 28 3 3 3 4 1 22 2 1 1 2 1 0 0 1 0 0 1 0 0 1 1 4 24 4 45 1 3 3 2 1 74 3 1 1 2 1 0 0 1 0 0 1 0 0 0 1 2 36 2 27 2 3 2 4 4 50 3 1 1 1 1 0 0 0 1 0 0 0 0 1 2 4 18 2 21 1 2 3 1 1 33 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 15 2 13 5 5 3 4 4 45 1 1 2 1 1 0 1 1 0 0 0 0 0 1 1 1 12 2 7 2 1 2 3 2 22 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 3 10 2 12 2 5 2 4 4 48 3 1 2 1 1 1 0 1 0 0 0 0 1 0 2 1 21 2 34 4 2 2 2 3 29 1 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 24 1 36 1 3 2 4 3 22 1 1 1 1 2 0 1 0 0 1 0 0 0 1 1 4 18 3 18 1 4 2 1 1 22 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 2 48 0 122 5 3 3 2 3 48 1 1 1 2 1 0 0 1 0 0 1 0 0 0 1 2 60 3 92 5 3 3 2 4 27 3 1 1 1 1 0 0 1 0 0 0 0 0 0 1 1 6 4 37 1 3 3 3 1 37 3 3 2 1 1 1 0 1 0 1 0 0 0 1 1 2 30 2 34 2 3 2 4 3 21 3 1 1 1 1 0 0 0 1 1 0 0 0 1 2 4 12 2 6 1 3 1 2 1 49 3 1 1 1 1 1 0 1 0 0 1 0 1 0 1 2 21 4 37 1 4 3 3 2 27 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 4 18 4 15 1 3 3 2 2 32 1 2 1 1 1 1 0 1 0 0 1 0 0 1 2 4 48 2 39 5 3 1 2 1 38 1 1 1 1 1 0 0 1 0 0 1 0 0 1 2 1 12 2 19 1 2 2 1 3 22 3 1 1 1 1 0 0 1 0 1 0 0 0 1 1 1 18 2 26 1 3 3 4 4 65 3 2 1 1 1 0 0 1 0 0 0 0 0 1 2 4 15 2 20 5 5 3 2 3 35 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 3 6 2 21 1 3 3 2 1 41 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 2 9 1 14 2 4 3 3 4 29 3 1 1 1 1 1 0 1 0 0 1 0 0 1 2 4 42 4 40 3 3 3 4 1 36 3 2 1 2 1 0 0 1 0 0 1 0 0 1 1 4 9 2 38 5 5 3 4 1 64 3 1 1 1 1 0 0 1 0 0 1 0 1 0 1 1 24 2 37 1 3 2 4 3 28 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 18 1 16 1 3 3 3 3 44 1 1 1 1 1 0 0 1 0 0 1 0 0 1 2 2 15 2 14 5 2 3 1 2 23 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 9 2 20 1 2 2 2 3 19 3 2 1 1 1 0 0 0 1 1 0 0 0 1 2 2 24 2 14 1 2 2 4 3 25 3 1 1 2 1 1 0 1 0 0 1 0 1 0 2 4 12 2 14 1 5 3 4 2 47 1 3 2 2 1 0 0 1 0 0 1 0 0 1 1 4 24 2 14 3 4 2 1 3 28 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 60 3 157 1 4 3 4 3 21 3 2 1 2 1 0 0 1 0 0 1 0 0 1 1 4 12 2 15 1 2 2 3 3 34 3 1 2 1 1 0 0 1 0 0 1 0 0 1 1 1 42 3 44 1 4 3 2 2 26 1 2 2 2 1 0 0 1 0 0 1 0 0 1 2 1 18 2 8 1 1 2 1 1 27 3 1 1 1 1 0 0 1 0 0 1 1 0 0 2 2 15 2 13 1 5 3 4 3 38 3 2 1 1 1 0 0 1 0 0 1 0 1 0 1 4 15 2 46 2 3 3 2 2 40 3 1 1 2 1 0 0 1 0 0 1 0 0 0 2 4 24 4 19 1 4 4 2 3 33 3 2 1 2 1 0 0 0 0 0 1 0 0 1 1 1 18 4 19 1 4 4 1 2 32 3 2 1 2 1 0 0 1 0 0 1 0 0 0 1 4 36 3 80 5 2 3 4 3 27 3 2 1 2 1 0 0 1 0 1 0 0 0 1 2 1 30 0 46 1 3 1 2 1 32 3 2 1 1 1 0 0 0 0 0 1 0 0 1 1 4 12 2 14 3 3 2 2 2 26 3 1 1 1 1 1 0 1 0 0 1 0 0 1 2 3 24 2 9 1 4 3 3 4 38 1 1 2 1 1 1 0 1 0 0 0 0 0 1 2 1 12 2 7 1 3 3 4 3 40 3 1 2 1 1 0 0 1 0 1 0 0 1 0 2 1 48 2 75 1 4 3 1 4 50 3 1 1 2 1 0 0 1 0 0 0 0 0 0 1 2 12 2 19 1 3 3 2 2 37 3 1 1 1 1 0 0 1 0 0 1 0 1 0 2 1 24 2 23 1 5 3 1 1 45 3 1 1 1 1 1 0 0 1 0 1 0 0 1 2 2 36 3 81 2 5 3 4 3 42 3 4 1 2 1 1 0 1 0 0 1 0 0 0 2 4 24 4 23 1 4 3 3 3 35 3 2 1 2 1 0 1 1 0 0 1 0 0 1 1 1 14 2 40 1 1 3 4 4 22 3 1 1 1 1 1 0 1 0 0 0 0 0 1 1 2 12 2 9 1 5 3 4 3 41 1 1 2 1 1 1 0 1 0 0 1 0 1 0 2 4 48 2 102 5 4 3 3 3 37 2 1 1 2 1 0 0 1 0 0 1 0 0 1 1 2 30 0 42 1 3 2 1 3 28 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 2 18 4 64 1 5 3 1 4 41 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 3 12 2 13 1 3 4 4 1 23 3 1 1 1 1 0 0 1 0 1 0 0 0 1 1 1 12 2 9 5 3 4 2 3 23 3 1 1 1 1 1 0 1 0 0 1 0 0 1 2 4 21 2 22 1 5 3 2 1 50 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 2 6 3 10 1 1 3 1 2 35 2 2 1 2 1 0 0 1 0 0 1 0 0 0 1 3 6 4 10 1 3 2 4 2 50 3 1 1 1 1 0 0 1 0 0 1 0 1 0 1 4 24 4 63 1 1 3 2 4 27 1 2 1 2 1 0 0 0 1 0 1 0 0 0 1 2 30 1 35 4 3 3 2 3 34 2 1 2 2 1 0 0 1 0 0 1 0 0 1 1 4 48 1 36 1 3 2 1 1 27 2 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 12 4 48 1 5 3 4 2 43 3 2 1 2 1 1 0 0 1 1 0 0 0 1 2 3 30 4 30 1 5 3 4 2 47 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 24 4 41 2 3 3 3 2 27 3 2 1 2 1 0 0 1 0 0 1 0 1 0 1 4 36 2 57 2 4 3 2 3 31 3 2 1 2 1 0 0 1 0 0 1 0 0 1 1 4 60 2 104 1 5 3 4 2 42 3 1 1 2 1 1 0 1 0 0 1 0 0 0 1 4 6 4 21 3 3 4 2 3 24 3 1 1 1 1 1 0 1 0 0 1 0 0 1 1 4 21 3 26 3 2 3 2 1 41 1 1 2 1 1 0 0 1 0 0 1 0 1 0 2 4 30 4 45 1 4 2 4 3 26 3 1 1 2 1 0 0 1 0 1 0 0 0 0 1 4 24 4 52 1 5 3 4 3 33 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 2 72 2 56 2 3 4 2 3 24 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 1 24 2 24 1 5 3 4 1 64 1 1 1 1 1 0 0 1 0 1 0 0 1 0 1 4 18 2 15 1 2 2 1 1 26 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 6 2 15 1 2 2 2 4 56 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 12 2 23 5 3 3 4 4 37 3 1 1 2 1 0 0 1 0 0 0 0 0 1 1 4 15 3 15 1 3 4 3 1 33 1 2 1 1 1 0 0 1 0 0 1 0 0 1 1 4 24 4 51 1 2 4 3 4 47 3 3 1 2 1 0 0 1 0 0 0 0 0 1 1 2 36 3 99 2 4 3 3 2 31 3 2 2 2 1 0 0 1 0 0 1 0 1 0 1 4 60 2 65 5 3 3 4 4 34 3 1 2 2 1 1 0 1 0 0 0 0 0 1 1 3 10 4 13 5 4 3 2 2 27 3 2 1 2 1 0 0 1 0 0 1 0 0 1 1 2 36 3 29 2 5 3 3 4 30 3 1 1 1 1 1 0 1 0 0 0 0 0 1 1 4 9 2 28 2 5 3 4 3 35 3 1 1 2 1 0 0 0 1 0 1 0 0 1 1 1 12 2 37 4 3 3 3 2 31 3 1 2 1 1 1 0 1 0 0 1 0 0 1 1 1 15 4 10 1 3 1 3 2 25 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 2 15 2 26 2 3 2 2 1 25 3 1 1 1 1 0 0 1 0 0 1 0 1 0 1 2 24 2 29 2 2 3 1 3 29 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 6 4 47 5 2 3 3 1 44 3 2 2 1 1 1 0 1 0 0 1 0 1 0 1 4 24 2 23 1 4 3 2 3 28 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 4 6 2 12 3 3 3 4 2 50 3 1 1 1 1 0 1 1 0 1 0 0 0 1 1 2 12 2 11 1 4 3 3 1 29 3 2 1 1 2 0 0 0 0 0 1 0 0 1 1 4 12 4 9 1 1 2 2 2 38 3 1 1 1 1 1 0 1 0 0 1 1 0 0 1 4 18 4 18 1 3 3 2 3 24 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 3 15 2 19 1 5 3 4 3 40 3 1 1 2 1 0 0 1 0 1 0 0 0 0 1 4 12 2 11 3 3 2 4 3 29 3 1 1 1 1 0 0 1 0 1 0 0 1 0 2 1 48 4 63 1 5 3 4 4 46 3 2 1 2 1 0 1 1 0 0 0 0 0 1 2 3 24 2 14 2 5 2 2 4 47 3 1 1 2 1 0 0 1 0 0 0 0 0 1 1 2 30 3 25 2 5 3 2 2 41 2 2 1 1 1 0 0 1 0 0 1 0 0 1 1 2 27 2 25 1 2 2 1 2 32 3 1 2 2 1 0 0 1 0 0 1 0 0 1 1 4 15 2 53 3 5 2 4 4 35 3 1 1 1 1 1 0 1 0 0 0 0 0 1 1 2 48 2 66 2 4 3 2 2 24 3 1 1 1 1 1 0 1 0 0 1 0 0 1 2 2 12 0 30 1 2 2 3 2 25 3 2 1 1 1 0 0 1 0 1 0 0 0 1 2 2 9 2 12 1 5 2 4 1 25 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 2 9 2 21 1 3 3 2 1 37 3 1 2 1 1 0 0 1 0 0 1 0 1 0 1 4 18 4 6 3 5 3 3 2 32 1 2 1 2 1 0 0 1 0 0 1 0 0 0 1 1 6 1 12 1 5 2 4 4 35 3 1 1 1 1 0 0 1 0 0 0 0 0 1 2 4 21 2 25 5 5 3 4 1 46 3 1 1 2 1 0 1 1 0 0 1 0 0 0 1 1 9 4 11 1 3 3 4 1 25 3 2 1 1 1 0 0 1 0 0 1 0 1 0 1 2 60 2 140 1 4 3 2 4 27 3 1 1 2 1 1 0 1 0 0 1 0 0 0 2 4 30 4 76 5 5 3 4 3 63 3 2 1 1 1 0 1 1 0 0 1 0 0 1 1 4 30 4 31 5 5 3 2 3 40 3 2 2 2 1 0 0 1 0 0 1 0 0 1 1 4 18 2 15 1 3 3 2 4 32 3 1 1 2 1 0 0 1 0 0 0 0 0 0 1 3 24 4 31 5 3 3 2 3 31 3 2 1 2 1 0 0 1 0 0 1 0 0 1 1 2 20 0 61 2 5 4 4 3 31 1 2 1 2 1 0 1 1 0 0 1 0 0 1 1 3 9 0 13 1 2 3 2 3 34 3 2 1 2 1 0 0 1 0 0 1 0 0 0 2 2 6 1 4 4 2 2 2 2 24 1 1 2 1 1 0 0 1 0 1 0 0 0 1 2 1 12 2 12 1 3 2 2 1 24 3 1 1 1 1 1 0 1 0 0 1 0 1 0 2 2 9 2 8 3 3 2 3 1 66 3 1 1 1 1 0 0 1 0 0 1 0 1 0 1 4 27 2 26 1 3 2 3 1 21 3 1 1 1 1 1 0 1 0 1 0 0 0 1 2 4 6 4 2 4 3 2 2 1 41 1 2 1 1 1 1 0 1 0 0 1 0 1 0 1 4 15 4 13 3 3 4 2 2 47 3 2 1 1 1 0 0 1 0 0 1 0 1 0 1 1 18 2 19 1 3 2 4 3 25 1 2 1 1 1 0 0 1 0 1 0 0 0 1 2 2 48 1 64 1 5 2 3 4 59 3 1 1 1 1 0 0 1 0 1 0 0 0 1 2 3 24 4 13 4 3 1 4 1 36 3 2 1 2 1 0 0 1 0 0 1 0 0 1 1 2 24 3 64 1 2 3 2 3 33 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 24 2 20 1 3 3 4 1 21 3 1 2 1 1 0 0 1 0 1 0 0 1 0 2 2 8 2 8 1 4 2 2 1 44 3 1 1 1 1 0 0 0 0 0 1 0 1 0 1 4 24 2 26 4 3 2 4 3 28 3 1 1 2 1 0 1 1 0 1 0 0 0 1 1 4 4 4 34 1 4 2 1 1 37 3 1 2 1 1 1 0 1 0 0 1 0 0 1 1 2 36 1 40 5 2 2 2 4 29 1 1 1 1 1 0 0 1 0 0 1 1 0 0 1 2 24 2 116 1 3 2 4 3 23 3 2 1 1 1 0 1 1 0 1 0 0 0 0 2 1 18 2 44 2 3 3 4 3 35 3 1 2 2 1 1 0 1 0 0 1 0 1 0 1 4 6 4 68 1 4 3 3 4 45 3 2 2 2 1 1 0 1 0 0 1 0 0 0 1 2 30 0 43 2 3 2 4 3 26 3 2 1 1 1 0 0 1 0 1 0 0 1 0 2 1 24 1 23 2 4 3 3 3 32 1 1 1 1 1 1 0 1 0 0 1 0 0 1 1 2 10 1 10 1 3 3 4 1 23 2 1 1 1 1 0 0 1 0 0 1 0 1 0 1 4 21 2 32 5 5 3 3 2 41 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 1 24 1 25 3 3 3 4 1 22 2 1 1 2 1 0 0 1 0 0 1 0 0 1 1 1 39 4 142 5 4 3 4 2 30 3 2 1 2 1 0 0 1 0 0 1 0 0 0 1 1 13 4 18 1 2 3 1 2 28 1 2 1 1 1 0 0 1 0 0 1 0 1 0 1 1 15 2 25 1 1 2 4 3 23 3 1 1 1 1 1 0 1 0 1 0 0 0 1 1 1 12 2 13 1 2 2 1 1 37 3 1 1 1 1 1 0 1 0 0 1 0 1 0 2 4 21 2 52 5 3 3 3 3 26 3 1 1 1 1 0 1 1 0 0 1 0 0 1 1 4 15 2 30 1 4 3 2 3 33 3 1 1 1 1 0 1 1 0 0 1 0 0 1 1 1 6 2 4 1 5 2 1 2 49 1 1 1 2 1 0 0 1 0 0 1 0 0 1 1 1 18 2 10 1 2 2 2 3 23 3 1 1 1 1 1 0 1 0 0 1 0 1 0 2 2 12 2 8 2 4 2 4 1 23 3 1 1 1 1 0 0 1 0 1 0 0 1 0 1 4 30 4 58 1 4 2 2 3 25 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 4 12 3 16 4 5 3 4 4 55 3 2 2 1 1 0 0 1 0 0 0 0 0 1 2 1 24 2 13 5 4 2 4 4 32 3 1 1 1 1 1 0 1 0 1 0 0 0 1 2 3 6 4 13 1 3 3 1 1 74 3 3 2 1 2 1 0 1 0 0 1 1 0 0 1 3 15 4 13 5 3 3 4 4 39 3 2 1 2 1 0 0 1 0 0 0 0 0 1 2 4 24 2 14 1 3 3 2 1 31 3 1 1 2 1 1 0 0 0 0 1 0 0 1 1 1 12 4 7 1 5 3 3 2 35 3 2 1 1 1 1 0 1 0 0 1 0 0 1 2 4 15 4 50 5 5 2 4 3 59 3 1 1 2 1 1 0 1 0 0 1 0 0 1 1 1 18 4 21 1 3 2 4 1 24 3 2 1 1 1 0 0 1 0 1 0 0 0 1 2 1 12 2 22 1 3 3 3 2 24 3 1 1 1 1 0 0 1 0 0 1 0 1 0 1 4 21 4 127 5 5 3 4 4 30 3 1 1 2 1 1 0 1 0 0 0 0 0 0 2 4 24 4 25 2 4 4 3 2 27 3 2 1 2 1 1 0 1 0 0 1 0 0 1 1 2 12 2 12 1 5 4 3 1 40 1 2 1 1 1 0 0 0 0 0 1 0 1 0 1 1 30 2 31 1 2 1 4 2 31 3 1 1 1 1 0 0 1 0 0 1 0 1 0 2 4 10 2 29 5 2 2 4 1 31 3 1 1 1 1 0 1 1 0 1 0 0 0 1 1 2 12 4 36 1 5 3 4 3 28 3 3 1 2 1 0 0 1 0 1 0 0 0 1 1 4 12 4 17 1 5 3 4 1 63 3 2 1 2 1 0 0 1 0 0 1 0 1 0 1 1 24 2 28 5 5 2 4 1 26 3 1 1 1 1 0 1 1 0 1 0 0 0 1 1 1 36 4 81 1 3 2 2 4 25 3 2 1 2 1 0 0 1 0 0 1 0 0 0 2 4 21 4 33 1 5 3 4 3 36 3 1 1 2 1 0 1 1 0 0 1 0 0 0 1 4 24 4 22 2 5 3 4 2 52 1 2 1 1 1 0 0 1 0 0 1 0 0 1 1 3 12 4 15 3 1 3 4 4 66 1 3 1 1 1 1 0 1 0 0 0 1 0 0 1 1 24 2 14 5 3 2 4 1 25 3 1 1 1 1 1 0 1 0 1 0 0 0 1 2 4 36 4 35 1 4 3 4 3 37 3 2 1 2 1 1 0 1 0 0 1 0 0 1 1 1 18 2 35 1 4 2 1 1 25 3 1 1 1 1 0 0 0 0 0 1 0 0 1 1 4 36 4 57 4 5 3 2 3 38 3 2 1 2 1 0 1 1 0 0 1 0 0 0 1 2 18 2 39 1 1 2 4 3 67 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 2 39 4 49 1 4 3 2 1 25 3 2 1 1 1 0 0 0 0 0 1 0 0 1 2 4 24 4 19 4 5 3 4 1 60 3 1 1 2 1 1 0 1 0 0 1 0 0 1 1 2 12 0 14 1 3 3 2 1 31 3 1 1 2 1 0 0 1 0 0 1 0 1 0 1 2 12 2 8 2 2 2 2 2 23 1 1 1 1 1 1 0 1 0 0 1 0 1 0 2 2 20 2 65 5 1 1 4 1 60 3 1 1 2 1 0 1 1 0 0 1 0 0 0 1 2 18 2 19 4 3 3 2 2 35 3 1 1 2 1 0 0 1 0 0 1 0 1 0 1 4 22 2 27 3 5 3 4 3 40 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 48 4 28 5 5 3 3 3 38 3 2 2 2 1 0 1 1 0 0 1 0 0 1 1 2 48 3 62 1 5 3 4 4 50 3 1 1 1 1 0 0 1 0 0 0 0 0 1 2 1 40 4 60 1 3 3 3 4 27 1 1 1 2 1 0 0 1 0 0 1 0 0 1 2 2 21 2 12 1 5 2 4 2 39 3 1 2 1 1 0 0 1 0 0 1 0 0 1 2 4 24 2 63 5 5 3 4 3 41 3 1 2 2 1 0 1 1 0 0 1 0 0 0 1 4 6 4 12 5 3 4 2 2 27 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 3 24 2 29 1 5 1 4 4 51 3 1 1 1 1 0 0 1 0 0 0 0 0 1 1 4 24 2 31 3 5 3 3 4 32 3 1 1 2 1 0 0 1 0 1 0 0 0 1 1 4 9 2 23 2 2 2 4 2 22 3 1 1 1 1 0 0 1 0 1 0 0 0 1 1 1 18 2 75 5 5 3 4 2 51 3 1 2 2 1 0 1 1 0 0 0 0 0 1 2 4 12 4 13 1 2 2 4 2 22 3 2 1 1 1 0 0 1 0 1 0 0 1 0 1 4 24 3 7 5 5 4 4 3 54 3 2 1 2 1 1 0 1 0 0 1 0 0 1 1 2 9 2 15 5 2 3 2 1 35 3 1 1 1 1 1 0 1 0 0 1 1 0 0 1 4 24 4 16 1 5 3 4 4 54 3 2 2 1 1 0 0 1 0 0 0 0 0 1 1 2 18 4 18 1 5 2 4 1 48 1 2 1 2 1 0 0 0 0 1 0 0 1 0 1 1 20 4 43 1 5 2 4 2 24 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 4 12 4 10 5 5 3 4 3 35 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 2 12 2 75 5 1 2 2 1 24 3 1 1 1 1 1 0 1 0 1 0 1 0 0 1 1 36 2 93 1 4 3 1 3 24 3 1 1 2 1 1 0 1 0 0 1 0 0 1 2 2 6 2 6 1 2 4 3 1 26 3 1 1 1 2 0 0 1 0 0 1 0 1 0 1 4 12 4 9 5 5 3 4 1 65 3 4 1 1 1 0 0 1 0 0 1 0 0 1 1 2 42 1 93 1 1 3 2 4 55 1 1 1 2 1 0 1 1 0 0 0 0 0 0 1 2 15 0 18 1 2 2 1 1 26 3 2 1 1 1 1 0 1 0 1 0 1 0 0 2 2 8 2 9 1 2 4 2 1 26 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 2 6 2 5 1 4 4 3 1 28 1 1 1 1 1 0 0 0 0 0 1 0 1 0 1 1 36 4 96 1 4 3 4 3 24 3 2 1 2 1 0 1 1 0 0 1 0 0 1 2 1 48 2 31 1 3 3 4 3 54 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 1 48 2 39 1 4 3 4 4 46 3 1 2 1 1 1 0 1 0 0 0 0 0 1 2 2 36 3 74 1 3 2 2 2 54 3 1 1 1 1 1 0 1 0 1 0 0 0 1 1 4 6 2 13 3 3 1 4 1 62 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 6 4 16 1 4 2 2 3 24 3 2 1 2 1 0 0 1 0 1 0 0 0 1 1 1 36 2 159 1 1 1 3 3 43 3 1 1 1 1 0 0 0 1 0 1 0 0 0 1 1 18 2 13 1 3 4 3 1 26 1 1 1 1 1 0 0 1 0 0 1 0 0 1 2 4 12 2 11 1 3 4 2 1 27 3 2 1 2 1 1 0 1 0 0 1 0 0 1 1 3 12 2 30 1 3 4 1 3 24 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 36 2 27 1 5 3 2 2 41 1 1 2 1 1 0 0 1 0 0 1 0 0 1 2 1 8 4 7 1 5 3 4 1 47 3 2 1 1 1 1 0 1 0 0 1 0 1 0 1 4 18 4 38 1 2 1 2 3 35 3 2 1 2 1 0 0 1 0 0 1 0 0 0 1 1 21 4 16 1 5 4 3 3 30 3 2 1 2 1 1 0 1 0 0 1 0 0 1 1 1 18 4 40 1 5 2 4 1 33 1 3 1 2 1 1 0 1 0 1 0 0 0 1 2 4 18 0 42 1 3 3 2 3 36 2 2 2 1 1 0 0 1 0 0 1 0 0 1 2 1 36 2 83 5 5 3 4 4 47 3 1 1 1 1 0 1 1 0 0 0 0 0 1 2 2 48 3 67 5 3 3 4 4 38 3 1 2 2 1 0 0 1 0 0 0 0 0 1 1 4 24 3 24 3 3 3 2 3 44 3 2 2 2 1 0 0 1 0 0 1 0 0 1 1 1 18 2 12 1 2 2 3 3 23 3 1 1 2 1 1 0 1 0 1 0 0 0 1 2 1 45 0 118 1 5 3 4 3 29 3 2 1 1 1 0 0 1 0 1 0 0 0 1 2 2 24 2 51 5 5 2 4 3 42 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 3 15 2 23 1 2 2 3 1 25 3 1 1 1 1 0 0 1 0 0 1 0 1 0 2 1 12 0 11 1 3 3 4 3 48 1 2 1 1 1 1 0 1 0 0 1 0 0 1 2 4 12 2 9 5 3 2 2 3 21 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 4 2 6 1 2 2 3 1 23 3 1 2 1 1 0 0 1 0 1 0 0 1 0 1 1 24 4 30 1 5 3 4 2 63 3 2 1 2 1 0 1 1 0 0 1 0 0 1 1 4 24 4 26 1 5 4 3 1 46 3 2 1 1 1 0 0 0 1 0 1 0 0 1 1 1 36 2 52 1 4 3 2 2 29 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 4 21 3 30 1 3 3 2 1 28 2 2 1 1 1 0 1 1 0 0 1 0 1 0 1 4 18 2 19 1 2 2 4 1 23 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 4 24 1 16 1 4 3 4 3 50 1 1 1 2 1 0 0 1 0 0 1 0 0 1 1 4 18 2 34 1 5 3 4 2 47 1 3 2 2 1 0 0 1 0 0 1 0 0 1 1 2 21 2 40 5 4 3 3 3 35 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 4 18 2 68 5 3 3 4 3 68 3 2 1 1 1 1 0 1 0 1 0 0 0 1 2 4 24 2 12 1 2 4 2 1 28 3 1 1 1 1 1 0 1 0 0 1 0 0 1 1 1 9 2 14 1 4 3 4 1 59 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 12 2 7 1 5 3 4 1 57 2 1 1 1 1 0 0 1 0 0 1 0 1 0 2 1 20 4 22 1 3 4 2 2 33 1 2 1 1 2 1 0 0 0 1 0 0 0 1 2 4 24 4 40 5 4 3 4 2 43 3 2 1 2 1 0 1 1 0 0 1 0 0 1 1 4 15 4 15 1 3 3 4 4 35 3 2 1 2 1 0 0 1 0 0 0 0 0 1 1 1 18 1 14 1 4 3 4 4 32 3 2 2 1 1 1 0 1 0 0 0 0 1 0 2 4 36 3 109 1 5 3 2 3 45 3 2 2 2 1 1 0 1 0 0 1 0 0 1 1 4 24 2 15 2 2 4 3 1 33 3 1 1 2 1 1 0 1 0 0 1 0 0 1 1 4 10 2 9 5 4 2 3 2 40 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 4 15 4 33 1 3 3 2 4 28 3 1 1 2 1 0 0 1 0 0 0 0 0 1 1 1 15 2 40 1 3 2 2 2 29 3 1 1 2 1 1 0 1 0 0 1 0 0 1 2 4 9 2 36 2 3 3 2 1 26 3 1 2 1 2 1 0 0 0 1 0 0 0 1 1 4 24 4 58 4 3 3 2 1 27 3 2 1 1 1 0 1 1 0 0 1 0 0 1 1 4 18 3 22 1 3 4 2 3 28 3 1 1 2 1 0 0 1 0 0 1 0 0 1 2 1 24 2 24 1 2 2 4 1 35 3 1 1 2 1 0 0 1 0 0 1 0 0 1 2 4 27 4 45 4 2 3 2 1 32 2 2 2 2 1 0 0 1 0 0 1 0 1 0 1 4 10 2 22 1 3 3 2 1 25 1 1 1 1 1 0 0 1 0 1 0 0 1 0 2 4 15 2 22 3 3 2 4 3 20 3 1 1 1 1 0 0 1 0 1 0 0 0 1 1 1 18 2 24 1 2 2 1 3 27 2 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 12 4 33 1 5 3 4 2 42 2 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 36 2 74 5 5 3 2 2 37 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 1 12 2 7 1 5 2 4 2 24 3 1 1 1 1 0 0 1 0 1 0 0 0 1 1 4 36 3 77 3 4 2 4 3 40 3 2 1 2 1 0 0 1 0 0 1 0 0 1 1 3 6 4 13 1 5 3 4 1 46 3 2 2 1 2 1 0 1 0 0 1 0 0 1 1 1 24 4 14 2 4 3 1 1 26 3 2 1 2 1 0 0 1 0 0 1 0 0 1 1 4 15 2 9 5 2 2 1 1 24 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 12 2 36 1 3 3 2 2 29 3 1 2 1 1 0 0 0 1 0 1 0 1 0 1 2 11 4 13 4 3 2 4 3 40 3 2 1 1 1 1 0 1 0 0 1 0 0 1 1 1 18 1 19 1 2 3 4 4 36 1 1 1 2 1 0 0 0 1 0 0 0 0 0 1 4 36 2 36 1 5 3 2 3 28 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 9 2 14 1 2 3 2 4 27 3 1 1 2 1 1 0 1 0 0 0 0 0 0 2 4 30 4 67 5 4 3 3 2 36 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 4 24 2 78 1 4 3 3 3 38 3 1 1 2 1 0 1 1 0 0 1 0 0 0 1 4 24 2 93 5 3 1 4 4 48 3 1 1 2 1 0 1 1 0 0 0 0 0 1 1 2 30 4 22 5 5 3 4 1 36 3 2 1 1 1 1 0 1 0 0 1 0 0 1 1 4 18 4 11 1 1 2 4 3 65 3 2 1 1 1 0 0 1 0 0 1 1 0 0 1 2 24 2 41 1 4 1 3 3 43 3 1 1 2 1 0 0 1 0 0 1 0 0 1 2 1 12 2 8 1 2 2 4 2 53 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 2 24 4 28 5 4 3 3 4 34 3 2 2 2 1 0 0 1 0 0 1 0 0 1 1 2 48 2 157 1 3 3 2 3 23 3 1 1 2 1 0 0 1 0 0 1 0 0 1 2 4 36 4 66 1 5 3 4 3 34 3 2 1 2 1 1 0 1 0 0 1 0 0 0 1 4 28 1 78 5 2 3 4 1 40 1 2 2 2 1 0 1 0 0 1 0 0 0 1 1 1 27 4 24 1 5 3 4 3 43 2 4 2 2 1 0 0 1 0 0 1 0 0 0 1 4 15 4 18 1 5 3 4 3 46 3 2 1 2 1 0 0 1 0 0 1 0 0 1 1 1 12 4 22 1 3 3 4 2 38 1 2 1 1 2 1 0 1 0 0 1 0 1 0 1 2 36 4 58 1 3 3 4 3 34 3 2 1 2 1 0 1 1 0 0 1 0 0 1 1 4 18 4 12 5 3 3 3 2 29 3 2 1 2 1 0 0 1 0 0 1 0 0 1 1 4 36 3 89 5 4 3 2 3 31 2 1 2 2 1 0 1 1 0 0 1 0 0 0 1 1 21 2 26 1 2 2 4 2 28 3 1 1 2 1 0 0 1 0 1 0 0 0 0 1 4 12 4 16 4 4 2 2 2 35 3 1 1 1 2 0 0 1 0 0 1 0 0 1 1 4 15 2 22 5 4 2 4 1 33 1 1 1 1 1 0 0 1 0 1 0 0 1 0 1 1 18 2 42 1 3 3 3 3 42 3 1 1 1 1 0 0 0 1 0 1 0 0 1 2 1 16 4 26 1 5 3 4 2 43 1 1 1 2 1 1 0 0 0 1 0 0 0 1 2 4 20 4 35 5 2 1 4 1 44 3 2 1 2 1 1 0 1 0 0 1 0 0 1 1 4 36 4 105 5 5 3 4 4 42 3 2 1 1 1 0 1 1 0 0 0 0 0 1 1 4 15 2 14 5 3 4 2 1 40 3 1 1 2 1 0 0 1 0 1 0 0 0 1 1 4 24 2 13 1 5 3 1 1 36 3 1 1 2 1 0 0 1 0 0 1 0 0 0 1 1 12 2 11 1 3 3 2 1 20 3 1 2 2 1 0 0 1 0 1 0 0 0 0 1 1 21 2 38 5 4 3 2 1 24 3 1 1 1 2 1 0 0 1 0 1 0 1 0 1 2 36 2 37 5 3 4 2 3 27 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 15 3 36 1 2 2 2 2 46 3 2 1 1 1 0 1 1 0 0 1 0 1 0 1 2 9 2 32 5 3 2 2 1 33 3 1 1 1 1 1 0 1 0 0 1 0 1 0 1 4 36 3 45 1 3 2 4 1 34 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 2 24 4 47 1 2 2 4 3 25 1 1 1 1 1 0 0 1 0 0 1 0 1 0 2 2 30 2 30 5 5 2 4 3 25 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 4 11 2 21 4 5 1 2 1 28 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 1 24 1 32 1 3 3 2 2 31 3 1 1 2 1 0 0 1 0 1 0 0 0 1 2 2 48 0 184 1 3 2 2 2 32 1 1 1 2 2 0 0 1 0 0 1 0 0 0 2 4 10 2 28 2 3 3 2 1 32 3 1 2 1 1 0 1 0 1 0 1 0 0 1 1 1 6 2 149 1 5 3 4 4 68 1 1 1 2 1 1 0 1 0 0 1 0 0 0 2 1 24 2 24 2 1 1 1 2 33 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 1 24 2 33 1 5 3 2 2 39 3 1 1 2 1 0 0 1 0 1 0 0 0 0 2 4 18 4 18 1 3 2 2 4 28 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 4 48 3 127 3 4 3 1 3 37 3 1 1 2 1 0 0 1 0 0 1 0 0 0 1 1 9 2 14 1 2 2 4 2 22 3 1 1 1 1 0 0 1 0 1 0 0 0 1 2 2 12 2 20 1 4 3 4 2 30 3 1 2 2 1 1 0 1 0 1 0 0 0 1 1 1 24 1 69 1 2 1 1 2 55 1 1 1 2 1 0 0 1 0 0 1 0 0 1 2 1 12 1 7 1 2 3 2 3 46 1 2 1 2 1 1 0 1 0 0 1 0 0 1 2 1 18 4 10 1 2 2 4 2 21 3 1 1 1 1 0 0 1 0 1 0 0 0 1 1 1 48 2 103 1 4 3 4 4 39 2 3 2 2 1 0 1 1 0 0 0 0 0 1 2 4 30 2 19 5 5 3 4 3 58 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 1 12 3 13 1 3 3 2 1 43 3 2 2 1 1 1 0 1 0 0 1 0 1 0 1 1 24 2 17 1 2 3 1 2 24 3 1 1 1 2 0 0 0 1 0 1 0 1 0 1 2 9 2 17 1 2 2 2 3 22 3 1 1 2 1 0 0 1 0 0 1 0 0 1 2 4 9 4 12 1 3 3 1 1 30 3 2 1 1 1 1 0 1 0 0 1 0 0 1 1 4 12 4 5 3 5 3 4 2 42 3 2 2 2 1 0 0 1 0 0 1 0 0 1 1 1 12 2 15 1 3 2 1 3 23 1 1 1 1 1 0 0 1 0 0 1 0 0 1 1 2 30 3 19 2 2 3 3 4 30 2 2 1 1 1 0 0 1 0 0 1 0 0 0 2 3 9 2 7 1 3 2 2 1 28 3 1 1 1 1 0 0 1 0 0 1 0 1 0 2 2 6 2 21 1 2 4 3 3 30 3 1 1 2 1 0 0 1 0 1 0 0 0 0 1 2 60 2 63 1 3 3 4 4 42 3 1 1 1 1 0 0 1 0 0 0 0 0 1 2 4 24 4 68 5 3 3 4 2 46 3 2 2 2 1 0 1 1 0 0 1 0 0 0 1 4 12 2 35 5 2 3 3 2 45 3 1 2 2 1 1 0 1 0 0 1 0 0 0 1 4 10 2 15 1 3 3 2 1 31 3 1 2 1 2 1 0 1 0 0 1 0 1 0 1 4 24 2 9 5 4 3 2 3 31 2 1 1 2 1 0 0 1 0 0 1 0 0 1 1 4 4 4 15 1 4 3 1 1 42 3 3 2 1 1 1 0 1 0 0 1 0 1 0 1 1 15 2 18 1 2 2 1 2 46 3 1 1 1 1 0 0 0 0 1 0 0 0 1 1 2 48 0 84 3 2 2 1 3 30 3 2 1 1 1 1 0 1 0 0 1 0 0 1 1 1 24 1 33 3 2 3 4 4 30 3 1 2 2 1 0 0 1 0 0 0 0 0 1 2 4 12 2 29 5 1 3 4 4 38 3 1 1 2 1 1 0 1 0 0 1 0 0 0 1 4 18 2 15 1 2 4 1 2 43 3 1 2 1 1 0 0 0 1 0 1 0 1 0 2 4 24 2 36 2 5 3 4 3 31 3 2 1 1 1 0 0 1 0 0 1 0 0 1 2 2 18 4 36 1 1 4 3 3 40 3 3 2 2 1 0 0 1 0 0 1 1 0 0 1 1 36 3 21 1 4 3 1 3 24 3 2 1 2 1 0 0 1 0 0 1 0 0 1 2 2 24 2 41 3 2 2 4 3 28 3 1 1 1 1 0 1 1 0 1 0 0 0 1 2 4 36 2 110 1 1 2 2 3 26 3 2 1 2 1 0 0 1 0 0 1 0 0 0 2 1 12 2 19 1 3 2 4 2 29 3 1 1 2 1 1 0 0 0 0 1 0 0 1 1 1 24 4 12 4 5 2 4 2 57 3 2 1 2 1 0 0 1 0 1 0 0 0 0 1 3 30 4 37 5 5 3 4 2 49 2 2 1 1 1 0 0 1 0 0 1 0 1 0 1 2 9 4 12 1 5 3 4 1 37 3 3 1 1 1 0 0 1 0 0 1 0 1 0 1 1 28 2 40 1 3 3 2 3 45 3 1 1 1 1 1 0 1 0 0 1 0 1 0 2 2 24 2 31 2 5 3 4 4 30 3 1 1 1 1 0 0 1 0 0 0 0 0 1 1 4 6 4 17 1 5 4 2 1 30 3 2 1 1 1 0 0 1 0 1 0 0 0 1 1 2 21 3 24 1 3 1 4 2 47 3 2 1 1 1 1 0 1 0 0 1 0 0 1 1 4 15 2 36 5 3 3 2 4 29 3 1 1 1 1 1 0 1 0 0 1 0 0 1 1 4 24 2 24 3 5 3 2 3 35 1 2 1 2 1 0 0 1 0 0 1 0 0 1 2 2 6 2 5 1 2 4 1 2 22 3 1 1 1 1 0 0 1 0 0 1 0 1 0 1 2 30 2 17 5 3 2 1 3 26 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 2 27 4 25 3 3 3 2 2 23 3 2 1 1 1 0 0 1 0 0 1 0 1 0 2 4 15 2 36 1 5 2 2 3 54 1 1 1 2 1 0 0 1 0 1 0 0 0 0 1 4 42 2 72 5 4 4 4 2 29 3 1 1 2 1 0 0 1 0 1 0 0 0 1 1 1 11 4 39 1 3 3 2 1 40 3 2 2 1 1 1 0 1 0 0 1 0 1 0 1 2 15 2 15 2 3 3 2 1 22 3 1 1 1 1 0 0 0 0 0 1 0 0 1 1 4 24 2 74 1 3 3 4 2 43 3 1 2 1 1 1 0 1 0 0 1 0 1 0 1 1 24 1 12 1 1 2 4 4 29 3 2 1 1 1 1 0 0 1 1 0 1 0 0 2 1 60 2 73 1 5 3 4 4 36 3 1 1 1 1 0 0 0 1 1 0 0 0 1 2 4 30 4 28 1 3 2 2 3 33 3 1 1 2 1 0 0 1 0 0 1 0 0 1 1 3 24 2 13 3 3 2 3 3 57 3 1 1 1 1 0 0 1 0 0 1 0 1 0 1 2 6 2 8 1 3 2 3 1 64 3 1 1 1 1 0 0 0 0 0 1 0 0 1 1 2 18 3 24 5 5 3 2 2 42 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 4 24 3 25 1 5 3 4 3 47 3 2 2 1 1 1 0 1 0 0 1 0 1 0 2 2 15 1 13 2 3 4 2 2 25 3 1 1 1 1 1 0 1 0 1 0 0 0 1 2 2 30 4 84 1 4 3 2 2 49 3 1 1 1 1 0 0 1 0 0 1 0 0 1 2 4 48 2 48 1 1 3 2 3 33 1 1 1 2 1 0 0 1 0 1 0 0 0 0 2 3 21 2 29 2 3 2 1 3 28 1 1 1 2 1 1 0 1 0 0 1 0 0 0 1 1 36 2 82 1 3 3 2 2 26 3 1 2 1 1 0 1 1 0 0 1 0 0 1 2 4 24 4 20 1 4 3 2 2 30 3 2 1 1 1 0 0 1 0 0 1 0 1 0 1 1 15 4 14 1 3 2 3 2 25 3 2 1 1 1 0 0 1 0 1 0 0 0 1 1 3 42 0 63 1 2 1 1 2 33 3 2 1 1 1 0 0 1 0 0 1 0 0 1 1 4 13 2 14 2 1 2 4 1 64 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 24 2 66 1 1 3 2 4 29 3 1 1 2 1 0 1 1 0 0 0 0 0 0 1 2 24 4 17 1 5 3 2 2 48 3 2 1 1 1 0 0 1 0 0 1 0 1 0 1 4 12 4 36 5 2 3 1 2 37 3 2 2 1 1 0 0 1 0 0 1 0 1 0 1 4 15 1 16 2 5 3 4 3 34 1 1 2 1 1 0 0 1 0 0 1 0 1 0 1 1 18 2 19 5 4 4 4 3 23 3 2 1 1 1 0 0 1 0 1 0 0 1 0 1 1 36 2 40 1 1 3 3 2 30 3 1 1 2 1 0 0 1 0 0 1 0 0 0 1 4 12 2 24 5 5 3 3 3 50 3 1 1 2 1 1 0 1 0 0 1 0 0 1 1 4 12 2 17 1 4 2 4 1 31 3 1 1 1 1 0 0 1 0 0 1 0 1 0 1 1 30 2 39 1 3 1 4 2 40 3 1 1 2 1 0 1 1 0 0 1 0 0 0 1 4 12 2 8 1 5 3 4 3 38 3 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 45 2 18 1 3 3 4 4 23 3 1 1 2 1 0 0 1 0 0 0 0 0 1 2 2 45 4 46 2 1 3 4 3 27 3 1 1 1 1 0 1 1 0 0 1 0 0 1 1 foreach/inst/examples/for.R0000644000176200001440000000602713612556305015400 0ustar liggesuserslibrary(foreach) n <- 10 nrows <- 5 ncols <- 5 # vector example set.seed(17) x <- numeric(n) for (i in seq(along=x)) x[i] <- rnorm(1) set.seed(17) y <- foreach(icount(n), .combine='c') %do% rnorm(1) cat('results of vector example:\n') print(identical(x, y)) # list example set.seed(17) x <- vector('list', length=n) for (i in seq(length=n)) x[i] <- list(rnorm(10)) set.seed(17) y <- foreach(icount(n)) %do% rnorm(10) cat('results of list example:\n') print(identical(x, y)) # matrix example set.seed(17) cols <- vector('list', length=ncols) for (i in seq(along=cols)) cols[i] <- list(rnorm(nrows)) x <- do.call('cbind', cols) set.seed(17) y <- foreach(icount(ncols), .combine='cbind') %do% rnorm(nrows) cat('results of matrix example:\n') dimnames(y) <- NULL print(identical(x, y)) # another matrix example set.seed(17) cols <- vector('list', length=ncols) for (i in seq(along=cols)) { r <- numeric(nrows) for (j in seq(along=r)) r[j] <- rnorm(1) cols[i] <- list(r) } x <- do.call('cbind', cols) set.seed(17) y <- foreach(icount(ncols), .combine='cbind') %:% foreach(icount(nrows), .combine='c') %do% rnorm(1) cat('results of another matrix example:\n') dimnames(y) <- NULL print(identical(x, y)) # ragged matrix example set.seed(17) x <- vector('list', length=ncols) for (i in seq(along=x)) x[i] <- list(rnorm(i)) set.seed(17) y <- foreach(i=icount(ncols)) %do% rnorm(i) cat('results of ragged matrix example:\n') print(identical(x, y)) # another ragged matrix example set.seed(17) x <- vector('list', length=ncols) for (i in seq(along=x)) { r <- numeric(i) for (j in seq(along=r)) r[j] <- rnorm(1) x[i] <- list(r) } set.seed(17) y <- foreach(i=icount(ncols)) %:% foreach(icount(i), .combine='c') %do% rnorm(1) cat('results of another ragged matrix example:\n') print(identical(x, y)) # filtering example set.seed(17) a <- rnorm(10) # C-style approach x <- numeric(length(a)) n <- 0 for (i in a) { if (i > 0) { n <- n + 1 x[n] <- i } } length(x) <- n # Vector approach y <- a[a > 0] # foreach approach z <- foreach(i=a, .combine='c') %:% when(i > 0) %do% i cat('results of filtering example:\n') print(identical(x, y)) print(identical(x, z)) # Define a function that creates an iterator that returns chunks of a vecto ivector <- function(x, chunksize) { n <- length(x) i <- 1 nextEl <- function() { if (n <= 0) stop('StopIteration') chunks <- ceiling(n / chunksize) m <- ceiling(n / chunks) r <- seq(i, length=m) i <<- i + m n <<- n - m x[r] } obj <- list(nextElem=nextEl) class(obj) <- c('abstractiter', 'iter') obj } # another filtering example set.seed(17) a <- rnorm(10000) # Vector approach x <- a[a > 0] # foreach with vectorization, limiting vector lengths to 1000 y <- foreach(a=ivector(a, 1000), .combine='c') %do% a[a > 0] cat('results of another filtering example:\n') print(identical(x, y)) foreach/inst/examples/isplit.R0000644000176200001440000000162113612556305016111 0ustar liggesusers# iterator for splitting data using a factor library(foreach) # let's use isplit on a data frame a <- foreach(i=isplit(airquality, airquality$Month), .combine=rbind) %do% quantile(i$value, na.rm=TRUE) # make it pretty and print it rownames(a) <- levels(as.factor(airquality$Month)) print(a) # use a list of factors to do an aggregated operation it <- isplit(as.data.frame(state.x77), list(Region=state.region, Cold=state.x77[,'Frost'] > 130), drop=TRUE) a <- foreach(i=it, .combine=rbind) %do% { x <- mean(i$value) dim(x) <- c(1, length(x)) colnames(x) <- names(i$value) cbind(i$key, as.data.frame(x)) } print(a) # compare with the standard aggregate function b <- aggregate(state.x77, list(Region=state.region, Cold=state.x77[,'Frost'] > 130), mean) print(b) cat('results identical:\n') print(identical(a, b)) foreach/inst/examples/qsort.R0000644000176200001440000000060113612556305015752 0ustar liggesuserslibrary(foreach) qsort <- function(x) { n <- length(x) if (n == 0) { x } else { p <- sample(n, 1) smaller <- foreach(y=x[-p], .combine=c) %:% when(y <= x[p]) %do% y larger <- foreach(y=x[-p], .combine=c) %:% when(y > x[p]) %do% y c(qsort(smaller), x[p], qsort(larger)) } } x <- runif(100) a <- qsort(x) b <- sort(x) print(all(a == b)) foreach/inst/examples/feapply.R0000644000176200001440000000117613612556305016252 0ustar liggesuserslibrary(foreach) feapply <- function(X, MARGIN, FUN, ...) { FUN <- match.fun(FUN) r <- foreach(x=iapply(X, MARGIN)) %do% { x <- FUN(x, ...) dim(x) <- NULL x } n <- unlist(lapply(r, length)) if (all(n[1] == n)) { r <- unlist(r) dim(r) <- if (n[1] == 1) dim(X)[MARGIN] else c(n[1], dim(X)[MARGIN]) } else if (length(MARGIN) > 1) { dim(r) <- dim(X)[MARGIN] } r } a <- array(rnorm(24), c(2, 3, 4)) m <- diag(2, 3, 2) MARGIN <- 3 fun <- function(x, m) x %*% m expected <- apply(a, MARGIN, fun, m) actual <- feapply(a, MARGIN, fun, m) print(identical(expected, actual)) foreach/inst/examples/sinc2.R0000644000176200001440000000171413612556305015626 0ustar liggesuserslibrary(foreach) # Define a function that creates an iterator that returns subvectors ivector <- function(x, chunks) { n <- length(x) i <- 1 nextEl <- 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 x[r] } obj <- list(nextElem=nextEl) class(obj) <- c('abstractiter', 'iter') obj } # Define the coordinate grid and figure out how to split up the work x <- seq(-10, 10, by=0.1) nw <- getDoParWorkers() cat(sprintf('Running with %d worker(s)\n', nw)) # Compute the value of the sinc function at each point in the grid z <- foreach(y=ivector(x, nw), .combine=cbind) %dopar% { y <- rep(y, each=length(x)) r <- sqrt(x ^ 2 + y ^ 2) matrix(10 * sin(r) / r, length(x)) } # Plot the results as a perspective plot persp(x, x, z, ylab='y', theta=30, phi=30, expand=0.5, col="lightblue") foreach/inst/examples/matmul.R0000644000176200001440000000052613612556305016107 0ustar liggesusers# simple (and inefficient) parallel matrix multiply library(foreach) # generate the input matrices x <- matrix(rnorm(16), 4) y <- matrix(rnorm(16), 4) # multiply the matrices z <- foreach(y=iter(y, by='col'), .combine=cbind) %dopar% (x %*% y) # print the results print(z) # check the results print(all.equal(z, x %*% y)) foreach/inst/examples/sinc.R0000644000176200001440000000126213612556305015542 0ustar liggesusers# simple foreach example that plots the sinc function library(foreach) # Define the coordinate grid to use x <- seq(-10, 10, by=0.1) # Compute starting indices for each task nw <- getDoParWorkers() cat(sprintf('Running with %d worker(s)\n', nw)) n <- ceiling(length(x) / nw) ind <- seq(by=n, length=nw) # Compute the value of the sinc function at each point in the grid z <- foreach(i=ind, .combine=cbind) %dopar% { j <- min(i + n - 1, length(x)) d <- expand.grid(x=x, y=x[i:j]) r <- sqrt(d$x^2 + d$y^2) matrix(10 * sin(r) / r, length(x)) } # Plot the results as a perspective plot persp(x, x, z, ylab='y', theta=30, phi=30, expand=0.5, col="lightblue") foreach/inst/examples/bootpar2.R0000644000176200001440000000124613612556305016340 0ustar liggesusers# foreach version based on for-loop version from Wikipedia # http://en.wikipedia.org/wiki/Bootstrapping_(statistics) library(foreach) data(iris) x <- iris[which(iris[,5] != "setosa"), c(1,5)] trials <- 10000 nwsopts <- list(chunkSize=150) # Can use the following "final" function instead of # using cbind as the "combine" function. final <- function(a) do.call('cbind', a) print(system.time( r <- foreach(icount(trials), .final=final, .options.nws=nwsopts) %dopar% { ind <- sample(100, 100, replace=TRUE) result1 <- glm(x[ind,2]~x[ind,1], family=binomial(logit)) coefficients(result1) } )) hist(r[1,], breaks=40) dev.new() hist(r[2,], breaks=40) foreach/inst/examples/bootpar.R0000644000176200001440000000107013612556305016251 0ustar liggesusers# foreach version based on for-loop version from Wikipedia # http://en.wikipedia.org/wiki/Bootstrapping_(statistics) library(foreach) data(iris) x <- iris[which(iris[,5] != "setosa"), c(1,5)] trials <- 10000 opts <- list(chunkSize=150) print(system.time( r <- foreach(icount(trials), .combine=cbind, .options.nws=opts, .options.smp=opts) %dopar% { ind <- sample(100, 100, replace=TRUE) result1 <- glm(x[ind,2]~x[ind,1], family=binomial(logit)) coefficients(result1) } )) hist(r[1,], breaks=40) dev.new() hist(r[2,], breaks=40) foreach/inst/examples/bootseq.R0000644000176200001440000000102613612556305016260 0ustar liggesusers# for-loop version from Wikipedia # http://en.wikipedia.org/wiki/Bootstrapping_(statistics) data(iris) x <- iris[which(iris[,5] != "setosa"), c(1,5)] trials <- 10000 intercept1 <- rep(0, trials) slope1 <- rep(0, trials) print(system.time( for (B in 1:trials) { ind <- sample(100, 100, replace=TRUE) result1 <- glm(x[ind,2]~x[ind,1], family=binomial(logit)) intercept1[B] <- coefficients(result1)[1] slope1[B] <- coefficients(result1)[2] } )) hist(intercept1, breaks=40) dev.new() hist(slope1, breaks=40) foreach/inst/examples/sqlite.R0000644000176200001440000000207713612556305016114 0ustar liggesuserslibrary(foreach) library(RSQLite) # Define a simple iterator for a query result, which is # just a wrapper around the fetch function iquery <- function(con, statement, ..., n=1) { rs <- dbSendQuery(con, statement, ...) nextEl <- function() { r <- fetch(rs, n) if (nrow(r) == 0) { dbClearResult(rs) stop('StopIteration') } r } obj <- list(nextElem=nextEl) class(obj) <- c('abstractiter', 'iter') obj } # create a SQLite instance and create one connection. m <- dbDriver('SQLite') # initialize a new database to a tempfile and copy some data.frame # from the base package into it tfile <- tempfile() con <- dbConnect(m, dbname=tfile) data(USArrests) dbWriteTable(con, 'USArrests', USArrests) # issue the query, and then iterate over the results it <- iquery(con, 'select * from USArrests', n=10) r <- foreach(r=it, .combine='rbind') %do% { state <- r$row_names crime <- r$Murder + r$Assault + r$Rape data.frame(state=state, crime=crime) } print(r) # clean up dbDisconnect(con) file.remove(tfile) foreach/inst/examples/matmul2.R0000644000176200001440000000147313612556305016173 0ustar liggesusers# Less inefficient parallel matrix multiply using custom matrix iterator library(foreach) iblkcol <- function(a, chunks) { n <- ncol(a) i <- 1 nextEl <- 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] } obj <- list(nextElem=nextEl) class(obj) <- c('abstractiter', 'iter') obj } # generate the input matrices x <- matrix(rnorm(100), 10) y <- matrix(rnorm(100), 10) # multiply the matrices nw <- getDoParWorkers() cat(sprintf('Running with %d worker(s)\n', nw)) mit <- iblkcol(y, nw) z <- foreach(y=mit, .combine=cbind) %dopar% (x %*% y) # print the results print(z) # check the results print(all.equal(z, x %*% y)) foreach/inst/examples/rf.R0000644000176200001440000000121113612556305015207 0ustar liggesusers# a simple parallel random forest library(foreach) library(randomForest) # generate the inputs nr <- 1000 x <- matrix(runif(100000), nr) y <- gl(2, nr/2) # split the total number of trees by the number of parallel execution workers nw <- getDoParWorkers() cat(sprintf('Running with %d worker(s)\n', nw)) it <- idiv(1000, chunks=nw) # run the randomForest jobs, and combine the results print(system.time({ rf <- foreach(ntree=it, .combine=combine, .multicombine=TRUE, .inorder=FALSE, .packages='randomForest') %dopar% { randomForest(x, y, ntree=ntree, importance=TRUE) } })) # print the result print(rf) foreach/inst/examples/comprehensions.R0000644000176200001440000000137413612556305017646 0ustar liggesuserslibrary(foreach) a <- foreach(x=1:4, .combine='c') %do% (x + 2 * x + x / 2) print(a) a <- foreach(x=1:9, .combine='c') %do% (x %% 2 == 1) print(a) a <- foreach(x=1:4, .combine='c') %:% foreach(y=c(3,5,7,9), .combine='c') %do% (x * y) print(a) a <- foreach(x=c(1,5,12,3,23,11,7,2), .combine='c') %:% when(x > 10) %do% x print(a) a <- foreach(x=c(1,3,5), .combine='c') %:% foreach(y=c(2,4,6)) %:% when(x < y) %do% c(x, y) print(a) n <- 30 s <- seq(length=n) a <- foreach(x=s, .combine='c') %:% foreach(y=s, .combine='c') %:% foreach(z=s) %:% when(x + y + z <= n) %:% when(x * x + y * y == z * z) %do% c(x, y, z) print(a) foreach/inst/examples/apply.R0000644000176200001440000001107713612556305015740 0ustar liggesusers# File src/library/base/R/apply.R # Part of the R package, http://www.R-project.org # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ applyPar <- function(X, MARGIN, FUN, ...) { FUN <- match.fun(FUN) ## 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 if(length(oldClass(X)) > 0) X <- if(dl == 2) as.matrix(X) else as.array(X) ## now recompute things as coercion can change dims ## (e.g. when a data frame contains a matrix). d <- dim(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.ans) < 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) #### ans <- vector("list", d2) nw <- getDoParWorkers() if(length(d.call) < 2) {# vector if (length(dn.call)) dimnames(newX) <- c(dn.call, list(NULL)) #### for(i in 1:d2) { #### tmp <- FUN(newX[,i], ...) #### if(!is.null(tmp)) ans[[i]] <- tmp #### } ans <- foreach(x=iblkcol(newX, nw), .combine='c', .packages='foreach') %dopar% { foreach(i=1:ncol(x)) %do% FUN(x[,i], ...) } } else { #### for(i in 1:d2) { #### tmp <- FUN(array(newX[,i], d.call, dn.call), ...) #### if(!is.null(tmp)) ans[[i]] <- tmp #### } ans <- foreach(x=iblkcol(newX, nw), .combine='c', .packages='foreach') %dopar% { foreach(y=1:ncol(x)) %do% FUN(array(x[,i], d.call, dn.call), ...) } } ## 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) { if(is.null(dn.ans)) dn.ans <- vector(mode="list", length(d.ans)) dn.ans <- c(list(ans.names), dn.ans) return(array(ans, c(len.a %/% d2, d.ans), if(!all(sapply(dn.ans, is.null))) dn.ans)) } return(ans) } ############################################################################## # # Something like this will be added to the iterators package. # This creates an iterator over block columns of a matrix. iblkcol <- function(a, chunks) { n <- ncol(a) i <- 1 nextEl <- 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] } obj <- list(nextElem=nextEl) class(obj) <- c('abstractiter', 'iter') obj } # Simple test program for applyPar library(foreach) x <- matrix(rnorm(16000000), 4000) actual <- applyPar(x, 2, mean) expected <- apply(x, 2, mean) cat(sprintf('Result correct: %s\n', identical(actual, expected))) foreach/inst/examples/tuneRF.R0000644000176200001440000000236313612556305016014 0ustar liggesusers# tuning random forest over mtry parameter in parallel library(foreach) library(randomForest) # a simple iterator over different values for the mtry argument mtryiter <- function(from, to, stepFactor=2) { nextEl <- function() { if (from > to) stop('StopIteration') i <- from from <<- ceiling(from * stepFactor) i } obj <- list(nextElem=nextEl) class(obj) <- c('abstractiter', 'iter') obj } # vector of ntree values that we're interested in vntree <- c(25, 50, 100, 200, 500, 1000) # function that gets random forest error information for different values of mtry tune <- function(x, y, ntree=vntree, mtry=NULL, keep.forest=FALSE, ...) { comb <- if (is.factor(y)) function(a, b) rbind(a, data.frame(ntree=ntree, mtry=b$mtry, error=b$err.rate[ntree, 1])) else function(a, b) rbind(a, data.frame(ntree=ntree, mtry=b$mtry, error=b$mse[ntree])) foreach(mtry=mtryiter(1, ncol(x)), .combine=comb, .init=NULL, .packages='randomForest') %dopar% { randomForest(x, y, ntree=max(ntree), mtry=mtry, keep.forest=FALSE, ...) } } # generate the inputs x <- matrix(runif(2000), 100) y <- gl(2, 50) # execute randomForest results <- tune(x, y) # print the result print(results) foreach/inst/examples/output.R0000644000176200001440000000157513612556305016155 0ustar liggesuserslibrary(foreach) # define a combine function that writes the results to a file. # note that the first argument is not a result, but the file # object, and must be specified via the .init argument and # returned as the value of this function. output <- function(fobj, ...) { lines <- list(...) cat(sprintf('writing %d line(s)\n', length(lines))) writeLines(unlist(lines), con=fobj) fobj } # create a temporary file to write the results to fname <- tempfile('foreach') fobj <- file(fname, 'w') # use ireadLines to create an iterator over the lines of the input file, # which are converted to upper case, and processed by the output function foreach(input=ireadLines('output.R'), .combine=output, .init=fobj, .multicombine=TRUE, .maxcombine=5) %do% toupper(input) # display the results and clean up close(fobj) file.show(fname) file.remove(fname) foreach/inst/examples/bigmean2.R0000644000176200001440000000163213612556305016273 0ustar liggesuserslibrary(foreach) # Define a combine function for the partial results comb <- function(...) { n <- foreach(a=list(...), .combine='+') %do% a$n means <- foreach(a=list(...), .combine='+') %do% ((a$n / n) * a$means) list(n=n, means=means) } # initialize some parameters datafile <- 'germandata.txt' nrows <- 100 # germandata.txt only has 1000 rows of data # create an iterator over the data in the file it <- iread.table(datafile, nrows=nrows, header=FALSE, row.names=NULL) # Compute the mean of each of those fields, nrows records at a time print(system.time( r <- foreach(d=it, .combine=comb, .multicombine=TRUE, .final=function(a) a$mean) %do% list(n=nrow(d), means=mean(d)) )) print(r) # This is faster for small problems (when it may not matter), # but becomes slower (or fails) for big problems print(system.time({ d <- read.table(datafile) r <- mean(d) })) print(r) foreach/inst/examples/colMeans.R0000644000176200001440000000100613612556305016343 0ustar liggesusers# compute the mean of the columns and the rows of a matrix library(foreach) # generate the input matrix x <- matrix(rnorm(100 * 100), 100) # compute the mean of each column of x cmeans <- foreach(i=1:ncol(x), .combine=c) %do% mean(x[,i]) # check the results expected <- colMeans(x) print(all.equal(cmeans, expected)) # compute the mean of each row of x rmeans <- foreach(i=1:nrow(x), .combine=c) %do% mean(x[i,]) # check the results expected <- rowMeans(x) print(all.equal(rmeans, expected)) foreach/inst/examples/cross.R0000644000176200001440000000150113612556305015733 0ustar liggesuserslibrary(foreach) NUMROWS <- 500 NUMCOLS <- 100 NUMFOLDS <- 10 CHUNKSIZE <- 50 nwsopts <- list(chunkSize=CHUNKSIZE) xv <- matrix(rnorm(NUMROWS * NUMCOLS), NUMROWS, NUMCOLS) beta <- c(rnorm(NUMCOLS / 2, 0, 5), rnorm(NUMCOLS / 2, 0, 0.25)) yv <- xv %*% beta + rnorm(NUMROWS, 0, 20) dat <- data.frame(y=yv, x=xv) fold <- sample(rep(1:NUMFOLDS, length=NUMROWS)) # the variables dat, fold, and NUMCOLS are automatically exported print(system.time( prss <- foreach(foldnumber=1:NUMFOLDS, .combine='c', .options.nws=nwsopts) %:% foreach(i=2:NUMCOLS, .combine='c', .final=mean) %dopar% { glmfit <- glm(y ~ ., data=dat[fold != foldnumber, 1:i]) yhat <- predict(glmfit, newdata=dat[fold == foldnumber, 1:i]) sum((yhat - dat[fold == foldnumber, 1]) ^ 2) } )) cat('Results:', prss, '\n') foreach/inst/doc/0000755000176200001440000000000013617102076013406 5ustar liggesusersforeach/inst/doc/nested.html0000644000176200001440000007054513617102076015571 0ustar liggesusers Nesting foreach loops

Nesting foreach loops

Steve Weston

Converted to RMarkdown by Hong Ooi

Introduction

The foreach package provides a looping construct for executing R code repeatedly. It is similar to the standard for loop, which makes it easy to convert a for loop to a foreach loop. Unlike many parallel programming packages for R, foreach doesn’t require the body of the for loop to be turned into a function. foreach differs from a for loop in that its return is a list of values, whereas a for loop has no value and uses side effects to convey its result. Because of this, foreach loops have a few advantages over for loops when the purpose of the loop is to create a data structure such as a vector, list, or matrix: First, there is less code duplication, and hence, less chance for an error because the initialization of the vector or matrix is unnecessary. Second, a foreach loop may be easily parallelized by changing only a single keyword.

The nesting operator: %:%

An important feature of foreach is the %:% operator. I call this the nesting operator because it is used to create nested foreach loops. Like the %do% and %dopar% operators, it is a binary operator, but it operates on two foreach objects. It also returns a foreach object, which is essentially a special merger of its operands.

Let’s say that we want to perform a Monte Carlo simulation using a function called sim. (Remember that sim needs to be rather compute intensive to be worth executing in parallel.) The sim function takes two arguments, and we want to call it with all combinations of the values that are stored in the vectors avec and bvec. The following doubly-nested for loop does that. For testing purposes, the sim function is defined to return \(10 a + b\). (Of course, an operation this trivial is not worth executing in parallel.)

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
##      [,1] [,2] [,3] [,4]
## [1,]   11   12   13   14
## [2,]   21   22   23   24

In this case, it makes sense to store the results in a matrix, so we create one of the proper size called x, and assign the return value of sim to the appropriate element of x each time through the inner loop.

When using foreach, we don’t create a matrix and assign values into it. Instead, the inner loop returns the columns of the result matrix as vectors, which are combined in the outer loop into a matrix. Here’s how to do that using the %:% operator. Due to operator precedence, you cannot put braces around the inner foreach loop.

x <-
  foreach(b=bvec, .combine='cbind') %:%
    foreach(a=avec, .combine='c') %do% {
      sim(a, b)
    }
x
##      result.1 result.2 result.3 result.4
## [1,]       11       12       13       14
## [2,]       21       22       23       24

This is structured very much like the nested for loop. The outer foreach is iterating over the values in bvec, passing them to the inner foreach, which iterates over the values in avec for each value of bvec. Thus, the sim function is called in the same way in both cases. The code is slightly cleaner in this version, and has the advantage of being easily parallelized.

Using %:% with %dopar%

When parallelizing nested for loops, there is always a question of which loop to parallelize. The standard advice is to parallelize the outer loop. This results in larger individual tasks, and larger tasks can often be performed more efficiently than smaller tasks. However, if the outer loop doesn’t have many iterations and the tasks are already large, parallelizing the outer loop results in a small number of huge tasks, which may not allow you to use all of your processors, and can also result in load balancing problems. You could parallelize an inner loop instead, but that could be inefficient because you’re repeatedly waiting for all the results to be returned every time through the outer loop. And if the tasks and number of iterations vary in size, then it’s really hard to know which loop to parallelize.

But in our Monte Carlo example, all of the tasks are completely independent of each other, and so they can all be executed in parallel. You really want to think of the loops as specifying a single stream of tasks. You just need to be careful to process all of the results correctly, depending on which iteration of the inner loop they came from.

That is exactly what the %:% operator does: it turns multiple foreach loops into a single loop. That is why there is only one %do% operator in the example above. And when we parallelize that nested foreach loop by changing the %do% into a %dopar%, we are creating a single stream of tasks that can all be executed in parallel:

x <-
  foreach(b=bvec, .combine='cbind') %:%
    foreach(a=avec, .combine='c') %dopar% {
      sim(a, b)
    }
x
##      result.1 result.2 result.3 result.4
## [1,]       11       12       13       14
## [2,]       21       22       23       24

Of course, we’ll actually only run as many tasks in parallel as we have processors, but the parallel backend takes care of all that. The point is that the %:% operator makes it easy to specify the stream of tasks to be executed, and the .combine argument to foreach allows us to specify how the results should be processed. The backend handles executing the tasks in parallel.

Chunking tasks

Of course, there has to be a snag to this somewhere. What if the tasks are quite small, so that you really might want to execute the entire inner loop as a single task? Well, small tasks are a problem even for a singly-nested loop. The solution to this problem, whether you have a single loop or nested loops, is to use task chunking.

Task chunking allows you to send multiple tasks to the workers at once. This can be much more efficient, especially for short tasks. Currently, only the doNWS backend supports task chunking. Here’s how it’s done with doNWS:

opts <- list(chunkSize=2)
x <-
  foreach(b=bvec, .combine='cbind', .options.nws=opts) %:%
    foreach(a=avec, .combine='c') %dopar% {
      sim(a, b)
    }
x
##      result.1 result.2 result.3 result.4
## [1,]       11       12       13       14
## [2,]       21       22       23       24

If you’re not using doNWS, then this argument is ignored, which allows you to write code that is backend-independent. You can also specify options for multiple backends, and only the option list that matches the registered backend will be used.

It would be nice if the chunk size could be picked automatically, but I haven’t figured out a good, safe way to do that. So for now, you need to specify the chunk size manually.

The point is that by using the %:% operator, you can convert a nested for loop to a nested foreach loop, use %dopar% to run in parallel, and then tune the size of the tasks using the chunkSize option so that they are big enough to be executed efficiently, but not so big that they cause load balancing problems. You don’t have to worry about which loop to parallelize, because you’re turning the nested loops into a single stream of tasks that can all be executed in parallel by the parallel backend.

Another example

Now let’s imagine that the sim function returns a object that includes an error estimate. We want to return the result with the lowest error for each value of b, along with the arguments that generated that result. Here’s how that might be done with nested for loops:

n <- length(bvec)
d <- data.frame(x=numeric(n), a=numeric(n), b=numeric(n), err=numeric(n))

for (j in 1:n) {
  err <- Inf
  best <- NULL
  for (i in 1:length(avec)) {
    obj <- sim(avec[i], bvec[j])
    if (obj$err < err) {
      err <- obj$err
      best <- data.frame(x=obj$x, a=avec[i], b=bvec[j], err=obj$err)
    }
  }
  d[j,] <- best
}
d
##    x a b err
## 1 11 1 1   0
## 2 22 2 2   0
## 3 23 2 3   1
## 4 24 2 4   2

This is also quite simple to convert to foreach. We just need to supply the appropriate .combine functions. For the outer foreach, we can use the standard rbind function which can be used with data frames. For the inner foreach, we write a function that compares two data frames, each with a single row, returning the one with a smaller error estimate:

comb <- function(d1, d2) if (d1$err < d2$err) d1 else d2

Now we specify it with the .combine argument to the inner foreach:

opts <- list(chunkSize=2)
d <-
  foreach(b=bvec, .combine='rbind', .options.nws=opts) %:%
    foreach(a=avec, .combine='comb', .inorder=FALSE) %dopar% {
      obj <- sim(a, b)
      data.frame(x=obj$x, a=a, b=b, err=obj$err)
    }
d
##    x a b err
## 1 11 1 1   0
## 2 22 2 2   0
## 3 23 2 3   1
## 4 24 2 4   2

Note that since the order of the arguments to the comb function is unimportant, I have set the .inorder argument to FALSE. This reduces the number of results that need to be saved on the master before they can be combined in case they are returned out of order. But even with niceties such as parallelization, backend-specific options, and the .inorder argument, the nested foreach version is quite readable.

But what if we would like to return the indices into avec and bvec, rather than the data itself? A simple way to do that is to create a couple of counting iterators that we pass to the foreach functions:

library(iterators)
opts <- list(chunkSize=2)
d <-
  foreach(b=bvec, j=icount(), .combine='rbind', .options.nws=opts) %:%
    foreach(a=avec, i=icount(), .combine='comb', .inorder=FALSE) %dopar% {
      obj <- sim(a, b)
      data.frame(x=obj$x, i=i, j=j, err=obj$err)
    }
d
##    x i j err
## 1 11 1 1   0
## 2 22 2 2   0
## 3 23 2 3   1
## 4 24 2 4   2

Note that it’s very important that the call to icount is passed as the argument to foreach. If the iterators were created and passed to foreach using a variable, for example, we would not get the desired effect. This is not a bug or a limitation, but an important aspect of the design of the foreach function.

These new iterators are infinite iterators, but that’s no problem since we have bvec and avec to control the number of iterations of the loops. Making them infinite means we don’t have to keep them in sync with bvec and avec.

Conclusion

Nested for loops are a common construct, and are often the most time consuming part of R scripts, so they are prime candidates for parallelization. The usual approach is to parallelize the outer loop, but as we’ve seen, that can lead to suboptimal performance due to an imbalance between the size and the number of tasks. By using the %:% operator with foreach, and by using chunking techniques, many of these problems can be overcome. The resulting code is often clearer and more readable than the original R code, since foreach was designed to deal with exactly this kind of problem.

foreach/inst/doc/foreach.R0000644000176200001440000001253413617102075015144 0ustar liggesusers## ----loadLibs----------------------------------------------------------------- library(foreach) ## ----ex1---------------------------------------------------------------------- x <- foreach(i=1:3) %do% sqrt(i) x ## ----ex2---------------------------------------------------------------------- x <- foreach(a=1:3, b=rep(10, 3)) %do% (a + b) x ## ----ex3---------------------------------------------------------------------- x <- foreach(a=1:3, b=rep(10, 3)) %do% { a + b } x ## ----ex4---------------------------------------------------------------------- x <- foreach(a=1:1000, b=rep(10, 2)) %do% { a + b } x ## ----ex5---------------------------------------------------------------------- x <- foreach(i=1:3, .combine='c') %do% exp(i) x ## ----ex6---------------------------------------------------------------------- x <- foreach(i=1:4, .combine='cbind') %do% rnorm(4) x ## ----ex7---------------------------------------------------------------------- x <- foreach(i=1:4, .combine='+') %do% rnorm(4) x ## ----ex7.1-------------------------------------------------------------------- cfun <- function(a, b) NULL x <- foreach(i=1:4, .combine='cfun') %do% rnorm(4) x ## ----ex7.2-------------------------------------------------------------------- cfun <- function(...) NULL x <- foreach(i=1:4, .combine='cfun', .multicombine=TRUE) %do% rnorm(4) x ## ----ex7.3-------------------------------------------------------------------- cfun <- function(...) NULL x <- foreach(i=1:4, .combine='cfun', .multicombine=TRUE, .maxcombine=10) %do% rnorm(4) x ## ----ex7.4-------------------------------------------------------------------- foreach(i=4:1, .combine='c') %dopar% { Sys.sleep(3 * i) i } foreach(i=4:1, .combine='c', .inorder=FALSE) %dopar% { Sys.sleep(3 * i) i } ## ----ex8---------------------------------------------------------------------- library(iterators) x <- foreach(a=irnorm(4, count=4), .combine='cbind') %do% a x ## ----ex9---------------------------------------------------------------------- set.seed(123) x <- foreach(a=irnorm(4, count=1000), .combine='+') %do% a x ## ----ex10--------------------------------------------------------------------- set.seed(123) x <- numeric(4) i <- 0 while (i < 1000) { x <- x + rnorm(4) i <- i + 1 } x ## ----ex11--------------------------------------------------------------------- set.seed(123) x <- foreach(icount(1000), .combine='+') %do% rnorm(4) x ## ----ex12.data---------------------------------------------------------------- x <- matrix(runif(500), 100) y <- gl(2, 50) ## ----ex12.load---------------------------------------------------------------- library(randomForest) ## ----ex12.seq----------------------------------------------------------------- rf <- foreach(ntree=rep(250, 4), .combine=combine) %do% randomForest(x, y, ntree=ntree) rf ## ----ex12.par----------------------------------------------------------------- rf <- foreach(ntree=rep(250, 4), .combine=combine, .packages='randomForest') %dopar% randomForest(x, y, ntree=ntree) rf ## ----ex13.orig---------------------------------------------------------------- applyKernel <- function(newX, FUN, d2, d.call, dn.call=NULL, ...) { ans <- vector("list", d2) for(i in 1:d2) { tmp <- FUN(array(newX[,i], d.call, dn.call), ...) if(!is.null(tmp)) ans[[i]] <- tmp } ans } applyKernel(matrix(1:16, 4), mean, 4, 4) ## ----ex13.first--------------------------------------------------------------- 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) ## ----ex13.second-------------------------------------------------------------- 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) ## ----ex13.iter, results="hide"------------------------------------------------ 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() ## ----ex13.third--------------------------------------------------------------- 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) ## ----when--------------------------------------------------------------------- x <- foreach(a=irnorm(1, count=10), .combine='c') %:% when(a >= 0) %do% sqrt(a) x ## ----qsort-------------------------------------------------------------------- qsort <- function(x) { n <- length(x) if (n == 0) { x } else { p <- sample(n, 1) smaller <- foreach(y=x[-p], .combine=c) %:% when(y <= x[p]) %do% y larger <- foreach(y=x[-p], .combine=c) %:% when(y > x[p]) %do% y c(qsort(smaller), x[p], qsort(larger)) } } qsort(runif(12)) foreach/inst/doc/foreach.Rmd0000644000176200001440000004405613615517321015473 0ustar liggesusers--- title: Using the `foreach` package author: Steve Weston output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{foreach} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{utf8} --- _Converted to RMarkdown by Hong Ooi_ ## Introduction One of R's most useful features is its interactive interpreter. This makes it very easy to learn and experiment with R. It allows you to use R like a calculator to perform arithmetic operations, display data sets, generate plots, and create models. Before too long, new R users will find a need to perform some operation repeatedly. Perhaps they want to run a simulation repeatedly in order to find the distribution of the results. Perhaps they need to execute a function with a variety a different arguments passed to it. Or maybe they need to create a model for many different data sets. Repeated executions can be done manually, but it becomes quite tedious to execute repeated operations, even with the use of command line editing. Fortunately, R is much more than an interactive calculator. It has its own built-in language that is intended to automate tedious tasks, such as repeatedly executing R calculations. R comes with various looping constructs that solve this problem. The `for` loop is one of the more common looping constructs, but the `repeat` and `while` statements are also quite useful. In addition, there is the family of "apply" functions, which includes `apply`, `lapply`, `sapply`, `eapply`, `mapply`, `rapply`, and others. The `foreach` package provides a new looping construct for executing R code repeatedly. With the bewildering variety of existing looping constructs, you may doubt that there is a need for yet another construct. The main reason for using the `foreach` package is that it supports _parallel execution_, that is, it can execute those repeated operations on multiple processors/cores on your computer, or on multiple nodes of a cluster. If each operation takes over a minute, and you want to execute it hundreds of times, the overall runtime can take hours. But using `foreach`, that operation can be executed in parallel on hundreds of processors on a cluster, reducing the execution time back down to minutes. But parallel execution is not the only reason for using the `foreach` package. There are other reasons that you might choose to use it to execute quick executing operations, as we will see later in the document. ## Getting Started Let's take a look at a simple example use of the `foreach` package. Assuming that you have the `foreach` package installed, you first need to load it: ```{r loadLibs} library(foreach) ``` Note that all of the packages that `foreach` depends on will be loaded as well. Now I can use `foreach` to execute the `sqrt` function repeatedly, passing it the values 1 through 3, and returning the results in a list, called `x`. (Of course, `sqrt` is a vectorized function, so you would never really do this. But later, we'll see how to take advantage of vectorized functions with `foreach`.) ```{r ex1} x <- foreach(i=1:3) %do% sqrt(i) x ``` This is a bit odd looking, because it looks vaguely like a `for` loop, but is implemented using a binary operator, called `%do%`. Also, unlike a `for` loop, it returns a value. This is quite important. The purpose of this statement is to compute the list of results. Generally, `foreach` with `%do%` is used to execute an R expression repeatedly, and return the results in some data structure or object, which is a list by default. You will note in the previous example that we used a variable `i` as the argument to the `sqrt` function. We specified the values of the `i` variable using a named argument to the `foreach` function. We could have called that variable anything we wanted, for example, `a`, or `b`. We could also specify other variables to be used in the R expression, as in the following example: ```{r ex2} x <- foreach(a=1:3, b=rep(10, 3)) %do% (a + b) x ``` Note that parentheses are needed here. We can also use braces: ```{r ex3} x <- foreach(a=1:3, b=rep(10, 3)) %do% { a + b } x ``` We call `a` and `b` the _iteration variables_, since those are the variables that are changing during the multiple executions. Note that we are iterating over them in parallel, that is, they are both changing at the same time. In this case, the same number of values are being specified for both iteration variables, but that need not be the case. If we only supplied two values for `b`, the result would be a list of length two, even if we specified a thousand values for `a`: ```{r ex4} x <- foreach(a=1:1000, b=rep(10, 2)) %do% { a + b } x ``` Note that you can put multiple statements between the braces, and you can use assignment statements to save intermediate values of computations. However, if you use an assignment as a way of communicating between the different executions of your loop, then your code won't work correctly in parallel, which we will discuss later. \section{The `.combine` Option} So far, all of our examples have returned a list of results. This is a good default, since a list can contain any R object. But sometimes we'd like the results to be returned in a numeric vector, for example. This can be done by using the `.combine` option to `foreach`: ```{r ex5} x <- foreach(i=1:3, .combine='c') %do% exp(i) x ``` The result is returned as a numeric vector, because the standard R `c` function is being used to concatenate all the results. Since the `exp` function returns numeric values, concatenating them with the `c` function will result in a numeric vector of length three. What if the R expression returns a vector, and we want to combine those vectors into a matrix? One way to do that is with the `cbind` function: ```{r ex6} x <- foreach(i=1:4, .combine='cbind') %do% rnorm(4) x ``` This generates four vectors of four random numbers, and combines them by column to produce a 4 by 4 matrix. We can also use the `"+"` or `"*"` functions to combine our results: ```{r ex7} x <- foreach(i=1:4, .combine='+') %do% rnorm(4) x ``` You can also specify a user-written function to combine the results. Here's an example that throws away the results: ```{r ex7.1} cfun <- function(a, b) NULL x <- foreach(i=1:4, .combine='cfun') %do% rnorm(4) x ``` Note that this `cfun` function takes two arguments. The `foreach` function knows that the functions `c`, `cbind`, and `rbind` take many arguments, and will call them with up to 100 arguments (by default) in order to improve performance. But if any other function is specified (such as `"+"`), it assumes that it only takes two arguments. If the function does allow many arguments, you can specify that using the `.multicombine` argument: ```{r ex7.2} cfun <- function(...) NULL x <- foreach(i=1:4, .combine='cfun', .multicombine=TRUE) %do% rnorm(4) x ``` If you want the combine function to be called with no more than 10 arguments, you can specify that using the `.maxcombine` option: ```{r ex7.3} cfun <- function(...) NULL x <- foreach(i=1:4, .combine='cfun', .multicombine=TRUE, .maxcombine=10) %do% rnorm(4) x ``` The `.inorder` option is used to specify whether the order in which the arguments are combined is important. The default value is `TRUE`, but if the combine function is `"+"`, you could specify `.inorder` to be `FALSE`. Actually, this option is important only when executing the R expression in parallel, since results are always computed in order when running sequentially. This is not necessarily true when executing in parallel, however. In fact, if the expressions take very different lengths of time to execute, the results could be returned in any order. Here's a contrived example, that executes the tasks in parallel to demonstrate the difference. The example uses the `Sys.sleep` function to cause the earlier tasks to take longer to execute: ```{r ex7.4} foreach(i=4:1, .combine='c') %dopar% { Sys.sleep(3 * i) i } foreach(i=4:1, .combine='c', .inorder=FALSE) %dopar% { Sys.sleep(3 * i) i } ``` The results of the first of these two examples is guaranteed to be the vector `c(4, 3, 2, 1)`. The second example will return the same values, but they will probably be in a different order. ## Iterators The values for the iteration variables don't have to be specified with only vectors or lists. They can be specified with an _iterator_, many of which come with the `iterators` package. An iterator is an abstract source of data. A vector isn't itself an iterator, but the `foreach` function automatically creates an iterator from a vector, list, matrix, or data frame, for example. You can also create an iterator from a file or a data base query, which are natural sources of data. The `iterators` package supplies a function called `irnorm` which can return a specified number of random numbers for each time it is called. For example: ```{r ex8} library(iterators) x <- foreach(a=irnorm(4, count=4), .combine='cbind') %do% a x ``` This becomes useful when dealing with large amounts of data. Iterators allow the data to be generated on-the-fly, as it is needed by your operations, rather than requiring all of the data to be generated at the beginning. For example, let's say that we want to sum together a thousand random vectors: ```{r ex9} set.seed(123) x <- foreach(a=irnorm(4, count=1000), .combine='+') %do% a x ``` This uses very little memory, since it is equivalent to the following `while` loop: ```{r ex10} set.seed(123) x <- numeric(4) i <- 0 while (i < 1000) { x <- x + rnorm(4) i <- i + 1 } x ``` This could have been done using the `icount` function, which generates the values from one to 1000: ```{r ex11} set.seed(123) x <- foreach(icount(1000), .combine='+') %do% rnorm(4) x ``` but sometimes it's preferable to generate the actual data with the iterator (as we'll see later when we execute in parallel). In addition to introducing the `icount` function from the `iterators` package, the last example also used an unnamed argument to the `foreach` function. This can be useful when we're not intending to generate variable values, but only controlling the number of times that the R expression is executed. There's a lot more that I could say about iterators, but for now, let's move on to parallel execution. ## Parallel Execution Although `foreach` can be a useful construct in its own right, the real point of the `foreach` package is to do parallel computing. To make any of the previous examples run in parallel, all you have to do is to replace `%do%` with `%dopar%`. But for the kinds of quick running operations that we've been doing, there wouldn't be much point to executing them in parallel. Running many tiny tasks in parallel will usually take more time to execute than running them sequentially, and if it already runs fast, there's no motivation to make it run faster anyway. But if the operation that we're executing in parallel takes a minute or longer, there starts to be some motivation. ### Parallel Random Forest Let's take random forest as an example of an operation that can take a while to execute. Let's say our inputs are the matrix `x`, and the factor `y`: ```{r ex12.data} x <- matrix(runif(500), 100) y <- gl(2, 50) ``` We've already loaded the `foreach` package, but we'll also need to load the `randomForest` package: ```{r ex12.load} library(randomForest) ``` If we want want to create a random forest model with a 1000 trees, and our computer has four cores in it, we can split up the problem into four pieces by executing the `randomForest` function four times, with the `ntree` argument set to 250. Of course, we have to combine the resulting `randomForest` objects, but the `randomForest` package comes with a function called `combine` that does just that. Let's do that, but first, we'll do the work sequentially: ```{r ex12.seq} rf <- foreach(ntree=rep(250, 4), .combine=combine) %do% randomForest(x, y, ntree=ntree) rf ``` To run this in parallel, we need to change `\%do\%`, but we also need to use another `foreach` option called `.packages` to tell the `foreach` package that the R expression needs to have the `randomForest` package loaded in order to execute successfully. Here's the parallel version: ```{r ex12.par} rf <- foreach(ntree=rep(250, 4), .combine=combine, .packages='randomForest') %dopar% randomForest(x, y, ntree=ntree) rf ``` If you've done any parallel computing, particularly on a cluster, you may wonder why I didn't have to do anything special to handle `x` and `y`. The reason is that the `dopar` function noticed that those variables were referenced, and that they were defined in the current environment. In that case `%dopar%` will automatically export them to the parallel execution workers once, and use them for all of the expression evaluations for that `foreach` execution. That is true for functions that are defined in the current environment as well, but in this case, the function is defined in a package, so we had to specify the package to load with the `.packages` option instead. ### Parallel Apply Now let's take a look at how to make a parallel version of the standard R `apply` function. The `apply` function is written in R, and although it's only about 100 lines of code, it's a bit difficult to understand on a first reading. However, it all really comes down two `for` loops, the slightly more complicated of which looks like: ```{r ex13.orig} applyKernel <- function(newX, FUN, d2, d.call, dn.call=NULL, ...) { ans <- vector("list", d2) for(i in 1:d2) { tmp <- FUN(array(newX[,i], d.call, dn.call), ...) if(!is.null(tmp)) ans[[i]] <- tmp } ans } applyKernel(matrix(1:16, 4), mean, 4, 4) ``` I've turned this into a function, because otherwise, R will complain that I'm using `...` in an invalid context. This could be executed using `foreach` as follows: ```{r ex13.first} 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 this approach will cause the entire `newX` array to be sent to each of the parallel execution workers. Since each task needs only one column of the array, we'd like to avoid this extra data communication. One way to solve this problem is to use an iterator that iterates over the matrix by column: ```{r ex13.second} 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) ``` Now we're only sending any given column of the matrix to one parallel execution worker. But it would be even more efficient if we sent the matrix in bigger chunks. To do that, we use a function called `iblkcol` that returns an iterator that will return multiple columns of the original matrix. That means that the R expression will need to execute the user's function once for every column in its submatrix. ```{r ex13.iter, results="hide"} 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() ``` ```{r ex13.third} 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) ``` Note the use of the `%do%` inside the `%dopar%` to call the function on the columns of the submatrix `x`. Now that we're using `%do%` again, it makes sense for the iterator to be an index into the matrix `x`, since `%do%` doesn't need to copy `x` the way that `%dopar%` does. ## List Comprehensions If you're familiar with the Python programming language, it may have occurred to you that the `foreach` package provides something that is not too different from Python's _list comprehensions_. In fact, the `foreach` package also includes a function called `when` which can prevent some of the evaluations from happening, very much like the "if" clause in Python's list comprehensions. For example, you could filter out negative values of an iterator using `when` as follows: ```{r when} x <- foreach(a=irnorm(1, count=10), .combine='c') %:% when(a >= 0) %do% sqrt(a) x ``` I won't say much on this topic, but I can't help showing how `foreach` with `when` can be used to write a simple quick sort function, in the classic Haskell fashion: ```{r qsort} qsort <- function(x) { n <- length(x) if (n == 0) { x } else { p <- sample(n, 1) smaller <- foreach(y=x[-p], .combine=c) %:% when(y <= x[p]) %do% y larger <- foreach(y=x[-p], .combine=c) %:% when(y > x[p]) %do% y c(qsort(smaller), x[p], qsort(larger)) } } qsort(runif(12)) ``` Not that I recommend this over the standard R `sort` function. But it's a pretty interesting example use of `foreach`. ## Conclusion Much of parallel computing comes to doing three things: splitting the problem into pieces, executing the pieces in parallel, and combining the results back together. Using the `foreach` package, the iterators help you to split the problem into pieces, the `%dopar%` function executes the pieces in parallel, and the specified `.combine` function puts the results back together. We've demonstrated how simple things can be done in parallel quite easily using the `foreach` package, and given some ideas about how more complex problems can be solved. But it's a fairly new package, and we will continue to work on ways of making it a more powerful system for doing parallel computing. foreach/inst/doc/nested.Rmd0000644000176200001440000002567513614562752015363 0ustar liggesusers--- title: Nesting `foreach` loops author: Steve Weston output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{nested} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{utf8} --- _Converted to RMarkdown by Hong Ooi_ ## Introduction ```{r loadLibs, echo=FALSE, results="hide"} library(foreach) registerDoSEQ() ``` The `foreach` package provides a looping construct for executing R code repeatedly. It is similar to the standard `for` loop, which makes it easy to convert a `for` loop to a `foreach` loop. Unlike many parallel programming packages for R, `foreach` doesn't require the body of the `for` loop to be turned into a function. `foreach` differs from a `for` loop in that its return is a list of values, whereas a `for` loop has no value and uses side effects to convey its result. Because of this, `foreach` loops have a few advantages over `for` loops when the purpose of the loop is to create a data structure such as a vector, list, or matrix: First, there is less code duplication, and hence, less chance for an error because the initialization of the vector or matrix is unnecessary. Second, a `foreach` loop may be easily parallelized by changing only a single keyword. ## The nesting operator: `%:%` An important feature of `foreach` is the `%:%` operator. I call this the _nesting_ operator because it is used to create nested `foreach` loops. Like the `%do%` and `%dopar%` operators, it is a binary operator, but it operates on two `foreach` objects. It also returns a `foreach` object, which is essentially a special merger of its operands. Let's say that we want to perform a Monte Carlo simulation using a function called `sim`. (Remember that `sim` needs to be rather compute intensive to be worth executing in parallel.) The `sim` function takes two arguments, and we want to call it with all combinations of the values that are stored in the vectors `avec` and `bvec`. The following doubly-nested `for` loop does that. For testing purposes, the `sim` function is defined to return $10 a + b$. (Of course, an operation this trivial is not worth executing in parallel.) ```{r init1,echo=FALSE,results="hide"} sim <- function(a, b) 10 * a + b avec <- 1:2 bvec <- 1:4 ``` ```{r for1} 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 ``` In this case, it makes sense to store the results in a matrix, so we create one of the proper size called `x`, and assign the return value of `sim` to the appropriate element of `x` each time through the inner loop. When using `foreach`, we don't create a matrix and assign values into it. Instead, the inner loop returns the columns of the result matrix as vectors, which are combined in the outer loop into a matrix. Here's how to do that using the `%:%` operator. Due to operator precedence, you cannot put braces around the inner `foreach` loop. ```{r foreach1} x <- foreach(b=bvec, .combine='cbind') %:% foreach(a=avec, .combine='c') %do% { sim(a, b) } x ``` This is structured very much like the nested `for` loop. The outer `foreach` is iterating over the values in `bvec`, passing them to the inner `foreach`, which iterates over the values in `avec` for each value of `bvec`. Thus, the `sim` function is called in the same way in both cases. The code is slightly cleaner in this version, and has the advantage of being easily parallelized. ## Using `%:%` with `%dopar%` When parallelizing nested `for` loops, there is always a question of which loop to parallelize. The standard advice is to parallelize the outer loop. This results in larger individual tasks, and larger tasks can often be performed more efficiently than smaller tasks. However, if the outer loop doesn't have many iterations and the tasks are already large, parallelizing the outer loop results in a small number of huge tasks, which may not allow you to use all of your processors, and can also result in load balancing problems. You could parallelize an inner loop instead, but that could be inefficient because you're repeatedly waiting for all the results to be returned every time through the outer loop. And if the tasks and number of iterations vary in size, then it's really hard to know which loop to parallelize. But in our Monte Carlo example, all of the tasks are completely independent of each other, and so they can all be executed in parallel. You really want to think of the loops as specifying a single stream of tasks. You just need to be careful to process all of the results correctly, depending on which iteration of the inner loop they came from. That is exactly what the `%:%` operator does: it turns multiple `foreach` loops into a single loop. That is why there is only one `%do%` operator in the example above. And when we parallelize that nested `foreach` loop by changing the `%do%` into a `%dopar%`, we are creating a single stream of tasks that can all be executed in parallel: ```{r foreach2} x <- foreach(b=bvec, .combine='cbind') %:% foreach(a=avec, .combine='c') %dopar% { sim(a, b) } x ``` Of course, we'll actually only run as many tasks in parallel as we have processors, but the parallel backend takes care of all that. The point is that the `%:%` operator makes it easy to specify the stream of tasks to be executed, and the `.combine` argument to `foreach` allows us to specify how the results should be processed. The backend handles executing the tasks in parallel. ## Chunking tasks Of course, there has to be a snag to this somewhere. What if the tasks are quite small, so that you really might want to execute the entire inner loop as a single task? Well, small tasks are a problem even for a singly-nested loop. The solution to this problem, whether you have a single loop or nested loops, is to use _task chunking_. Task chunking allows you to send multiple tasks to the workers at once. This can be much more efficient, especially for short tasks. Currently, only the `doNWS` backend supports task chunking. Here's how it's done with `doNWS`: ```{r foreach3} opts <- list(chunkSize=2) x <- foreach(b=bvec, .combine='cbind', .options.nws=opts) %:% foreach(a=avec, .combine='c') %dopar% { sim(a, b) } x ``` If you're not using `doNWS`, then this argument is ignored, which allows you to write code that is backend-independent. You can also specify options for multiple backends, and only the option list that matches the registered backend will be used. It would be nice if the chunk size could be picked automatically, but I haven't figured out a good, safe way to do that. So for now, you need to specify the chunk size manually. The point is that by using the `%:%` operator, you can convert a nested `for` loop to a nested `foreach` loop, use `%dopar%` to run in parallel, and then tune the size of the tasks using the `chunkSize` option so that they are big enough to be executed efficiently, but not so big that they cause load balancing problems. You don't have to worry about which loop to parallelize, because you're turning the nested loops into a single stream of tasks that can all be executed in parallel by the parallel backend. ## Another example Now let's imagine that the `sim` function returns a object that includes an error estimate. We want to return the result with the lowest error for each value of b, along with the arguments that generated that result. Here's how that might be done with nested `for` loops: ```{r init2, echo=FALSE, results="hide"} sim <- function(a, b) { x <- 10 * a + b err <- abs(a - b) list(x=x, err=err) } ``` ```{r for2} n <- length(bvec) d <- data.frame(x=numeric(n), a=numeric(n), b=numeric(n), err=numeric(n)) for (j in 1:n) { err <- Inf best <- NULL for (i in 1:length(avec)) { obj <- sim(avec[i], bvec[j]) if (obj$err < err) { err <- obj$err best <- data.frame(x=obj$x, a=avec[i], b=bvec[j], err=obj$err) } } d[j,] <- best } d ``` This is also quite simple to convert to `foreach`. We just need to supply the appropriate `.combine` functions. For the outer `foreach`, we can use the standard `rbind` function which can be used with data frames. For the inner `foreach`, we write a function that compares two data frames, each with a single row, returning the one with a smaller error estimate: ```{r innercombine} comb <- function(d1, d2) if (d1$err < d2$err) d1 else d2 ``` Now we specify it with the `.combine` argument to the inner `foreach`: ```{r foreach4} opts <- list(chunkSize=2) d <- foreach(b=bvec, .combine='rbind', .options.nws=opts) %:% foreach(a=avec, .combine='comb', .inorder=FALSE) %dopar% { obj <- sim(a, b) data.frame(x=obj$x, a=a, b=b, err=obj$err) } d ``` Note that since the order of the arguments to the `comb` function is unimportant, I have set the `.inorder` argument to `FALSE`. This reduces the number of results that need to be saved on the master before they can be combined in case they are returned out of order. But even with niceties such as parallelization, backend-specific options, and the `.inorder` argument, the nested `foreach` version is quite readable. But what if we would like to return the indices into `avec` and `bvec`, rather than the data itself? A simple way to do that is to create a couple of counting iterators that we pass to the `foreach` functions: ```{r foreach5} library(iterators) opts <- list(chunkSize=2) d <- foreach(b=bvec, j=icount(), .combine='rbind', .options.nws=opts) %:% foreach(a=avec, i=icount(), .combine='comb', .inorder=FALSE) %dopar% { obj <- sim(a, b) data.frame(x=obj$x, i=i, j=j, err=obj$err) } d ``` Note that it's very important that the call to icount is passed as the argument to `foreach`. If the iterators were created and passed to `foreach` using a variable, for example, we would not get the desired effect. This is not a bug or a limitation, but an important aspect of the design of the `foreach` function. These new iterators are infinite iterators, but that's no problem since we have `bvec` and `avec` to control the number of iterations of the loops. Making them infinite means we don't have to keep them in sync with `bvec` and `avec`. ## Conclusion Nested `for` loops are a common construct, and are often the most time consuming part of R scripts, so they are prime candidates for parallelization. The usual approach is to parallelize the outer loop, but as we've seen, that can lead to suboptimal performance due to an imbalance between the size and the number of tasks. By using the `%:%` operator with `foreach`, and by using chunking techniques, many of these problems can be overcome. The resulting code is often clearer and more readable than the original R code, since `foreach` was designed to deal with exactly this kind of problem. foreach/inst/doc/nested.R0000644000176200001440000000505713617102076015022 0ustar liggesusers## ----loadLibs, echo=FALSE, results="hide"------------------------------------- library(foreach) registerDoSEQ() ## ----init1,echo=FALSE,results="hide"------------------------------------------ sim <- function(a, b) 10 * a + b avec <- 1:2 bvec <- 1:4 ## ----for1--------------------------------------------------------------------- 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 ## ----foreach1----------------------------------------------------------------- x <- foreach(b=bvec, .combine='cbind') %:% foreach(a=avec, .combine='c') %do% { sim(a, b) } x ## ----foreach2----------------------------------------------------------------- x <- foreach(b=bvec, .combine='cbind') %:% foreach(a=avec, .combine='c') %dopar% { sim(a, b) } x ## ----foreach3----------------------------------------------------------------- opts <- list(chunkSize=2) x <- foreach(b=bvec, .combine='cbind', .options.nws=opts) %:% foreach(a=avec, .combine='c') %dopar% { sim(a, b) } x ## ----init2, echo=FALSE, results="hide"---------------------------------------- sim <- function(a, b) { x <- 10 * a + b err <- abs(a - b) list(x=x, err=err) } ## ----for2--------------------------------------------------------------------- n <- length(bvec) d <- data.frame(x=numeric(n), a=numeric(n), b=numeric(n), err=numeric(n)) for (j in 1:n) { err <- Inf best <- NULL for (i in 1:length(avec)) { obj <- sim(avec[i], bvec[j]) if (obj$err < err) { err <- obj$err best <- data.frame(x=obj$x, a=avec[i], b=bvec[j], err=obj$err) } } d[j,] <- best } d ## ----innercombine------------------------------------------------------------- comb <- function(d1, d2) if (d1$err < d2$err) d1 else d2 ## ----foreach4----------------------------------------------------------------- opts <- list(chunkSize=2) d <- foreach(b=bvec, .combine='rbind', .options.nws=opts) %:% foreach(a=avec, .combine='comb', .inorder=FALSE) %dopar% { obj <- sim(a, b) data.frame(x=obj$x, a=a, b=b, err=obj$err) } d ## ----foreach5----------------------------------------------------------------- library(iterators) opts <- list(chunkSize=2) d <- foreach(b=bvec, j=icount(), .combine='rbind', .options.nws=opts) %:% foreach(a=avec, i=icount(), .combine='comb', .inorder=FALSE) %dopar% { obj <- sim(a, b) data.frame(x=obj$x, i=i, j=j, err=obj$err) } d foreach/inst/doc/foreach.html0000644000176200001440000014325113617102075015710 0ustar liggesusers Using the foreach package

Using the foreach package

Steve Weston

Converted to RMarkdown by Hong Ooi

Introduction

One of R’s most useful features is its interactive interpreter. This makes it very easy to learn and experiment with R. It allows you to use R like a calculator to perform arithmetic operations, display data sets, generate plots, and create models.

Before too long, new R users will find a need to perform some operation repeatedly. Perhaps they want to run a simulation repeatedly in order to find the distribution of the results. Perhaps they need to execute a function with a variety a different arguments passed to it. Or maybe they need to create a model for many different data sets.

Repeated executions can be done manually, but it becomes quite tedious to execute repeated operations, even with the use of command line editing. Fortunately, R is much more than an interactive calculator. It has its own built-in language that is intended to automate tedious tasks, such as repeatedly executing R calculations.

R comes with various looping constructs that solve this problem. The for loop is one of the more common looping constructs, but the repeat and while statements are also quite useful. In addition, there is the family of “apply” functions, which includes apply, lapply, sapply, eapply, mapply, rapply, and others.

The foreach package provides a new looping construct for executing R code repeatedly. With the bewildering variety of existing looping constructs, you may doubt that there is a need for yet another construct. The main reason for using the foreach package is that it supports parallel execution, that is, it can execute those repeated operations on multiple processors/cores on your computer, or on multiple nodes of a cluster. If each operation takes over a minute, and you want to execute it hundreds of times, the overall runtime can take hours. But using foreach, that operation can be executed in parallel on hundreds of processors on a cluster, reducing the execution time back down to minutes.

But parallel execution is not the only reason for using the foreach package. There are other reasons that you might choose to use it to execute quick executing operations, as we will see later in the document.

Getting Started

Let’s take a look at a simple example use of the foreach package. Assuming that you have the foreach package installed, you first need to load it:

library(foreach)

Note that all of the packages that foreach depends on will be loaded as well.

Now I can use foreach to execute the sqrt function repeatedly, passing it the values 1 through 3, and returning the results in a list, called x. (Of course, sqrt is a vectorized function, so you would never really do this. But later, we’ll see how to take advantage of vectorized functions with foreach.)

x <- foreach(i=1:3) %do% sqrt(i)
x
## [[1]]
## [1] 1
## 
## [[2]]
## [1] 1.414214
## 
## [[3]]
## [1] 1.732051

This is a bit odd looking, because it looks vaguely like a for loop, but is implemented using a binary operator, called %do%. Also, unlike a for loop, it returns a value. This is quite important. The purpose of this statement is to compute the list of results. Generally, foreach with %do% is used to execute an R expression repeatedly, and return the results in some data structure or object, which is a list by default.

You will note in the previous example that we used a variable i as the argument to the sqrt function. We specified the values of the i variable using a named argument to the foreach function. We could have called that variable anything we wanted, for example, a, or b. We could also specify other variables to be used in the R expression, as in the following example:

x <- foreach(a=1:3, b=rep(10, 3)) %do% (a + b)
x
## [[1]]
## [1] 11
## 
## [[2]]
## [1] 12
## 
## [[3]]
## [1] 13

Note that parentheses are needed here. We can also use braces:

x <- foreach(a=1:3, b=rep(10, 3)) %do% {
  a + b
}
x
## [[1]]
## [1] 11
## 
## [[2]]
## [1] 12
## 
## [[3]]
## [1] 13

We call a and b the iteration variables, since those are the variables that are changing during the multiple executions. Note that we are iterating over them in parallel, that is, they are both changing at the same time. In this case, the same number of values are being specified for both iteration variables, but that need not be the case. If we only supplied two values for b, the result would be a list of length two, even if we specified a thousand values for a:

x <- foreach(a=1:1000, b=rep(10, 2)) %do% {
  a + b
}
x
## [[1]]
## [1] 11
## 
## [[2]]
## [1] 12

Note that you can put multiple statements between the braces, and you can use assignment statements to save intermediate values of computations. However, if you use an assignment as a way of communicating between the different executions of your loop, then your code won’t work correctly in parallel, which we will discuss later.

So far, all of our examples have returned a list of results. This is a good default, since a list can contain any R object. But sometimes we’d like the results to be returned in a numeric vector, for example. This can be done by using the .combine option to foreach:

x <- foreach(i=1:3, .combine='c') %do% exp(i)
x
## [1]  2.718282  7.389056 20.085537

The result is returned as a numeric vector, because the standard R c function is being used to concatenate all the results. Since the exp function returns numeric values, concatenating them with the c function will result in a numeric vector of length three.

What if the R expression returns a vector, and we want to combine those vectors into a matrix? One way to do that is with the cbind function:

x <- foreach(i=1:4, .combine='cbind') %do% rnorm(4)
x
##       result.1  result.2     result.3   result.4
## [1,] -1.092978 0.6295170  1.833871978  2.0404157
## [2,] -1.240119 1.2464664 -0.009688854  0.6820452
## [3,]  2.462393 0.2607038 -0.610613021 -0.6065908
## [4,] -1.115345 0.3595195  0.178409580  0.8715811

This generates four vectors of four random numbers, and combines them by column to produce a 4 by 4 matrix.

We can also use the "+" or "*" functions to combine our results:

x <- foreach(i=1:4, .combine='+') %do% rnorm(4)
x
## [1]  1.7216779 -1.6464609 -2.1349854 -0.3416262

You can also specify a user-written function to combine the results. Here’s an example that throws away the results:

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

Note that this cfun function takes two arguments. The foreach function knows that the functions c, cbind, and rbind take many arguments, and will call them with up to 100 arguments (by default) in order to improve performance. But if any other function is specified (such as "+"), it assumes that it only takes two arguments. If the function does allow many arguments, you can specify that using the .multicombine argument:

cfun <- function(...) NULL
x <- foreach(i=1:4, .combine='cfun', .multicombine=TRUE) %do% rnorm(4)
x
## NULL

If you want the combine function to be called with no more than 10 arguments, you can specify that using the .maxcombine option:

cfun <- function(...) NULL
x <- foreach(i=1:4, .combine='cfun', .multicombine=TRUE, .maxcombine=10) %do% rnorm(4)
x
## NULL

The .inorder option is used to specify whether the order in which the arguments are combined is important. The default value is TRUE, but if the combine function is "+", you could specify .inorder to be FALSE. Actually, this option is important only when executing the R expression in parallel, since results are always computed in order when running sequentially. This is not necessarily true when executing in parallel, however. In fact, if the expressions take very different lengths of time to execute, the results could be returned in any order. Here’s a contrived example, that executes the tasks in parallel to demonstrate the difference. The example uses the Sys.sleep function to cause the earlier tasks to take longer to execute:

foreach(i=4:1, .combine='c') %dopar% {
  Sys.sleep(3 * i)
  i
}
## Warning: executing %dopar% sequentially: no parallel backend registered
## [1] 4 3 2 1
foreach(i=4:1, .combine='c', .inorder=FALSE) %dopar% {
  Sys.sleep(3 * i)
  i
}
## [1] 4 3 2 1

The results of the first of these two examples is guaranteed to be the vector c(4, 3, 2, 1). The second example will return the same values, but they will probably be in a different order.

Iterators

The values for the iteration variables don’t have to be specified with only vectors or lists. They can be specified with an iterator, many of which come with the iterators package. An iterator is an abstract source of data. A vector isn’t itself an iterator, but the foreach function automatically creates an iterator from a vector, list, matrix, or data frame, for example. You can also create an iterator from a file or a data base query, which are natural sources of data. The iterators package supplies a function called irnorm which can return a specified number of random numbers for each time it is called. For example:

library(iterators)
x <- foreach(a=irnorm(4, count=4), .combine='cbind') %do% a
x
##        result.1   result.2   result.3   result.4
## [1,] -1.5350510  1.7874584  0.4996798 -0.1752564
## [2,] -0.7261872 -0.8157457  0.3745338  0.4990661
## [3,] -2.0773878  0.6599377 -0.6587684 -1.6518373
## [4,] -0.2685922 -0.1270722 -0.8608408  2.9782248

This becomes useful when dealing with large amounts of data. Iterators allow the data to be generated on-the-fly, as it is needed by your operations, rather than requiring all of the data to be generated at the beginning.

For example, let’s say that we want to sum together a thousand random vectors:

set.seed(123)
x <- foreach(a=irnorm(4, count=1000), .combine='+') %do% a
x
## [1]   9.097676 -13.106472  14.076261  19.252750

This uses very little memory, since it is equivalent to the following while loop:

set.seed(123)
x <- numeric(4)
i <- 0
while (i < 1000) {
  x <- x + rnorm(4)
  i <- i + 1
}
x
## [1]   9.097676 -13.106472  14.076261  19.252750

This could have been done using the icount function, which generates the values from one to 1000:

set.seed(123)
x <- foreach(icount(1000), .combine='+') %do% rnorm(4)
x
## [1]   9.097676 -13.106472  14.076261  19.252750

but sometimes it’s preferable to generate the actual data with the iterator (as we’ll see later when we execute in parallel).

In addition to introducing the icount function from the iterators package, the last example also used an unnamed argument to the foreach function. This can be useful when we’re not intending to generate variable values, but only controlling the number of times that the R expression is executed.

There’s a lot more that I could say about iterators, but for now, let’s move on to parallel execution.

Parallel Execution

Although foreach can be a useful construct in its own right, the real point of the foreach package is to do parallel computing. To make any of the previous examples run in parallel, all you have to do is to replace %do% with %dopar%. But for the kinds of quick running operations that we’ve been doing, there wouldn’t be much point to executing them in parallel. Running many tiny tasks in parallel will usually take more time to execute than running them sequentially, and if it already runs fast, there’s no motivation to make it run faster anyway. But if the operation that we’re executing in parallel takes a minute or longer, there starts to be some motivation.

Parallel Random Forest

Let’s take random forest as an example of an operation that can take a while to execute. Let’s say our inputs are the matrix x, and the factor y:

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

We’ve already loaded the foreach package, but we’ll also need to load the randomForest package:

library(randomForest)
## randomForest 4.6-14
## Type rfNews() to see new features/changes/bug fixes.

If we want want to create a random forest model with a 1000 trees, and our computer has four cores in it, we can split up the problem into four pieces by executing the randomForest function four times, with the ntree argument set to 250. Of course, we have to combine the resulting randomForest objects, but the randomForest package comes with a function called combine that does just that.

Let’s do that, but first, we’ll do the work sequentially:

rf <- foreach(ntree=rep(250, 4), .combine=combine) %do%
  randomForest(x, y, ntree=ntree)
rf
## 
## Call:
##  randomForest(x = x, y = y, ntree = ntree) 
##                Type of random forest: classification
##                      Number of trees: 1000
## No. of variables tried at each split: 2

To run this in parallel, we need to change \%do\%, but we also need to use another foreach option called .packages to tell the foreach package that the R expression needs to have the randomForest package loaded in order to execute successfully. Here’s the parallel version:

rf <- foreach(ntree=rep(250, 4), .combine=combine, .packages='randomForest') %dopar%
  randomForest(x, y, ntree=ntree)
rf
## 
## Call:
##  randomForest(x = x, y = y, ntree = ntree) 
##                Type of random forest: classification
##                      Number of trees: 1000
## No. of variables tried at each split: 2

If you’ve done any parallel computing, particularly on a cluster, you may wonder why I didn’t have to do anything special to handle x and y. The reason is that the dopar function noticed that those variables were referenced, and that they were defined in the current environment. In that case %dopar% will automatically export them to the parallel execution workers once, and use them for all of the expression evaluations for that foreach execution. That is true for functions that are defined in the current environment as well, but in this case, the function is defined in a package, so we had to specify the package to load with the .packages option instead.

Parallel Apply

Now let’s take a look at how to make a parallel version of the standard R apply function. The apply function is written in R, and although it’s only about 100 lines of code, it’s a bit difficult to understand on a first reading. However, it all really comes down two for loops, the slightly more complicated of which looks like:

applyKernel <- function(newX, FUN, d2, d.call, dn.call=NULL, ...) {
  ans <- vector("list", d2)
  for(i in 1:d2) {
    tmp <- FUN(array(newX[,i], d.call, dn.call), ...)
    if(!is.null(tmp)) ans[[i]] <- tmp
  }
  ans
}
applyKernel(matrix(1:16, 4), mean, 4, 4)
## [[1]]
## [1] 2.5
## 
## [[2]]
## [1] 6.5
## 
## [[3]]
## [1] 10.5
## 
## [[4]]
## [1] 14.5

I’ve turned this into a function, because otherwise, R will complain that I’m using ... in an invalid context.

This could be executed using foreach as follows:

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)
## [[1]]
## [1] 2.5
## 
## [[2]]
## [1] 6.5
## 
## [[3]]
## [1] 10.5
## 
## [[4]]
## [1] 14.5

But this approach will cause the entire newX array to be sent to each of the parallel execution workers. Since each task needs only one column of the array, we’d like to avoid this extra data communication.

One way to solve this problem is to use an iterator that iterates over the matrix by column:

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)
## [[1]]
## [1] 2.5
## 
## [[2]]
## [1] 6.5
## 
## [[3]]
## [1] 10.5
## 
## [[4]]
## [1] 14.5

Now we’re only sending any given column of the matrix to one parallel execution worker. But it would be even more efficient if we sent the matrix in bigger chunks. To do that, we use a function called iblkcol that returns an iterator that will return multiple columns of the original matrix. That means that the R expression will need to execute the user’s function once for every column in its submatrix.

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)
## [[1]]
## [1] 2.5
## 
## [[2]]
## [1] 6.5
## 
## [[3]]
## [1] 10.5
## 
## [[4]]
## [1] 14.5

Note the use of the %do% inside the %dopar% to call the function on the columns of the submatrix x. Now that we’re using %do% again, it makes sense for the iterator to be an index into the matrix x, since %do% doesn’t need to copy x the way that %dopar% does.

List Comprehensions

If you’re familiar with the Python programming language, it may have occurred to you that the foreach package provides something that is not too different from Python’s list comprehensions. In fact, the foreach package also includes a function called when which can prevent some of the evaluations from happening, very much like the “if” clause in Python’s list comprehensions. For example, you could filter out negative values of an iterator using when as follows:

x <- foreach(a=irnorm(1, count=10), .combine='c') %:% when(a >= 0) %do% sqrt(a)
x
## [1] 0.4055020 1.0835713 0.8704032 0.3653185 1.4166866 0.8115083

I won’t say much on this topic, but I can’t help showing how foreach with when can be used to write a simple quick sort function, in the classic Haskell fashion:

qsort <- function(x) {
  n <- length(x)
  if (n == 0) {
    x
  } else {
    p <- sample(n, 1)
    smaller <- foreach(y=x[-p], .combine=c) %:% when(y <= x[p]) %do% y
    larger  <- foreach(y=x[-p], .combine=c) %:% when(y >  x[p]) %do% y
    c(qsort(smaller), x[p], qsort(larger))
  }
}

qsort(runif(12))
##  [1] 0.05671936 0.05986948 0.19082846 0.22652967 0.54588779 0.62601549
##  [7] 0.66316703 0.68171436 0.74671367 0.80146286 0.80993460 0.82453758

Not that I recommend this over the standard R sort function. But it’s a pretty interesting example use of foreach.

Conclusion

Much of parallel computing comes to doing three things: splitting the problem into pieces, executing the pieces in parallel, and combining the results back together. Using the foreach package, the iterators help you to split the problem into pieces, the %dopar% function executes the pieces in parallel, and the specified .combine function puts the results back together. We’ve demonstrated how simple things can be done in parallel quite easily using the foreach package, and given some ideas about how more complex problems can be solved. But it’s a fairly new package, and we will continue to work on ways of making it a more powerful system for doing parallel computing.