itertools/0000755000176200001440000000000012307715041012276 5ustar liggesusersitertools/inst/0000755000176200001440000000000012303743706013260 5ustar liggesusersitertools/inst/examples/0000755000176200001440000000000012303743706015076 5ustar liggesusersitertools/inst/examples/range.R0000644000176200001440000000103612142544526016315 0ustar liggesuserslibrary(itertools) library(foreach) library(abind) a <- array(rnorm(60), c(5,4,3)) expected <- apply(a, c(2,3), range) acomb <- function(...) abind(..., along=3) actual <- foreach(ia=iarray(a, c(2,3)), .combine='acomb', .multicombine=TRUE) %:% foreach(x=ia, .combine='cbind') %do% range(x) dimnames(actual) <- NULL print(identical(actual, expected)) actual <- foreach(x=iarray(a, 3, chunks=2), .combine='acomb', .multicombine=TRUE) %do% apply(x, c(2,3), range) dimnames(actual) <- NULL print(identical(actual, expected)) itertools/inst/examples/timeoutExample.R0000644000176200001440000000216511323213374020221 0ustar liggesusers# Here is yet another silly example that computes pi. # It demonstrates the use of the "timeout" function to limit # the length of time to compute the estimate. It is also # yet another demonstration of using vector operations within # a foreach loop. library(itertools) library(foreach) # Initialize variables n <- 1000000 # length of vectors t <- 60 # seconds to compute # Create iterators of random numbers uniformly distributed over [-0.5, 0.5] xit <- irunif(n=n, min=-0.5, max=0.5) yit <- irunif(n=n, min=-0.5, max=0.5) # Create a timeout iterator that just happens to return zeros timer <- timeout(irepeat(0), time=t) # Define a ".final" function that calculates pi from estimates of pi/4 calc.pi <- function(x) { cat(sprintf('computed %d estimates of pi/4\n', length(x))) 4 * mean(x) } # foreach iterates over "timer" even though it is not named. # It's not named because it is needed to break out of the # loop, not for its value. pi <- foreach(x=xit, y=yit, timer, .combine='c', .final=calc.pi) %do% { sum(sqrt(x*x + y*y) < 0.5) / n } cat(sprintf('Approximate value of pi after about %d seconds: %f\n', t, pi)) itertools/inst/examples/blockMM.R0000644000176200001440000000337412142544526016554 0ustar liggesuserslibrary(foreach) library(itertools) n <- 10777 nrowsx <- 959 ncolsy <- 101 chunks <- 80 # applied to "n" xchunks <- 1 # applied to "nrowsx" ychunks <- 1 # applied to "ncolsy" x <- matrix(rnorm(nrowsx * n), nrow=nrowsx) y <- matrix(rnorm(n * ncolsy), nrow=n) expected <- x %*% y actual <- foreach(ia=iarray(x, c(2,1), chunks=c(chunks,xchunks)), .combine='rbind') %:% foreach(a=ia, ib=iarray(y, c(2,1), chunks=c(ychunks,chunks)), .combine='+') %:% foreach(b=ib, .combine='cbind') %do% { a %*% b } all.equal(actual, expected) actual <- foreach(ib=iarray(y, c(1,2), chunks=c(chunks,ychunks)), .combine='cbind') %:% foreach(b=ib, ia=iarray(x, c(1,2), chunks=c(xchunks,chunks)), .combine='+') %:% foreach(a=ia, .combine='rbind') %do% { a %*% b } all.equal(actual, expected) actual <- foreach(bsub=iarray(y, 2, chunks=ychunks), .combine='cbind') %:% foreach(ia=iarray(x, c(2,1), chunks=c(chunks,xchunks)), .combine='rbind') %:% foreach(a=ia, b=iarray(bsub, 1, chunks=chunks), .combine='+') %do% { a %*% b } all.equal(actual, expected) iqseq <- function(n, ...) { i <- 0 it <- idiv(n, ...) nextEl <- function() { j <- i + nextElem(it) val <- call(':', i + 1, j) i <<- j val } obj <- list(nextElem=nextEl) class(obj) <- c('abstractiter', 'iter') obj } actual <- foreach(bcols=iqseq(ncol(y), chunks=ychunks), .combine='cbind') %:% foreach(ia=iarray(x, c(2,1), chunks=c(chunks,xchunks)), .combine='rbind') %:% foreach(a=ia, b=iarray(y, 1, chunks=chunks, idx=list(TRUE, bcols)), .combine='+') %do% { a %*% b } all.equal(actual, expected) itertools/inst/examples/productExample.R0000644000176200001440000000045311316464677020231 0ustar liggesuserslibrary(itertools) library(foreach) it <- product(a=LETTERS[1:10], b=1, x=1:3) success <- foreach(a=LETTERS[1:10], .combine='c', .final=all) %:% foreach(b=1, .combine='c') %:% foreach(x=1:3, actual=it, .combine='c') %do% identical(list(a=a, b=b, x=x), actual) print(success) itertools/inst/examples/iarrayExample2.R0000644000176200001440000000120012143022023020057 0ustar liggesuserslibrary(itertools) display <- function(it, level=0) { it <- ihasNext(it) i <- 0 while(hasNext(it)) { if (i > 0) cat(', ') y <- nextElem(it) if (inherits(y, 'iter')) { cat('{') display(y, level=level+1) cat('}') } else { if (length(y) > 1) cat(sprintf('[%s]', paste(y, collapse=', '))) else cat(sprintf('%s', y)) } i <- i + 1 } if (level == 0) cat('\n') } x <- array(seq_len(2*3*2), c(2,3,2)) display(iarray(x, c(1,2,3))) display(iarray(x, c(3,2,1))) display(iarray(x, c(2,3))) display(iarray(x, c(3,2))) display(iarray(x[,,1], 2)) display(iarray(x[,,2], 1)) itertools/inst/examples/isplitIndicesExample.R0000644000176200001440000000171211321173035021330 0ustar liggesusers# This example takes the sum of the square roots of the numbers from # one to a billion. Note that this can't be done with the expression: # # sum(sqrt(1:1000000000)) # # since that attempts to allocate a 3.7 Gb vector, which generates # an error in versions of R including 2.10.1. library(itertools) library(foreach) # Size of input vector n <- 1000000000 # The best value for chunkSize depends on how much memory you have. # Generally, if chunkSize is too small, the code becomes inefficient. # If chunkSize is too big, you either run out of memory or suffer from # virtual memory thrashing. I think that a value of 5 million should # avoid memory thrashing on most modern computers without being too # inefficient, but if you have 2 Gigabytes of memory or more, you # might want to increase this value. chunkSize <- 5000000 r <- foreach(x=isplitIndices(n, chunkSize=chunkSize), .combine='sum') %do% { sqrt(x) } cat(sprintf('sum(sqrt(1:%d)) = %e\n', n, r)) itertools/inst/examples/ihasNextExample.R0000644000176200001440000000023311316464677020330 0ustar liggesuserslibrary(itertools) n <- 100 it <- ihasNext(icount(n)) total <- 0 while (hasNext(it)) total <- total + nextElem(it) print(total == sum(seq(length=n))) itertools/inst/examples/ireadBinExample.R0000644000176200001440000000064411321501044020240 0ustar liggesusers# This is a terrible example and desperately needs to be replaced # with something that appears somewhat useful. library(itertools) library(foreach) n <- 1000 zz <- file("testbin", "wb") expected <- foreach(1:1000) %do% { x <- rnorm(n) writeBin(x, zz) mean(x) } close(zz) it <- ireadBin("testbin", "double", n=n) actual <- foreach(x=it) %do% { mean(x) } print(identical(actual, expected)) unlink("testbin") itertools/inst/examples/iarrayExample.R0000644000176200001440000000045012142544526020023 0ustar liggesuserslibrary(itertools) library(foreach) n <- 10 x <- matrix(rnorm(n * n), n) # Split matrix x into four submatrices and put them back # together again y <- foreach(a=iarray(x, c(1,2), chunks=2), .combine='cbind') %:% foreach(b=a, .combine='rbind') %do% { b } print(identical(x, y)) itertools/inst/examples/ireaddfExample.R0000644000176200001440000000611212132155132020121 0ustar liggesuserslibrary(itertools) # Write a data frame to disk, using one file per column. # The optional fprefix argument is used to partially # specify the name of these files. writedf <- function(df, fprefix=as.character(substitute(df))) { # Handle fprefix argument if (! is.character(fprefix)) stop('fprefix must be character') if (length(fprefix) == 1) fprefix <- sprintf('%s_%02d', fprefix, seq_along(df)) # Write each column of "df" to a file for (icol in seq_along(df)) { p <- fprefix[icol] cls <- class(df[[icol]])[1] type <- if (cls == 'numeric') 'double' else cls if (type == 'factor') { writeBin(as.integer(df[[icol]]), sprintf('%s_factor.col', p)) writeLines(levels(df[[icol]]), sprintf('%s_factor.lev', p)) } else if (type == 'character') { writeLines(df[[icol]], sprintf('%s_character.col', p)) } else if (type == 'integer') { writeBin(df[[icol]], sprintf('%s_integer.col', p)) } else if (type == 'double') { writeBin(df[[icol]], sprintf('%s_double.col', p)) } else { stop('unsupported type: ', type) } } } # Read a data frame from files containing column data. # The arguments "n", "start", and "col.names" can be used # to read part of the data frame. # # Although you must specify a value for "n", you can # specify a value that is larger than the number of elements # in the files. This will allocate too much memory, so # try not to overestimate by too much. readdf <- function(filenames, n, start=1, col.names) { it <- ireaddf(filenames, n, start, col.names, chunkSize=n) df <- nextElem(it) tryCatch(nextElem(it), error=function(e) invisible()) df } testreaddf <- function(n=1000, s=c(1, 8, 9, 12)) { filenames <- Sys.glob('fifty1_*.col') col.names <- c('AOU', 'RouteDataID', 'countrynum', 'statenum', 'Route', 'RPID', 'year', 'rteNo', 'species', 'stopNo', 'count', 'rtestopNo') readdf(filenames[s], n, col.names=col.names[s]) } testireaddf <- function(n=200000000, chunkSize=1000000) { library(foreach) filenames <- Sys.glob('fifty1_*.col') col.names <- c('AOU', 'RouteDataID', 'countrynum', 'statenum', 'Route', 'RPID', 'year', 'rteNo', 'species', 'stopNo', 'count', 'rtestopNo') nfilenames <- sub('fifty1', 'mod', filenames, fixed=TRUE) print(nfilenames) cobj <- writedf.combiner(nfilenames) # Copy the sub-data frames from one set of files to another cat('Starting to read "fifty1" data files...\n') foreach(df=ireaddf(filenames, n, col.names=col.names, chunkSize=chunkSize), .combine=cobj$combine, .maxcombine=3) %do% { df } cobj$close() # Check that the two sets of files contain identical data frames cat('Compare the two sets of data files...\n') r <- foreach(df1=ireaddf(filenames, n, col.names=col.names, chunkSize=chunkSize), df2=ireaddf(nfilenames, n, col.names=col.names, chunkSize=chunkSize), .combine='all', .maxcombine=50) %do% { identical(df1, df2) } print(r) cat('Finished\n') } itertools/NAMESPACE0000644000176200001440000000074512205462111013515 0ustar liggesusersexport(product, ihasNext, ilimit, izip, enumerate, chain, ifilter, ifilterfalse, irepeat, recycle, ichunk, timeout, ireadBin, irep, isplitVector, isplitRows, isplitCols, isplitIndices, irecord, ireplay, iRNGStream, iRNGSubStream, ireaddf, writedf.combiner, iarray, ibreak, end_iteration, iteration_has_ended, new_iterator, is.iterator) export(hasNext) S3method("hasNext", "ihasNext") S3method("iter", "connection") import(iterators) import(parallel) itertools/NEWS0000644000176200001440000000213012303736515012776 0ustar liggesusersNEWS/ChangeLog for itertools ---------------------------- 0.1-3 2014-2-27 o added "mode" argument to ichunk function o added iRNGStream and iRNGSubStream functions which could be useful for parallel random number generation. o added ireaddf function for reading data frames from files o added writedf.combiner function for writing data frames to files o added iarray function for creating iterators over arrays o add ibreak function for creating iterators that can be stopped 0.1-2 2012-6-20 o added irecord and ireplay functions for recording and replaying iterables o added iter.connection method 0.1-1 2010-1-14 o added ichunk function to aid in manual chunking o added utility functions written by Hadley Wickham o added "isplit" functions for iterating over data structures o added timeout function for creating iterator timeouts o added ireadBin function for iterating over binary connections o made irep much more like the rep function, and added new irepeat to be like the old irep function 0.1 2009-12-29 o project created on r-forge itertools/R/0000755000176200001440000000000012303743706012504 5ustar liggesusersitertools/R/isplitVector.R0000644000176200001440000000177211321173035015314 0ustar liggesusers# # Copyright (c) 2010, Stephen B. Weston # # This 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. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 # USA isplitVector <- function(x, ...) { it <- idiv(length(x), ...) i <- 1L nextEl <- function() { n <- as.integer(nextElem(it)) j <- i i <<- i + n x[seq(j, length=n)] } object <- list(nextElem=nextEl) class(object) <- c('abstractiter', 'iter') object } itertools/R/recycle.R0000644000176200001440000000773011323263104014252 0ustar liggesusers# # Copyright (c) 2009-2010, Stephen B. Weston # # This 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. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 # USA recycle <- function(iterable, times=NA_integer_) { # Manually check for a missing argument since "inherits" issues # a cryptic error message in that case if (missing(iterable)) { stop('argument "iterable" is missing, with no default') } if (!is.numeric(times) || length(times) != 1 || (!is.na(times) && times < 0)) { stop('argument "times" must be a non-negative numeric value') } times <- as.integer(times) if (is.na(times) || times > 1) { if (! inherits(iterable, 'iter')) { buffer <- iterable buffer.iter <- iter(buffer) } else { iterable.iter <- iter(iterable) bsize <- 256 # allocated size of buffer bsize.max <- 2 ^ 31 - 1 # maximum allowable allocated size of buffer buffer <- vector('list', length=bsize) blen <- 0 # number of values currently in buffer buffer.iter <- NULL # will become an iterator over buffer } } else if (times > 0) { iterable.iter <- iter(iterable) } # This is used until the underlying iterator runs out nextEl.buffering <- function() { tryCatch({ # Check if buffer is full if (blen >= bsize) { # Don't attempt to create a list with more than 2^31-1 elements if (blen == bsize.max) { stop('underlying iterator has too many values to buffer') } # Double the size of buffer bsize <<- min(2 * bsize, bsize.max) length(buffer) <<- bsize } e <- nextElem(iterable.iter) blen <<- blen + 1 buffer[blen] <<- list(e) e }, error=function(e) { if (identical(conditionMessage(e), 'StopIteration')) { times <<- times - 1L # will still be greater than zero length(buffer) <<- blen iterable <<- NULL iterable.iter <<- NULL buffer.iter <<- iter(buffer) nextEl.pointer <<- nextEl.cycling nextEl() } else { stop(e) } }) } # This will be used once we've run through the underlying iterator nextEl.cycling <- function() { tryCatch({ nextElem(buffer.iter) }, error=function(e) { if (identical(conditionMessage(e), 'StopIteration')) { if (!is.na(times) && times <= 1) { times <<- 0L stop(e) } times <<- times - 1L buffer.iter <<- iter(buffer) # If this throws 'StopIteration', we're done nextElem(buffer.iter) } else { stop(e) } }) } # This handles the case when "times" is one (pretty useless case) nextEl.one <- function() { nextElem(iterable.iter) } # This handles the case when "times" is zero nextEl.zero <- function() { stop('StopIteration', call.=FALSE) } # Set the initial value of nextEl.pointer if (is.na(times) || times > 1) { nextEl.pointer <- if (is.null(buffer.iter)) nextEl.buffering else nextEl.cycling } else if (times == 1) { nextEl.pointer <- nextEl.one } else { nextEl.pointer <- nextEl.zero } # This is the function that will be stored in the iterator object, # which will call either nextEl.buffering of nextEl.cycling, depending # on the value of nextEl.pointer variable nextEl <- function() { nextEl.pointer() } obj <- list(nextElem=nextEl) class(obj) <- c('abstractiter', 'iter') obj } itertools/R/enumerate.R0000644000176200001440000000151411321173474014613 0ustar liggesusers# # Copyright (c) 2009-2010, Stephen B. Weston # # This 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. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 # USA enumerate <- function(iterable) { it <- iter(iterable) e <- icount() izip(index=e, value=it) } itertools/R/ilimit.R0000644000176200001440000000201011321173474014105 0ustar liggesusers# # Copyright (c) 2009-2010, Stephen B. Weston # # This 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. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 # USA ilimit <- function(iterable, n) { it <- iter(iterable) n <- as.integer(n) nextEl <- function() { if (n <= 0) { stop('StopIteration', call.=FALSE) } n <<- n - 1L nextElem(it) } obj <- list(nextElem=nextEl) class(obj) <- c('abstractiter', 'iter') obj } itertools/R/hasNext.R0000644000176200001440000000144011321173474014236 0ustar liggesusers# # Copyright (c) 2009-2010, Stephen B. Weston # # This 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. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 # USA hasNext <- function(obj, ...) { UseMethod('hasNext') } itertools/R/isplitCols.R0000644000176200001440000000200411321173035014737 0ustar liggesusers# # Copyright (c) 2010, Stephen B. Weston # # This 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. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 # USA isplitCols <- function(x, ...) { it <- idiv(ncol(x), ...) i <- 1L nextEl <- function() { n <- as.integer(nextElem(it)) j <- i i <<- i + n x[, seq(j, length=n), drop=FALSE] } object <- list(nextElem=nextEl) class(object) <- c('abstractiter', 'iter') object } itertools/R/iarray.R0000644000176200001440000000524012143022111014075 0ustar liggesusersiarray <- function(X, MARGIN, ..., chunks, chunkSize, drop, idx=lapply(dim(X), function(i) TRUE)) { dimx <- dim(X) # Verify that X has the dim attribute set and length > 0 if (length(dimx) == 0) stop('dim(X) must have a positive length') # Check for unknown arguments if (length(list(...)) > 0) { nms <- names(list(...)) if (is.null(nms) || '' %in% nms) stop('arguments other than X and MARGIN must be named') else stop('unused argument(s) ', paste(nms, collapse=', ')) } # Don't allow both chunks and chunkSize if (! missing(chunks) && ! missing(chunkSize)) stop('chunks and chunkSize cannot both be specified') # Get the number of value this iterator will return i <- 0 mlen <- length(MARGIN) n <- dimx[MARGIN[mlen]] # Create an iterator based on chunking if (! missing(chunks)) { if (length(chunks) != 1 && length(chunks) != mlen) stop('length of chunks must be 1 or the same as MARGIN') if (missing(drop)) drop <- FALSE if (length(chunks) == 1) chunks <- rep(chunks, mlen) it <- idiv(n, chunks=chunks[mlen]) } else if (! missing(chunkSize)) { if (length(chunkSize) != 1 && length(chunkSize) != mlen) stop('length of chunkSize must be 1 or the same as MARGIN') if (missing(drop)) drop <- FALSE if (length(chunkSize) == 1) chunkSize <- rep(chunkSize, mlen) it <- idiv(n, chunkSize=chunkSize[mlen]) } else { if (missing(drop)) drop <- TRUE it <- irep(1, times=n) } # Create a call object if this is the final dimension if (mlen == 1) { q <- as.call(c(list(as.name('['), as.name('X')), idx, list(drop=drop))) iq <- MARGIN + 2L } # Define the "nextElem" function nextEl <- if (mlen == 1) { function() { m <- nextElem(it) j <- i + m q[[iq]] <- if (m > 1) call(':', i + 1, j) else j i <<- j eval(q) } } else if (! missing(chunks)) { function() { m <- nextElem(it) j <- i + m idx[[MARGIN[mlen]]] <- if (m > 1) call(':', i + 1, j) else j i <<- j iarray(X, MARGIN[-mlen], chunks=chunks[-mlen], drop=drop, idx=idx) } } else if (! missing(chunkSize)) { function() { m <- nextElem(it) j <- i + m idx[[MARGIN[mlen]]] <- if (m > 1) call(':', i + 1, j) else j i <<- j iarray(X, MARGIN[-mlen], chunkSize=chunkSize[-mlen], drop=drop, idx=idx) } } else { function() { nextElem(it) # returns 1 or throws 'StopIteration' i <<- i + 1 idx[[MARGIN[mlen]]] <- i iarray(X, MARGIN[-mlen], drop=drop, idx=idx) } } obj <- list(nextElem=nextEl) class(obj) <- c('abstractiter', 'iter') obj } itertools/R/irep.R0000644000176200001440000000504011323264332013557 0ustar liggesusers# # Copyright (c) 2010, Stephen B. Weston # # This 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. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 # USA irep <- function(iterable, times, length.out, each) { # Apply "each" first it <- if (!missing(each)) { irep.each(iter(iterable), each) } else { iter(iterable) } if (!missing(length.out)) { # Ignore "times" if "length.out" is specified ilimit(recycle(it), length.out) } else if (!missing(times)) { if (length(times) == 1) { # If "times" has a single value, recycle that many times recycle(it, times) } else { # If "times" has multiple values, it's kind of like "each" irep.times(it, times) } } else { # Neither "length.out" or "times" was specified it } } # Internal function used to handle the irep "each" argument irep.each <- function(it, each) { each <- as.integer(each[1]) if (is.na(each)) { each <- 1L } else if (each < 0) { stop("invalid 'each' argument") } n <- 0L value <- NULL nextEl <- if (each == 0) { function() stop('StopIteration', call.=FALSE) } else if (each == 1) { function() nextElem(it) } else { function() { if (n <= 0) { value <<- nextElem(it) n <<- each } n <<- n - 1L value } } object <- list(nextElem=nextEl) class(object) <- c('abstractiter', 'iter') object } # Internal function used to handle the irep "times" argument irep.times <- function(it, times) { times <- as.integer(times) if (length(times) == 0 || any(is.na(times) | times < 0)) { stop("invalid 'times' argument") } i <- 0L n <- 0L value <- NULL nextEl <- function() { while (n <= 0 && i < length(times)) { i <<- i + 1L n <<- times[i] value <<- nextElem(it) } if (n <= 0) { stop('StopIteration', call.=FALSE) } n <<- n - 1L value } object <- list(nextElem=nextEl) class(object) <- c('abstractiter', 'iter') object } itertools/R/irecord.R0000644000176200001440000000317311770403446014263 0ustar liggesusers# # Copyright (c) 2012, Stephen B. Weston # # This 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. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 # USA irecord <- function(con, iterable) { if (is.character(con)) { con <- file(con, 'wb') on.exit(close(con)) } it <- iter(iterable) tryCatch({ repeat { serialize(nextElem(it), con) } }, error=function(e) { if (! identical(conditionMessage(e), 'StopIteration')) stop(e) }) invisible() } ireplay <- function(con) { # Remember if we had to open this connection opened <- if (is.character(con)) { con <- file(con, open='rb') TRUE } else { FALSE } nextEl <- function() { # Check if we've already stopped if (is.null(con)) { stop('StopIteration', call.=FALSE) } tryCatch({ unserialize(con) }, error=function(e) { if (opened) { close(con) } con <<- NULL stop('StopIteration', call.=FALSE) }) } object <- list(nextElem=nextEl) class(object) <- c('abstractiter', 'iter') object } itertools/R/izip.R0000644000176200001440000000207611321173474013605 0ustar liggesusers# # Copyright (c) 2009-2010, Stephen B. Weston # # This 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. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 # USA izip <- function(...) { iterators <- lapply(list(...), iter) if (length(iterators) == 0) { nextEl <- function() { stop('StopIteration', call.=FALSE) } } else { nextEl <- function() { lapply(iterators, nextElem) } } object <- list(nextElem=nextEl) class(object) <- c('abstractiter', 'iter') object } itertools/R/timeout.R0000644000176200001440000000210511321376203014304 0ustar liggesusers# # Copyright (c) 2010, Stephen B. Weston # # This 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. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 # USA timeout <- function(iterable, time) { force(time) it <- iter(iterable) starttime <- proc.time()[3] nextEl <- function() { delta <- proc.time()[3] - starttime if (delta >= time) { stop('StopIteration', call.=FALSE) } nextElem(it) } object <- list(nextElem=nextEl) class(object) <- c('abstractiter', 'iter') object } itertools/R/irepeat.R0000644000176200001440000000225211323213374014253 0ustar liggesusers# # Copyright (c) 2009-2010, Stephen B. Weston # # This 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. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 # USA irepeat <- function(x, times) { if (missing(times)) { nextEl <- function() { x } } else { times <- as.integer(times) if (is.na(times)) { stop('times must be a valid number') } nextEl <- function() { if (times <= 0) { stop('StopIteration', call.=FALSE) } times <<- times - 1L x } } object <- list(nextElem=nextEl) class(object) <- c('abstractiter', 'iter') object } itertools/R/ireaddf.R0000644000176200001440000000671112132155132014220 0ustar liggesusersireaddf <- function(filenames, n, start=1, col.names, chunkSize=1000) { opencol <- function(fname) { # Extract the type of data from the file name m <- regexpr('(factor|character|integer|double)', fname) if (m < 1) stop('illegal file name: ', fname) type <- substr(fname, m, attr(m, 'match.length') + m - 1L) if (type == 'factor') { conn <- file(fname, 'rb') if (start > 1) seek(conn, where=4 * (start - 1)) lfile <- sub('\\..+$', '.lev', fname) if (lfile == fname) lfile <- paste(fname, '.lev', sep='') lvls <- readLines(lfile) } else if (type == 'character') { conn <- file(fname, 'rt') if (start > 1) readLines(conn, n=start-1) lvls <- NULL } else if (type == 'integer') { conn <- file(fname, 'rb') if (start > 1) seek(conn, where=4 * (start - 1)) lvls <- NULL } else if (type == 'double') { conn <- file(fname, 'rb') if (start > 1) seek(conn, where=8 * (start - 1)) lvls <- NULL } else { stop('error: type = ', type) } list(type=type, conn=conn, lvls=lvls) } # Read the column data from the specified file readcol <- function(colinfo, n) { # Read the column data according to the data type if (colinfo$type == 'factor') { x <- readBin(colinfo$conn, what='integer', n=n) factor(colinfo$lvls[x], levels=colinfo$lvls) } else if (colinfo$type == 'character') { readLines(colinfo$conn, n=n) } else if (colinfo$type == 'integer') { readBin(colinfo$conn, what=colinfo$type, n=n) } else if (colinfo$type == 'double') { readBin(colinfo$conn, what=colinfo$type, n=n) } else { stop('internal error: type = ', colinfo$type) } } # Handle the col.names argument if (missing(col.names)) { col.names <- cnames(filenames) } else { if (any(duplicated(col.names))) stop('col.names must contain all unique names') if (length(col.names) != length(filenames)) stop('col.names must be the same length as filenames') } # Open the column data files and return column information # in a list of (type, conn, lvls) lists names(filenames) <- col.names columndata <- lapply(filenames, opencol) stopped <- FALSE # Define the "next element" function needed for every iterator nextEl <- function() { # First check if we've already stopped if (stopped) stop('StopIteration') # Next check if there are any more rows to read if (n == 0) { for (colinfo in columndata) close(colinfo$conn) stopped <<- TRUE stop('StopIteration') } # Read the columns from the files into a list of equal length vectors df <- lapply(columndata, readcol, n=min(chunkSize, n)) # Get the length of all columns xn <- sapply(df, length) mn <- min(xn) # Check if we ran out of date in at least one column data file if (mn == 0) { # Close all connections and throw a StopIteration for (colinfo in columndata) close(colinfo$conn) stopped <<- TRUE stop('StopIteration') } # Decrement n by the number of rows that we just read n <<- n - mn # Convert the list of vectors into a data frame if possible if (all(xn == mn)) { attr(df, 'row.names') <- .set_row_names(mn) class(df) <- 'data.frame' } df } # Construct and return the iterator object obj <- list(nextElem=nextEl) class(obj) <- c('abstractiter', 'iter') obj } itertools/R/ireadBin.R0000644000176200001440000000620411322746524014347 0ustar liggesusers# # Copyright (c) 2010, Stephen B. Weston # # This 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. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 # USA ireadBin <- function(con, what='raw', n=1L, size=NA_integer_, signed=TRUE, endian=.Platform$endian, ipos=NULL) { # Sanity check "n" if (!is.numeric(n) || length(n) != 1 || n < 1) { stop('n must be a numeric value >= 1') } # Remember if we had to open this connection opened <- if (is.character(con)) { con <- file(con, open='rb') TRUE } else { if (!isOpen(con, 'r') || summary(con)$text != 'binary') { stop('con must be opened for reading in binary mode') } FALSE } if (!is.null(ipos)) { if (!isSeekable(con)) { stop('ipos cannot be specified unless con is seekable') } ipos <- iter(ipos) } nextEl <- function() { # Check if we've already stopped if (is.null(con)) { stop('StopIteration', call.=FALSE) } # "local" arguments to readBin that may be modified by "ipos" lwhat <- what ln <- n lsize <- size lsigned <- signed lendian <- endian # Seek on the connection if a position iterator has been specified if (!is.null(ipos)) { tryCatch({ p <- nextElem(ipos) }, error=function(e) { # Close the connection if necessary and propagate the exception if (opened) { close(con) } con <<- NULL stop(e) }) # default value of "origin" origin <- 'start' if (is.list(p)) { # XXX should check for illegal element names in "p" # Don't do a "seek" unless a "where" value is specified if (!is.null(p$where)) { where <- p$where if (!is.null(p$origin)) origin <- p$origin seek(con, where=where, origin=origin, rw='read') } if (!is.null(p$what)) lwhat <- p$what if (!is.null(p$n)) ln <- p$n if (!is.null(p$size)) lsize <- p$size if (!is.null(p$signed)) lsigned <- p$signed if (!is.null(p$endian)) lendian <- p$endian } else { where <- p seek(con, where=where, origin=origin, rw='read') } } # Read the next "n" items d <- readBin(con, what=lwhat, n=ln, size=lsize, signed=lsigned, endian=lendian) # Check if we've hit EOF if (length(d) == 0) { # Close the connection if necessary if (opened) { close(con) } con <<- NULL stop('StopIteration', call.=FALSE) } d } it <- list(nextElem=nextEl) class(it) <- c('abstractiter', 'iter') it } itertools/R/iRNGStream.R0000644000176200001440000000257612132066606014611 0ustar liggesusersiRNGStream <- function(seed) { # Convert a single number into the appropriate vector for "L'Ecuyer-CMRG" if (length(seed) == 1) { seed <- convseed(seed) } # Error checking: this will throw an error right away if the seed is bad nextRNGStream(seed) # Define the "Next Element" function for the iterator nextEl <- function() (seed <<- nextRNGStream(seed)) obj <- list(nextElem=nextEl) class(obj) <- c('abstractiter', 'iter') obj } iRNGSubStream <- function(seed) { # Convert a single number into the appropriate vector for "L'Ecuyer-CMRG" if (length(seed) == 1) { seed <- convseed(seed) } # Error checking: this will throw an error right away if the seed is bad nextRNGSubStream(seed) # Define the "Next Element" function for the iterator nextEl <- function() (seed <<- nextRNGSubStream(seed)) obj <- list(nextElem=nextEl) class(obj) <- c('abstractiter', 'iter') obj } convseed <- function(iseed) { saveseed <- if (exists('.Random.seed', where=.GlobalEnv, inherits=FALSE)) get('.Random.seed', pos=.GlobalEnv, inherits=FALSE) saverng <- RNGkind("L'Ecuyer-CMRG") tryCatch({ set.seed(iseed) get('.Random.seed', pos=.GlobalEnv, inherits=FALSE) }, finally={ RNGkind(saverng[1], saverng[2]) if (is.null(saveseed)) rm('.Random.seed', pos=.GlobalEnv) else assign('.Random.seed', saveseed, pos=.GlobalEnv) }) } itertools/R/isplitRows.R0000644000176200001440000000200311321173035014770 0ustar liggesusers# # Copyright (c) 2010, Stephen B. Weston # # This 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. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 # USA isplitRows <- function(x, ...) { it <- idiv(nrow(x), ...) i <- 1L nextEl <- function() { n <- as.integer(nextElem(it)) j <- i i <<- i + n x[seq(j, length=n),, drop=FALSE] } object <- list(nextElem=nextEl) class(object) <- c('abstractiter', 'iter') object } itertools/R/ifilter.R0000644000176200001440000000243311321173474014265 0ustar liggesusers# # Copyright (c) 2009-2010, Stephen B. Weston # # This 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. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 # USA ifilter <- function(pred, iterable) { it <- iter(iterable) nextEl <- function() { repeat { val <- nextElem(it) if (pred(val)) { return(val) } } } object <- list(nextElem=nextEl) class(object) <- c('abstractiter', 'iter') object } ifilterfalse <- function(pred, iterable) { it <- iter(iterable) nextEl <- function() { repeat { val <- nextElem(it) if (! pred(val)) { return(val) } } } object <- list(nextElem=nextEl) class(object) <- c('abstractiter', 'iter') object } itertools/R/product.R0000644000176200001440000000405511321173474014311 0ustar liggesusers# # Copyright (c) 2009-2010, Stephen B. Weston # # This 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. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 # USA product <- function(...) { args <- substitute(list(...))[-1] n <- length(args) anames <- names(args) if (is.null(anames)) { anames <- rep('', n) } env <- parent.frame() product.internal(n, args, anames, env) } product.internal <- function(n, args, anames, env) { if (n <= 1) { if (n == 1) { icar <- iter(eval(args[[1]], envir=env)) nextEl <- function() { carval <- list(nextElem(icar)) names(carval) <- anames[1] carval } } else { nextEl <- function() { stop('StopIteration', call.=FALSE) } } } else { icdr <- product.internal(n - 1, args[-n], anames[-n], env) cdrval <- NULL needval <- TRUE icar <- NULL nextEl <- function() { repeat { if (needval) { cdrval <<- nextElem(icdr) needval <<- FALSE icar <<- iter(eval(args[[n]], envir=env)) } tryCatch({ carval <- list(nextElem(icar)) break }, error=function(e) { if (identical(conditionMessage(e), 'StopIteration')) { needval <<- TRUE } else { stop(e) } }) } names(carval) <- anames[n] c(cdrval, carval) } } object <- list(nextElem=nextEl) class(object) <- c('abstractiter', 'iter') object } itertools/R/isplitIndices.R0000644000176200001440000000176011321173035015425 0ustar liggesusers# # Copyright (c) 2010, Stephen B. Weston # # This 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. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 # USA isplitIndices <- function(n, ...) { it <- idiv(n, ...) i <- 1L nextEl <- function() { m <- as.integer(nextElem(it)) j <- i i <<- i + m seq(j, length=m) } object <- list(nextElem=nextEl) class(object) <- c('abstractiter', 'iter') object } itertools/R/chain.R0000644000176200001440000000240311321173474013706 0ustar liggesusers# # Copyright (c) 2009-2010, Stephen B. Weston # # This 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. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 # USA chain <- function(...) { iterators <- lapply(list(...), iter) nextEl <- function() { repeat { if (length(iterators) == 0) { stop('StopIteration', call.=FALSE) } tryCatch({ return(nextElem(iterators[[1]])) }, error=function(e) { if (identical(conditionMessage(e), 'StopIteration')) { iterators <<- iterators[-1] } else { stop(e) } }) } } object <- list(nextElem=nextEl) class(object) <- c('abstractiter', 'iter') object } itertools/R/util.R0000644000176200001440000000056011320724405013576 0ustar liggesusers# This code was contributed by Hadley Wickham end_iteration <- function() stop('StopIteration', call.=FALSE) iteration_has_ended <- function(e) { identical(conditionMessage(e), 'StopIteration') } new_iterator <- function(nextElem, ...) { structure(list(nextElem=nextElem, ...), class=c('abstractiter', 'iter')) } is.iterator <- function(x) inherits(x, 'iter') itertools/R/ibreak.R0000644000176200001440000000207112205462111014051 0ustar liggesusers# # Copyright (c) 2013, Stephen B. Weston # # This 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. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 # USA ibreak <- function(iterable, finished) { force(finished) it <- iter(iterable) stopped <- FALSE nextEl <- function() { if (stopped || finished()) { stopped <<- TRUE stop('StopIteration', call.=FALSE) } nextElem(it) } object <- list(nextElem=nextEl) class(object) <- c('abstractiter', 'iter') object } itertools/R/writedf.R0000644000176200001440000000656712132155132014277 0ustar liggesusers# Construct default column names from the specified file names cnames <- function(filenames) { m <- regexpr('^(.+)_', filenames) if (any(m < 1)) { paste('X', seq_along(filenames), sep='.') } else { nms <- substr(filenames, m, attr(m, 'match.length') + m - 2L) if (any(duplicated(nms))) paste('X', seq_along(filenames), sep='.') else nms } } # This is a writedf combiner factory function writedf.combiner <- function(filenames) { opencol <- function(i) { # Extract the type of data from the file name m <- regexpr('(factor|character|integer|double)', filenames[i]) if (m < 1) stop('illegal file name: ', filenames[i]) type <- substr(filenames[i], m, attr(m, 'match.length') + m - 1L) if (type == 'factor') { conn <- file(filenames[i], 'wb') lfile <- sub('\\..+$', '.lev', filenames[i]) if (lfile == filenames[i]) lfile <- paste(filenames[i], '.lev', sep='') } else if (type == 'character') { conn <- file(filenames[i], 'wt') lfile <- NULL } else if (type == 'integer') { conn <- file(filenames[i], 'wb') lfile <- NULL } else if (type == 'double') { conn <- file(filenames[i], 'wb') lfile <- NULL } else { stop('error: type = ', type) } list(type=type, conn=conn, lfile=lfile) } combine <- function(...) { # Write each column of "df" to a file dfs <- list(...) for (icol in seq_along(columndata)) { colinfo <- columndata[[icol]] if (colinfo$type == 'factor') { for (df in dfs) { if (! is.null(df)) { levsvar <- sprintf('levels.%d', icol) levs <- get(levsvar) if (is.null(levs)) { assign(levsvar, levels(df[[icol]]), inherits=TRUE) } else { if (any(levs != levels(df[[icol]]))) { # XXX should this be an error? # XXX should a try to fix the problem? warning('inconsistent levels found for column ', icol) } } writeBin(as.integer(df[[icol]]), colinfo$conn) } } } else if (colinfo$type == 'character') { for (df in dfs) { if (! is.null(df)) writeLines(df[[icol]], colinfo$conn) } } else if (colinfo$type == 'integer') { for (df in dfs) { if (! is.null(df)) writeBin(df[[icol]], colinfo$conn) } } else if (colinfo$type == 'double') { for (df in dfs) { if (! is.null(df)) writeBin(df[[icol]], colinfo$conn) } } else { stop('unsupported type: ', colinfo$type) } } NULL } closeallcolumns <- function() { # Close all column data files for (i in seq_along(columndata)) { colinfo <- columndata[[i]] close(colinfo$conn) if (! is.null(colinfo$lfile)) { levsvar <- sprintf('levels.%d', i) levs <- get(levsvar) if (is.null(levs)) { warning(sprintf('not writing levels file for column %d\n', i)) } else { writeLines(levs, colinfo$lfile) } } } } columndata <- lapply(seq_along(filenames), opencol) for (i in seq_along(filenames)) assign(sprintf('levels.%d', i), NULL) # Construct and return the combiner object obj <- list(combine=combine, close=closeallcolumns) class(obj) <- c('combiner') obj } itertools/R/ichunk.R0000644000176200001440000000360512130355044014104 0ustar liggesusers# # Copyright (c) 2009-2013, Stephen B. Weston # # This 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. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 # USA ichunk <- function(iterable, chunkSize, mode='list') { force(iterable) force(chunkSize) it <- iter(iterable) legal.modes <- c('list', 'logical', 'integer', 'numeric', 'double', 'complex', 'character', 'raw') if (! mode %in% legal.modes) stop(sprintf("cannot make a vector of mode '%s'", mode)) nextEl.list <- function() { r <- vector('list', chunkSize) i <- 0L tryCatch({ while (i < chunkSize) { r[i + 1L] <- list(nextElem(it)) i <- i + 1L } }, error=function(e) { if (!identical(conditionMessage(e), 'StopIteration') || i == 0L) stop(e) length(r) <<- i }) r } nextEl.vector <- function() { r <- vector(mode, chunkSize) i <- 0L tryCatch({ while (i < chunkSize) { r[i + 1L] <- nextElem(it) i <- i + 1L } }, error=function(e) { if (!identical(conditionMessage(e), 'StopIteration') || i == 0L) stop(e) length(r) <<- i }) r } object <- if (mode == 'list') list(nextElem=nextEl.list) else list(nextElem=nextEl.vector) class(object) <- c('abstractiter', 'iter') object } itertools/R/ihasNext.R0000644000176200001440000000157111316464677014430 0ustar liggesusers# This is based on code that was contributed by Hadley Wickham hasNext.ihasNext <- function(obj, ...) { obj$hasNext() } ihasNext <- function(iterable) { it <- iter(iterable) if (inherits(it, 'ihasNext')) { it } else { cache <- NULL hasnext <- NA nextEl <- function() { if (! hasNx()) { stop('StopIteration', call.=FALSE) } hasnext <<- NA cache } hasNx <- function() { if (is.na(hasnext)) { tryCatch({ cache <<- nextElem(it) hasnext <<- TRUE }, error=function(e) { if (identical(conditionMessage(e), 'StopIteration')) { hasnext <<- FALSE } else { stop(e) } }) } hasnext } obj <- list(nextElem=nextEl, hasNext=hasNx) class(obj) <- c('ihasNext', 'abstractiter', 'iter') obj } } itertools/R/iter.connection.R0000644000176200001440000000042111557642753015737 0ustar liggesusersiter.connection <- function(obj, ...) { s <- summary(obj) if (s$opened != "opened") stop("connection not opened") if (s$`can read` != "yes") stop("connection not readable") if (s$text == "binary") ireadBin(obj, ...) else ireadLines(obj, ...) } itertools/MD50000644000176200001440000000631412307715041012612 0ustar liggesusers65a9708069574eaf847a2b9e99c206a3 *DESCRIPTION 548ebc34b756663db90b6393c2dffd4e *NAMESPACE 3506205ccc38d7a60d55591f87c4544a *NEWS 4c05e3620d51310b98fe02d7773cc666 *R/chain.R 1b569831ef6a96e1c2f10cf75c183b1e *R/enumerate.R 4b876588bd4fcb9ac913849db3e93107 *R/hasNext.R 9025154f972064be19699b14378a4547 *R/iRNGStream.R 865411ce9891c3740cbb1a1527b2ec76 *R/iarray.R ab4d49d801d42f1a4f46d1cf7783c703 *R/ibreak.R a4e9ccb43c0424e7cb876343d470f22d *R/ichunk.R 4dfba9907ecc6d0fcc3f28a11e020a82 *R/ifilter.R 1ed778c9558ac623faac9c201f5e5f17 *R/ihasNext.R 1a3bddd98e9f32d9607e154987d970bc *R/ilimit.R 906e8a6543acba997093f34dff522166 *R/ireadBin.R e4b662edbc413ef574edf1da99b58ed1 *R/ireaddf.R eca66fd5560258d027187b164b2c01b8 *R/irecord.R 4f355a262403fc02cee9dbc0edeb6334 *R/irep.R 6683a637f6db3b7a2e7ef5a3f677e600 *R/irepeat.R de3bc98e7a8a8d9ddb9234f74017d23f *R/isplitCols.R 5d89021aafe86c63686ed865c3a9ca7a *R/isplitIndices.R cec4656b3b449b92bab604d1cda68ad7 *R/isplitRows.R c71f3418c7370cf5e5b0b6876d8475f8 *R/isplitVector.R bb9ba811be9b739fead579f7e9643a1f *R/iter.connection.R 92967796327d99319faed9f855e43a04 *R/izip.R abd40d7e0ac1738b65dfbed458da8c89 *R/product.R cc87f19da665b0e666a2bbb89ed223dd *R/recycle.R d4d8297d28e38c82ab86fbec31f38eee *R/timeout.R 7bbb0498876495195590f0e5155ffb09 *R/util.R 2355e0e134041651ef46174fd23039d5 *R/writedf.R 1dd5a34a34b2acc04ed3583ffbd645a6 *inst/examples/blockMM.R 664a36ad62483128251e80a943ce9ba5 *inst/examples/iarrayExample.R 065a24dd6b5c57a7745ca118cd90182e *inst/examples/iarrayExample2.R cb375ec7603454eb2e771e81fb2a81c1 *inst/examples/ihasNextExample.R 3eab25ba787614241ebf6f20a6c32e48 *inst/examples/ireadBinExample.R 757ee19746f4dad65af2e8cb449428dc *inst/examples/ireaddfExample.R 103d3ddc1af5a2b341e28eb64ce09c81 *inst/examples/isplitIndicesExample.R d86635eb371b9d78cbf47d646878be65 *inst/examples/productExample.R 95616ee1e3c24cd6cab253dfb771132e *inst/examples/range.R ce4b5984264f721882238508dd22c3e6 *inst/examples/timeoutExample.R f71fa87ae3089cc0fc4785f825be355b *man/chain.Rd 9e03af3c3bc8df1774185f114780bd44 *man/enumerate.Rd 19f3f57ecef199d26f159eb9f0d19d45 *man/hasNext.Rd 396741418ef6c4fa472fbcc5fd31be70 *man/iRNGStream.Rd 1e17bd222b833fdab8151c7bfe75f841 *man/iarray.Rd 41fafbe6aa30e4f6a5320fa9179db4fb *man/ibreak.Rd a57af546c641a76ffce6b72d21647a3f *man/ichunk.Rd b9b0d55d22020e2b4c0931db664ee04f *man/ifilter.Rd dd1752740d2ef058bb1e48509cdb7717 *man/ihasNext.Rd 5873b36410d200dc8ab279b89c649fcc *man/ilimit.Rd 1ed4e1cc80b3420ced4188373197aa1d *man/ireadBin.Rd 45f0b786a7856aa40beef7a8f6a54c5c *man/ireaddf.Rd a932c26e4ba48f1974d53a2018f9f7d3 *man/irecord.Rd 338a40b82fe87699db974f85504fe033 *man/irep.Rd 2d87df17f39c4ec3bbeab2c0373e7809 *man/irepeat.Rd fa106e7fc62de0266c0d5ad814cc4171 *man/isplitCols.Rd 1a34fbab99e8b55890a8f29dab88cc1c *man/isplitIndices.Rd 273c875f5837dc998472fa99c5121913 *man/isplitRows.Rd 747d173c02ac86eb40205e4183072c7a *man/isplitVector.Rd 98804b3a98ce8276f86aaa177e85cf08 *man/itertools-package.Rd 38644b394864b102c9a4335b8e94b5fc *man/izip.Rd fd23fa040d5c50d8999c3ff07f9c3e9e *man/product.Rd 55725908c95b07066a26eeb82e8922d3 *man/recycle.Rd aa98c0e1a168d655dc450e45ee872656 *man/timeout.Rd a07e0bf1e1900caa644654229ca0b456 *man/util.Rd 517df1ceca586ab8874bad4dbb2243c9 *man/writedf.Rd itertools/DESCRIPTION0000644000176200001440000000126012307715041014003 0ustar liggesusersPackage: itertools Type: Package Title: Iterator Tools Version: 0.1-3 Author: Steve Weston, Hadley Wickham Maintainer: Steve Weston Description: Various tools for creating iterators, many patterned after functions in the Python itertools module, and others patterned after functions in the 'snow' package. Depends: R (>= 2.14.0), iterators(>= 1.0.0) Imports: parallel Suggests: foreach License: GPL-2 Repository: CRAN Repository/R-Forge/Project: itertools Repository/R-Forge/Revision: 60 Repository/R-Forge/DateTimeStamp: 2014-02-27 22:33:49 Date/Publication: 2014-03-12 00:20:01 Packaged: 2014-02-27 23:36:25 UTC; rforge NeedsCompilation: no itertools/man/0000755000176200001440000000000012303743706013056 5ustar liggesusersitertools/man/irep.Rd0000644000176200001440000000204111323354755014304 0ustar liggesusers\name{irep} \alias{irep} \title{Create a repeating iterator} \description{ Create an iterator version of the \code{rep} function. } \usage{ irep(iterable, times, length.out, each) } \arguments{ \item{iterable}{The iterable to iterate over repeatedly.} \item{times}{A vector giving the number of times to repeat each element if the length is greater than one, or to repeat all the elements if the length is one. This behavior is less strict than \code{rep} since the length of an iterable isn't generally known.} \item{length.out}{non-negative integer. The desired length of the output iterator.} \item{each}{non-negative integer. Each element of the iterable is repeated \code{each} times.} } \seealso{ \code{\link[base]{rep}} } \examples{ unlist(as.list(irep(1:4, 2))) unlist(as.list(irep(1:4, each=2))) unlist(as.list(irep(1:4, c(2,2,2,2)))) unlist(as.list(irep(1:4, c(2,1,2,1)))) unlist(as.list(irep(1:4, each=2, len=4))) unlist(as.list(irep(1:4, each=2, len=10))) unlist(as.list(irep(1:4, each=2, times=3))) } \keyword{utilities} itertools/man/ireaddf.Rd0000644000176200001440000000101312132155132014724 0ustar liggesusers\name{ireaddf} \alias{ireaddf} \title{Create an iterator to read data frames from files} \description{ Create an iterator to read data frames from files. } \usage{ ireaddf(filenames, n, start=1, col.names, chunkSize=1000) } \arguments{ \item{filenames}{Names of files contains column data.} \item{n}{Number of elements to read from each column file.} \item{start}{Element to starting reading from.} \item{col.names}{Names of the columns.} \item{chunkSize}{Number of rows to read at a time.} } \keyword{utilities} itertools/man/irecord.Rd0000644000176200001440000000231011770403446014771 0ustar liggesusers\name{irecord} \alias{irecord} \alias{ireplay} \title{Record and replay iterators} \description{ The \code{irecord} function records the values issued by a specified iterator to a file or connection object. The \code{ireplay} function returns an iterator that will replay those values. This is useful for iterating concurrently over multiple, large matrices or data frames that you can't keep in memory at the same time. These large objects can be recorded to files one at a time, and then be replayed concurrently using minimal memory. } \usage{ irecord(con, iterable) ireplay(con) } \arguments{ \item{con}{A file path or open connection.} \item{iterable}{The iterable to record to the file.} } \examples{ suppressMessages(library(foreach)) m1 <- matrix(rnorm(70), 7, 10) f1 <- tempfile() irecord(f1, iter(m1, by='row', chunksize=3)) m2 <- matrix(1:50, 10, 5) f2 <- tempfile() irecord(f2, iter(m2, by='column', chunksize=3)) # Perform a simple out-of-core matrix multiply p <- foreach(col=ireplay(f2), .combine='cbind') \%:\% foreach(row=ireplay(f1), .combine='rbind') \%do\% { row \%*\% col } dimnames(p) <- NULL print(p) all.equal(p, m1 \%*\% m2) unlink(c(f1, f2)) } \keyword{utilities} itertools/man/ilimit.Rd0000644000176200001440000000061711316464677014652 0ustar liggesusers\name{ilimit} \alias{ilimit} \title{Create a limited iterator} \description{ Create an iterator that wraps a specified iterable a limited number of times. } \usage{ ilimit(iterable, n) } \arguments{ \item{iterable}{Iterable to iterate over.} \item{n}{Maximum number of values to return.} } \examples{ # Limit icount to only return three values as.list(ilimit(icount(), 3)) } \keyword{utilities} itertools/man/ireadBin.Rd0000644000176200001440000000317711322746524015073 0ustar liggesusers\name{ireadBin} \alias{ireadBin} \title{Create an iterator to read binary data from a connection} \description{ Create an iterator to read binary data from a connection. } \usage{ ireadBin(con, what='raw', n=1L, size=NA_integer_, signed=TRUE, endian=.Platform$endian, ipos=NULL) } \arguments{ \item{con}{A connection object or a character string naming a file or a raw vector.} \item{what}{Either an object whose mode will give the mode of the vector to be read, or a character vector of length one describing the mode: one of \dQuote{numeric}, \dQuote{double}, \dQuote{integer}, \dQuote{int}, \dQuote{logical}, \dQuote{complex}, \dQuote{character}, \dQuote{raw}. Unlike \code{readBin}, the default value is \dQuote{raw}.} \item{n}{integer. The (maximal) number of records to be read each time the iterator is called.} \item{size}{integer. The number of bytes per element in the byte stream. The default, \sQuote{NA_integer_}, uses the natural size.} \item{signed}{logical. Only used for integers of sizes 1 and 2, when it determines if the quantity on file should be regarded as a signed or unsigned integer.} \item{endian}{The endian-ness ('\dQuote{big}' or '\dQuote{little}') of the target system for the file. Using '\dQuote{swap}' will force swapping endian-ness.} \item{ipos}{iterable. If not \code{NULL}, values from this iterable will be used to do a seek on the file before calling readBin.} } \examples{ zz <- file("testbin", "wb") writeBin(1:100, zz) close(zz) it <- ihasNext(ireadBin("testbin", integer(), 10)) while (hasNext(it)) { print(nextElem(it)) } unlink("testbin") } \keyword{utilities} itertools/man/chain.Rd0000644000176200001440000000047611316464677014450 0ustar liggesusers\name{chain} \alias{chain} \title{Create a chaining iterator} \description{ Create an iterator that chains multiple iterables together. } \usage{ chain(\dots) } \arguments{ \item{\dots}{The iterables to iterate over.} } \examples{ # Iterate over two iterables as.list(chain(1:2, letters[1:3])) } \keyword{utilities} itertools/man/isplitRows.Rd0000644000176200001440000000202711321173035015514 0ustar liggesusers\name{isplitRows} \alias{isplitRows} \title{Create an iterator that splits a matrix into block rows} \description{ Create an iterator that splits a matrix into block rows. You can specify either the number of blocks, using the \code{chunks} argument, or the maximum size of the blocks, using the \code{chunkSize} argument. } \usage{ isplitRows(x, \dots) } \arguments{ \item{x}{Matrix to iterate over.} \item{\dots}{Passed as the second and subsequent arguments to \code{idiv} function. Currently, \code{idiv} accepts either a value for \code{chunks} or \code{chunkSize}.} } \value{ An iterator that returns submatrices of \code{x}. } \seealso{ \code{\link[iterators]{idiv}, \link{isplitCols}} } \examples{ # Split a matrix into submatrices with a maximum of three rows x <- matrix(1:100, 10) it <- ihasNext(isplitRows(x, chunkSize=3)) while (hasNext(it)) { print(nextElem(it)) } # Split the same matrix into five submatrices it <- ihasNext(isplitRows(x, chunks=5)) while (hasNext(it)) { print(nextElem(it)) } } \keyword{utilities} itertools/man/enumerate.Rd0000644000176200001440000000060711316464677015347 0ustar liggesusers\name{enumerate} \alias{enumerate} \title{Create an enumeration object} \description{ Create an iterator that iterates over an iterable, returning the value in a list that includes an index. } \usage{ enumerate(iterable) } \arguments{ \item{iterable}{Iterable to iterate over.} } \examples{ # Create an enumeration of five random numbers as.list(enumerate(rnorm(5))) } \keyword{utilities} itertools/man/ichunk.Rd0000644000176200001440000000162212130355044014617 0ustar liggesusers\name{ichunk} \alias{ichunk} \title{Create a chunking iterator} \description{ Create an iterator that issues lists of values from the underlying iterable. This is useful for manually \dQuote{chunking} values from an iterable. } \usage{ ichunk(iterable, chunkSize, mode='list') } \arguments{ \item{iterable}{Iterable to iterate over.} \item{chunkSize}{Maximum number of values from \code{iterable} to return in each value issued by the resulting iterator.} \item{mode}{Mode of the objects returned by the iterator.} } \seealso{ \code{\link{isplitVector}} } \examples{ # Split the vector 1:10 into "chunks" with a maximum length of three it <- ihasNext(ichunk(1:10, 3)) while (hasNext(it)) { print(unlist(nextElem(it))) } # Same as previous, but return integer vectors rather than lists it <- ihasNext(ichunk(1:10, 3, mode='integer')) while (hasNext(it)) { print(nextElem(it)) } } \keyword{utilities} itertools/man/iRNGStream.Rd0000644000176200001440000000175112132276035015320 0ustar liggesusers\name{iRNGStream} \alias{iRNGStream} \alias{iRNGSubStream} \title{Iterators that support parallel RNG} \description{ The \code{iRNGStream} function creates an infinite iterator that calls \code{nextRNGStream} repeatedly, and \code{iRNGSubStream} creates an infinite iterator that calls \code{nextRNGSubStream} repeatedly. } \usage{ iRNGStream(seed) iRNGSubStream(seed) } \arguments{ \item{seed}{Either a single number to be passed to \code{set.seed} or a vector to be passed to \code{nextRNGStream} or \code{nextRNGSubStream}.} } \seealso{ \code{\link[base]{set.seed}}, \code{\link[parallel]{nextRNGStream}}, \code{\link[parallel]{nextRNGSubStream}} } \examples{ it <- iRNGStream(313) print(nextElem(it)) print(nextElem(it)) \dontrun{ library(foreach) foreach(1:3, rseed=iRNGSubStream(1970), .combine='c') \%dopar\% { RNGkind("L'Ecuyer-CMRG") # would be better to initialize workers only once assign('.Random.seed', rseed, pos=.GlobalEnv) runif(1) } } } \keyword{utilities} itertools/man/iarray.Rd0000644000176200001440000000354612142544526014644 0ustar liggesusers\name{iarray} \alias{iarray} \title{Create an iterator over an array} \description{ Create an iterator over an array. } \usage{ iarray(X, MARGIN, ..., chunks, chunkSize, drop, idx=lapply(dim(X), function(i) TRUE)) } \arguments{ \item{X}{Array to iterate over.} \item{MARGIN}{Vector of subscripts to iterate over. Note that if the length of \code{MARGIN} is greater than one, the resulting iterator will generate iterators which is particularly useful with nested foreach loops.} \item{\dots}{Used to force subsequent arguments to be specified by name.} \item{chunks}{Number of elements that the iterator should generate. This can be a single value or a vector the same length as \code{MARGIN}. A single value will be recycled for each dimension if \code{MARGIN} has more than one value.} \item{chunkSize}{The maximum size Number of elements that the iterator should generate. This can be a single value or a vector the same length as \code{MARGIN}. A single value will be recycled for each dimension if \code{MARGIN} has more than one value.} \item{drop}{Should dimensions of length 1 be dropped in the generated values? It defaults to \code{FALSE} if either \code{chunks} or \code{chunkSize} is specified, otherwise to \code{TRUE}.} \item{idx}{List of indices used to generate a call object.} } \seealso{ \code{\link[base]{apply}} } \examples{ # Iterate over matrices in a 3D array x <- array(1:24, c(2,3,4)) as.list(iarray(x, 3)) # Iterate over subarrays as.list(iarray(x, 3, chunks=2)) x <- array(1:64, c(4,4,4)) it <- iarray(x, c(2,3), chunks=c(1,2)) jt <- nextElem(it) nextElem(jt) jt <- nextElem(it) nextElem(jt) it <- iarray(x, c(2,3), chunks=c(2,2)) jt <- nextElem(it) nextElem(jt) nextElem(jt) jt <- nextElem(it) nextElem(jt) nextElem(jt) } \keyword{utilities} itertools/man/writedf.Rd0000644000176200001440000000046412132155132015003 0ustar liggesusers\name{writedf.combiner} \alias{writedf.combiner} \title{Create an object that contains a combiner function} \description{ Create an object that contains a combiner function. } \usage{ writedf.combiner(filenames) } \arguments{ \item{filenames}{Names of files to write column data to.} } \keyword{utilities} itertools/man/timeout.Rd0000644000176200001440000000106211321376203015023 0ustar liggesusers\name{timeout} \alias{timeout} \title{Create a timeout iterator} \description{ Create an iterator that iterates over another iterator for a specified period of time, and then stops. This can be useful when you want to search for something, or run a test for awhile, and then stop. } \usage{ timeout(iterable, time) } \arguments{ \item{iterable}{Iterable to iterate over.} \item{time}{The time interval to iterate for, in seconds.} } \examples{ # See how high we can count in a tenth of a second length(as.list(timeout(icount(), 0.1))) } \keyword{utilities} itertools/man/util.Rd0000644000176200001440000000177111320724405014321 0ustar liggesusers\name{is.iterator} \alias{is.iterator} \alias{end_iteration} \alias{iteration_has_ended} \alias{new_iterator} \title{Utilities for writing iterators} \description{ \code{is.iterator} indicates if an object is an iterator. \code{end_iteration} throws an exception to signal that there are no more values available in an iterator. \code{iteration_has_ended} tests an exception to see if it indicates that iteration has ended. \code{new_iterator} returns an iterator object. } \usage{ is.iterator(x) end_iteration() iteration_has_ended(e) new_iterator(nextElem, \dots) } \arguments{ \item{x}{any object.} \item{e}{a condition object.} \item{nextElem}{a function object that takes no arguments.} \item{\dots}{not currently used.} } \examples{ # Manually iterate using the iteration_has_ended function to help it <- iter(1:3) tryCatch({ stopifnot(is.iterator(it)) repeat { print(nextElem(it)) } }, error=function(e) { if (!iteration_has_ended(e)) { stop(e) } }) } \keyword{utilities} itertools/man/ihasNext.Rd0000644000176200001440000000103711316464677015143 0ustar liggesusers\name{ihasNext} \alias{ihasNext} \title{Create an iterator that supports the hasNext method} \description{ \code{ihasNext} is a generic function that indicates if the iterator has another element. } \usage{ ihasNext(iterable) } \arguments{ \item{iterable}{an iterable object, which could be an iterator.} } \value{ An \code{ihasNext} iterator that wraps the specified iterator and supports the \code{hasNext} method. } \examples{ it <- ihasNext(c('a', 'b', 'c')) while (hasNext(it)) print(nextElem(it)) } \keyword{utilities} itertools/man/ifilter.Rd0000644000176200001440000000155711316464677015025 0ustar liggesusers\name{ifilter} \alias{ifilter} \alias{ifilterfalse} \title{Create a filtering iterator} \description{ The \code{ifilter} and \code{ifilterfalse} functions create iterators that return a subset of the values of the specified iterable. \code{ifilter} returns the values for which the \code{pred} function returns \code{TRUE}, and \code{ifilterfalse} returns the values for which the \code{pred} function returns \code{FALSE}. } \usage{ ifilter(pred, iterable) ifilterfalse(pred, iterable) } \arguments{ \item{pred}{A function that takes one argument and returns \code{TRUE} or \code{FALSE}.} \item{iterable}{The iterable to iterate over.} } \examples{ # Return the odd numbers between 1 and 10 as.list(ifilter(function(x) x \%\% 2 == 1, icount(10))) # Return the even numbers between 1 and 10 as.list(ifilterfalse(function(x) x \%\% 2 == 1, icount(10))) } \keyword{utilities} itertools/man/isplitIndices.Rd0000644000176200001440000000201111321173035016131 0ustar liggesusers\name{isplitIndices} \alias{isplitIndices} \title{Create an iterator of indices} \description{ Create an iterator of chunks of indices from 1 to \code{n}. You can specify either the number of pieces, using the \code{chunks} argument, or the maximum size of the pieces, using the \code{chunkSize} argument. } \usage{ isplitIndices(n, \dots) } \arguments{ \item{n}{Maximum index to generate.} \item{\dots}{Passed as the second and subsequent arguments to \code{idiv} function. Currently, \code{idiv} accepts either a value for \code{chunks} or \code{chunkSize}.} } \value{ An iterator that returns vectors of indices from 1 to \code{n}. } \seealso{ \code{\link[iterators]{idiv}, \link{isplitVector}} } \examples{ # Return indices from 1 to 17 in vectors no longer than five it <- ihasNext(isplitIndices(17, chunkSize=5)) while (hasNext(it)) { print(nextElem(it)) } # Return indices from 1 to 7 in four vectors it <- ihasNext(isplitIndices(7, chunks=4)) while (hasNext(it)) { print(nextElem(it)) } } \keyword{utilities} itertools/man/irepeat.Rd0000644000176200001440000000063711323213374014776 0ustar liggesusers\name{irepeat} \alias{irepeat} \title{Create a repeating iterator} \description{ Create an iterator that returns a value a specified number of times. } \usage{ irepeat(x, times) } \arguments{ \item{x}{The value to return repeatedly.} \item{times}{The number of times to repeat the value. Default value is infinity.} } \examples{ # Repeat a value 10 times unlist(as.list(irepeat(42, 10))) } \keyword{utilities} itertools/man/isplitCols.Rd0000644000176200001440000000203611321173035015462 0ustar liggesusers\name{isplitCols} \alias{isplitCols} \title{Create an iterator that splits a matrix into block columns} \description{ Create an iterator that splits a matrix into block columns. You can specify either the number of blocks, using the \code{chunks} argument, or the maximum size of the blocks, using the \code{chunkSize} argument. } \usage{ isplitCols(x, \dots) } \arguments{ \item{x}{Matrix to iterate over.} \item{\dots}{Passed as the second and subsequent arguments to \code{idiv} function. Currently, \code{idiv} accepts either a value for \code{chunks} or \code{chunkSize}.} } \value{ An iterator that returns submatrices of \code{x}. } \seealso{ \code{\link[iterators]{idiv}, \link{isplitRows}} } \examples{ # Split a matrix into submatrices with a maximum of three columns x <- matrix(1:30, 3) it <- ihasNext(isplitCols(x, chunkSize=3)) while (hasNext(it)) { print(nextElem(it)) } # Split the same matrix into five submatrices it <- ihasNext(isplitCols(x, chunks=5)) while (hasNext(it)) { print(nextElem(it)) } } \keyword{utilities} itertools/man/izip.Rd0000644000176200001440000000057711316464677014343 0ustar liggesusers\name{izip} \alias{izip} \title{Create an iterator over multiple iterables} \description{ Create an iterator that iterates over multiple iterables, returning the values as a list. } \usage{ izip(\dots) } \arguments{ \item{\dots}{The iterables to iterate over.} } \examples{ # Iterate over two iterables of different sizes as.list(izip(a=1:2, b=letters[1:3])) } \keyword{utilities} itertools/man/hasNext.Rd0000644000176200001440000000110511316464677014766 0ustar liggesusers\name{hasNext} \alias{hasNext} \alias{hasNext.ihasNext} \title{Does This Iterator Have A Next Element} \description{ \code{hasNext} is a generic function that indicates if the iterator has another element. } \usage{ hasNext(obj, \dots) \method{hasNext}{ihasNext}(obj, \dots) } \arguments{ \item{obj}{an iterator object.} \item{\dots}{additional arguments that are ignored.} } \value{ Logical value indicating whether the iterator has a next element. } \examples{ it <- ihasNext(iter(c('a', 'b', 'c'))) while (hasNext(it)) print(nextElem(it)) } \keyword{methods} itertools/man/ibreak.Rd0000644000176200001440000000133512205462111014571 0ustar liggesusers\name{ibreak} \alias{ibreak} \title{Create an iterator that can be told to stop} \description{ Create an iterator that iterates over another iterator until a specified function returns \code{FALSE}. This can be useful for breaking out of a foreach loop, for example. } \usage{ ibreak(iterable, finished) } \arguments{ \item{iterable}{Iterable to iterate over.} \item{finished}{Function that returns a logical value. The iterator stops when this function returns \code{FALSE}.} } \examples{ # See how high we can count in a tenth of a second mkfinished <- function(time) { starttime <- proc.time()[3] function() proc.time()[3] > starttime + time } length(as.list(ibreak(icount(), mkfinished(0.1)))) } \keyword{utilities} itertools/man/isplitVector.Rd0000644000176200001440000000234611321173035016030 0ustar liggesusers\name{isplitVector} \alias{isplitVector} \title{Create an iterator that splits a vector} \description{ Create an iterator that splits a vector into smaller pieces. You can specify either the number of pieces, using the \code{chunks} argument, or the maximum size of the pieces, using the \code{chunkSize} argument. } \usage{ isplitVector(x, \dots) } \arguments{ \item{x}{Vector to iterate over. Note that it doesn't need to be an atomic vector, so a list is acceptable.} \item{\dots}{Passed as the second and subsequent arguments to \code{idiv} function. Currently, \code{idiv} accepts either a value for \code{chunks} or \code{chunkSize}.} } \value{ An iterator that returns vectors of the same type as \code{x} with one or more elements from \code{x}. } \seealso{ \code{\link[iterators]{idiv}} } \examples{ # Split the vector 1:10 into "chunks" with a maximum length of three it <- ihasNext(isplitVector(1:10, chunkSize=3)) while (hasNext(it)) { print(nextElem(it)) } # Split the vector "letters" into four chunks it <- ihasNext(isplitVector(letters, chunks=4)) while (hasNext(it)) { print(nextElem(it)) } # Get the first five elements of a list as a list nextElem(isplitVector(as.list(letters), chunkSize=5)) } \keyword{utilities} itertools/man/product.Rd0000644000176200001440000000116111316542444015023 0ustar liggesusers\name{product} \alias{product} \title{Create a cartesian product iterator} \description{ Create an iterator that returns values from multiple iterators in cartesian product fashion. That is, they are combined the manner of nested \code{for} loops. } \usage{ product(\dots) } \arguments{ \item{\dots}{Named iterables to iterate over. The right-most iterables change more quickly, like an odometer.} } \examples{ # Simulate a doubly-nested loop with a single while loop it <- ihasNext(product(a=1:3, b=1:2)) while (hasNext(it)) { x <- nextElem(it) cat(sprintf('a = \%d, b = \%d\n', x$a, x$b)) } } \keyword{utilities} itertools/man/itertools-package.Rd0000644000176200001440000000477011323264332016764 0ustar liggesusers\name{itertools-package} \alias{itertools-package} \alias{itertools} \docType{package} \title{ The itertools Package } \description{ The \code{itertools} package provides a variety of functions used to create iterators, as defined by REvolution Computing's \code{iterators} package. Many of the functions are patterned after functions of the same name in the Python itertools module, including \code{chain}, \code{product}, \code{izip}, \code{ifilter}, etc. In addition, a number of functions were inspired by utility functions in the \code{snow} package, such as \code{isplitRows}, \code{isplitCols}, and \code{isplitIndices}. There are also several utility functions that were contributed by Hadley Wickham that aid in writing iterators. These include \code{is.iterator}, \code{end_iterator}, \code{iteration_has_ended}, and \code{new_iterator}. } \details{ More information is available on the following topics: \tabular{ll}{ \code{isplitVector} \tab splits, or slices, a vector into shorter segments\cr \code{isplitCols} \tab splits a matrix column-wise\cr \code{isplitRows} \tab splits a matrix row-wise\cr \code{isplitIndices} \tab iterate over \dQuote{chunks} of indices from 1 to n\cr \code{chain} \tab chain multiple iterators together into one iterator\cr \code{enumerate} \tab create an enumeration from an iterator\cr \code{ichunk} \tab create lists of values from an iterator to aid manual chunking\cr \code{ihasNext} \tab add a hasNext method to an iterator\cr \code{ifilter} \tab only return values for which a predicate function returns true\cr \code{ifilterfalse} \tab only return values for which a predicate function returns false\cr \code{ilimit} \tab limit, or truncate, an iterator\cr \code{ireadBin} \tab reads from a binary connection\cr \code{irep} \tab an iterator version of the rep function\cr \code{irepeat} \tab a simple repeating value iterator\cr \code{izip} \tab zip together multiple iterators\cr \code{product} \tab zip together multiple iterators in cartesian product fashion\cr \code{recycle} \tab recycle values from an iterator repeatedly\cr \code{timeout} \tab iterate for a specified number of seconds\cr \code{is.iterator} \tab indicates if an object is an iterator\cr \code{end_iteration} \tab throws an exception to signal end of iteration\cr \code{iteration_has_ended} \tab tests an exception to see if iteration has ended\cr \code{new_iterator} \tab creates a new iterator object\cr } For a complete list of functions with individual help pages, use \code{library(help="itertools")}. } \keyword{package} itertools/man/recycle.Rd0000644000176200001440000000075311323263104014766 0ustar liggesusers\name{recycle} \alias{recycle} \title{Create a recycling iterator} \description{ Create an iterator that recycles a specified iterable. } \usage{ recycle(iterable, times=NA_integer_) } \arguments{ \item{iterable}{The iterable to recycle.} \item{times}{integer. Number of times to recycle the values in the iterator. Default value of \code{NA_integer_} means to recycle forever.} } \examples{ # Recycle over 'a', 'b', and 'c' three times recycle(letters[1:3], 3) } \keyword{utilities}