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