1library(foreach)
2
3n <- 10
4nrows <- 5
5ncols <- 5
6
7# vector example
8set.seed(17)
9x <- numeric(n)
10for (i in seq(along=x))
11  x[i] <- rnorm(1)
12
13set.seed(17)
14y <- foreach(icount(n), .combine='c') %do%
15  rnorm(1)
16
17cat('results of vector example:\n')
18print(identical(x, y))
19
20# list example
21set.seed(17)
22x <- vector('list', length=n)
23for (i in seq(length=n))
24  x[i] <- list(rnorm(10))
25
26set.seed(17)
27y <- foreach(icount(n)) %do%
28  rnorm(10)
29
30cat('results of list example:\n')
31print(identical(x, y))
32
33# matrix example
34set.seed(17)
35cols <- vector('list', length=ncols)
36for (i in seq(along=cols))
37  cols[i] <- list(rnorm(nrows))
38x <- do.call('cbind', cols)
39
40set.seed(17)
41y <- foreach(icount(ncols), .combine='cbind') %do%
42  rnorm(nrows)
43
44cat('results of matrix example:\n')
45dimnames(y) <- NULL
46print(identical(x, y))
47
48# another matrix example
49set.seed(17)
50cols <- vector('list', length=ncols)
51for (i in seq(along=cols)) {
52  r <- numeric(nrows)
53  for (j in seq(along=r))
54    r[j] <- rnorm(1)
55  cols[i] <- list(r)
56}
57x <- do.call('cbind', cols)
58
59set.seed(17)
60y <- foreach(icount(ncols), .combine='cbind') %:%
61  foreach(icount(nrows), .combine='c') %do%
62    rnorm(1)
63
64cat('results of another matrix example:\n')
65dimnames(y) <- NULL
66print(identical(x, y))
67
68# ragged matrix example
69set.seed(17)
70x <- vector('list', length=ncols)
71for (i in seq(along=x))
72  x[i] <- list(rnorm(i))
73
74set.seed(17)
75y <- foreach(i=icount(ncols)) %do%
76  rnorm(i)
77
78cat('results of ragged matrix example:\n')
79print(identical(x, y))
80
81# another ragged matrix example
82set.seed(17)
83x <- vector('list', length=ncols)
84for (i in seq(along=x)) {
85  r <- numeric(i)
86  for (j in seq(along=r))
87    r[j] <- rnorm(1)
88  x[i] <- list(r)
89}
90
91set.seed(17)
92y <- foreach(i=icount(ncols)) %:%
93  foreach(icount(i), .combine='c') %do%
94    rnorm(1)
95
96cat('results of another ragged matrix example:\n')
97print(identical(x, y))
98
99# filtering example
100set.seed(17)
101a <- rnorm(10)
102
103# C-style approach
104x <- numeric(length(a))
105n <- 0
106for (i in a) {
107  if (i > 0) {
108    n <- n + 1
109    x[n] <- i
110  }
111}
112length(x) <- n
113
114# Vector approach
115y <- a[a > 0]
116
117# foreach approach
118z <- foreach(i=a, .combine='c') %:% when(i > 0) %do% i
119
120cat('results of filtering example:\n')
121print(identical(x, y))
122print(identical(x, z))
123
124# Define a function that creates an iterator that returns chunks of a vecto
125ivector <- function(x, chunksize) {
126  n <- length(x)
127  i <- 1
128
129  nextEl <- function() {
130    if (n <= 0) stop('StopIteration')
131    chunks <- ceiling(n / chunksize)
132    m <- ceiling(n / chunks)
133    r <- seq(i, length=m)
134    i <<- i + m
135    n <<- n - m
136    x[r]
137  }
138
139  obj <- list(nextElem=nextEl)
140  class(obj) <- c('abstractiter', 'iter')
141  obj
142}
143
144# another filtering example
145set.seed(17)
146a <- rnorm(10000)
147
148# Vector approach
149x <- a[a > 0]
150
151# foreach with vectorization, limiting vector lengths to 1000
152y <- foreach(a=ivector(a, 1000), .combine='c') %do%
153  a[a > 0]
154
155cat('results of another filtering example:\n')
156print(identical(x, y))
157