git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/Streamer@68814 bc3139a8-67e5-0310-9ffc-ced21a209358
... | ... |
@@ -18,9 +18,11 @@ Imports: methods, graph, parallel, BiocGenerics |
18 | 18 |
Suggests: RUnit, Rsamtools (>= 1.5.53) |
19 | 19 |
biocViews: Infrastructure, DataImport |
20 | 20 |
Collate: |
21 |
- generics.R OldClass.R |
|
22 |
- Streamer.R Producer.R Consumer.R Stream.R |
|
23 |
- ConnectionProducer.R RawInput.R Seq.R |
|
24 |
- Downsample.R Team.R UserFunction-class.R Utility.R |
|
25 |
- ParallelConnector.R TConnector.R YConnector.R |
|
21 |
+ AllGenerics.R |
|
22 |
+ Streamer-class.R Producer-class.R Consumer-class.R Stream-class.R |
|
23 |
+ ConnectionProducer-classes.R RawInput-class.R Seq-class.R |
|
24 |
+ Downsample-class.R Team-class.R FunctionProducerConsumer-classes.R |
|
25 |
+ Utility-classes.R ParallelConnector-class.R TConnector-class.R |
|
26 |
+ YConnector-class.R |
|
27 |
+ lapply-methods.R stream-methods.R |
|
26 | 28 |
zzz.R |
16 | 18 |
similarity index 92% |
17 | 19 |
rename from R/Consumer.R |
18 | 20 |
rename to R/Consumer-class.R |
... | ... |
@@ -53,9 +53,3 @@ |
53 | 53 |
txt <- sprintf("stream: %s", inp) |
54 | 54 |
cat(strwrap(txt, exdent=2), sep="\n") |
55 | 55 |
}) |
56 |
- |
|
57 |
-setMethod(stream, "Consumer", |
|
58 |
- function(x, ..., verbose=FALSE) |
|
59 |
-{ |
|
60 |
- .stream_set(x, ..., verbose=verbose) |
|
61 |
-}) |
0 | 2 |
deleted file mode 100644 |
... | ... |
@@ -1,57 +0,0 @@ |
1 |
-.Producer <- setRefClass("Producer", contains="Streamer") |
|
2 |
- |
|
3 |
-setMethod(stream, "Producer", |
|
4 |
- function(x, ..., verbose=FALSE) |
|
5 |
-{ |
|
6 |
- if (0L == length(list(...))) |
|
7 |
- .stream_set(x, verbose=verbose) |
|
8 |
- else |
|
9 |
- do.call(stream, c(rev(list(..., verbose=verbose)), list(x))) |
|
10 |
-}) |
|
11 |
- |
|
12 |
-setMethod(lapply, "Producer", |
|
13 |
- function(X, FUN, ...) |
|
14 |
-{ |
|
15 |
- FUN <- match.fun(FUN) |
|
16 |
- YIELD <- selectMethod("yield", class(X)) # avoid S4 dispatch |
|
17 |
- |
|
18 |
- it <- 0L |
|
19 |
- result <- vector("list", 4096L) # pre-allocate |
|
20 |
- .partialResult <- function(err) { |
|
21 |
- if (is(err, "simpleError")) { |
|
22 |
- length(result) <- it |
|
23 |
- err$message <- paste0("yield(): ", conditionMessage(err)) |
|
24 |
- err$partialResult <- result |
|
25 |
- class(err) <- c("partialResult", class(err)) |
|
26 |
- } |
|
27 |
- stop(err) |
|
28 |
- } |
|
29 |
- |
|
30 |
- repeat { |
|
31 |
- y <- tryCatch(YIELD(X), error = .partialResult) |
|
32 |
- if (!length(y)) |
|
33 |
- break; |
|
34 |
- y <- tryCatch(FUN(y, ...), error = .partialResult) |
|
35 |
- it <- it + 1L |
|
36 |
- if (it == length(result)) # grow |
|
37 |
- length(result) <- 1.6 * length(result) |
|
38 |
- result[[it]] <- y |
|
39 |
- } |
|
40 |
- length(result) <- it |
|
41 |
- result |
|
42 |
-}) |
|
43 |
- |
|
44 |
-setMethod(sapply, "Producer", |
|
45 |
- function(X, FUN, ..., simplify=TRUE, USE.NAMES=TRUE) |
|
46 |
-{ |
|
47 |
- FUN <- match.fun(FUN) |
|
48 |
- answer <- tryCatch(lapply(X = X, FUN = FUN, ...), error=function(err) { |
|
49 |
- if (is(err, "partialResult")) |
|
50 |
- err$partialResult <- simplify2array(err$partialResult, |
|
51 |
- higher = (simplify == "array")) |
|
52 |
- stop(err) |
|
53 |
- }) |
|
54 |
- if (!identical(simplify, FALSE) && length(answer)) |
|
55 |
- simplify2array(answer, higher = (simplify == "array")) |
|
56 |
- else answer |
|
57 |
-}) |
64 | 6 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,35 @@ |
1 |
+.Stream <- setRefClass("Stream", contains = "Consumer") |
|
2 |
+ |
|
3 |
+.Stream$methods( |
|
4 |
+ yield=function() |
|
5 |
+ { |
|
6 |
+ .self$inputPipe$yield() |
|
7 |
+ |
|
8 |
+ }) |
|
9 |
+ |
|
10 |
+setMethod(length, "Stream", |
|
11 |
+ function(x) |
|
12 |
+{ |
|
13 |
+ i <- 0L |
|
14 |
+ inp <- x |
|
15 |
+ while (extends(class(inp), "Consumer")) { |
|
16 |
+ inp <- inp$inputPipe |
|
17 |
+ i <- i + 1L |
|
18 |
+ } |
|
19 |
+ i |
|
20 |
+}) |
|
21 |
+ |
|
22 |
+setMethod("[[", c("Stream", "numeric"), |
|
23 |
+ function(x, i, j, ...) |
|
24 |
+{ |
|
25 |
+ i <- as.integer(i) |
|
26 |
+ len <- length(x) |
|
27 |
+ if (1L != length(i) || 0 >= i || len < i) |
|
28 |
+ stop("'i' must be integer(1), 0 < i <= length(x)") |
|
29 |
+ inp <- x$inputPipe |
|
30 |
+ while (extends(class(inp), "Consumer") && 1L < i) { |
|
31 |
+ inp <- inp$inputPipe |
|
32 |
+ i <- i - 1L |
|
33 |
+ } |
|
34 |
+ inp |
|
35 |
+}) |
0 | 36 |
deleted file mode 100644 |
... | ... |
@@ -1,62 +0,0 @@ |
1 |
-.Stream <- setRefClass("Stream", contains = "Consumer") |
|
2 |
- |
|
3 |
-.Stream$methods( |
|
4 |
- yield=function() |
|
5 |
- { |
|
6 |
- .self$inputPipe$yield() |
|
7 |
- |
|
8 |
- }) |
|
9 |
- |
|
10 |
-.stream_set <- function(x, ..., verbose) |
|
11 |
-{ |
|
12 |
- ## helper used to construct streams |
|
13 |
- inp <- list(x, ...) |
|
14 |
- use <- sapply(inp, "[[", "inUse") |
|
15 |
- cls <- sapply(inp, class) |
|
16 |
- if(any(use)) { |
|
17 |
- msg <- sprintf("%s : already in use in another stream", |
|
18 |
- paste(cls[which(use)], sep = " ", collapse = ", ")) |
|
19 |
- stop(msg) |
|
20 |
- } |
|
21 |
- x$inUse <- TRUE |
|
22 |
- inputPipe <- Reduce(function(x, y) { |
|
23 |
- x$inputPipe <- y |
|
24 |
- y$inUse <- TRUE |
|
25 |
- if (is(x, "ParallelConnector")) { |
|
26 |
- x$.upstream <- .mc_parallel(quote({ |
|
27 |
- while(TRUE) { |
|
28 |
- prime <- yield(y) |
|
29 |
- sendMaster(prime) |
|
30 |
- }})) |
|
31 |
- } |
|
32 |
- x |
|
33 |
- }, list(x, ...), right=TRUE) |
|
34 |
- .Stream$new(inputPipe=inputPipe, verbose=verbose) |
|
35 |
-} |
|
36 |
- |
|
37 |
-setMethod(length, "Stream", |
|
38 |
- function(x) |
|
39 |
-{ |
|
40 |
- i <- 0L |
|
41 |
- inp <- x |
|
42 |
- while (extends(class(inp), "Consumer")) { |
|
43 |
- inp <- inp$inputPipe |
|
44 |
- i <- i + 1L |
|
45 |
- } |
|
46 |
- i |
|
47 |
-}) |
|
48 |
- |
|
49 |
-setMethod("[[", c("Stream", "numeric"), |
|
50 |
- function(x, i, j, ...) |
|
51 |
-{ |
|
52 |
- i <- as.integer(i) |
|
53 |
- len <- length(x) |
|
54 |
- if (1L != length(i) || 0 >= i || len < i) |
|
55 |
- stop("'i' must be integer(1), 0 < i <= length(x)") |
|
56 |
- inp <- x$inputPipe |
|
57 |
- while (extends(class(inp), "Consumer") && 1L < i) { |
|
58 |
- inp <- inp$inputPipe |
|
59 |
- i <- i - 1L |
|
60 |
- } |
|
61 |
- inp |
|
62 |
-}) |
78 | 15 |
similarity index 81% |
79 | 16 |
rename from man/ConnectionProducer-class.Rd |
80 | 17 |
rename to man/ConnectionProducer-classes.Rd |
... | ... |
@@ -1,6 +1,7 @@ |
1 |
-\name{ConnectionProducer-class} |
|
1 |
+\name{ConnectionProducer-classes} |
|
2 | 2 |
\Rdversion{1.1} |
3 | 3 |
\docType{class} |
4 |
+\alias{ConnectionProducer-classes} |
|
4 | 5 |
\alias{ConnectionProducer-class} |
5 | 6 |
\alias{close.ConnectionProducer} |
6 | 7 |
\alias{ScanProducer-class} |
... | ... |
@@ -10,7 +11,7 @@ |
10 | 11 |
\alias{ReadLinesProducer} |
11 | 12 |
\alias{ReadTableProducer} |
12 | 13 |
|
13 |
-\title{Class "ConnectionProducer"} |
|
14 |
+\title{Producer classes to read file connections} |
|
14 | 15 |
|
15 | 16 |
\description{ |
16 | 17 |
|
... | ... |
@@ -47,10 +48,16 @@ ReadTableProducer(file, ..., fileArgs=list(), readTableArgs=list(...)) |
47 | 48 |
|
48 | 49 |
} |
49 | 50 |
|
50 |
-\section{Internal Methods}{ |
|
51 |
+\section{Methods}{See \code{\link{Producer}} Methods.} |
|
51 | 52 |
|
52 |
- Class-based fields and methods are for internal use. See, e.g., |
|
53 |
- \code{Streamer:::.ScanLinesProducer$help()} for documentation |
|
53 |
+\section{Internal Class Fields and Methods}{ |
|
54 |
+ |
|
55 |
+ Internal fields of this class are are described with, e.g., |
|
56 |
+ \code{getRefClass("ReadLinesProducer")$fields}. |
|
57 |
+ |
|
58 |
+ Internal methods of this class are described with |
|
59 |
+ \code{getRefClass("ReadLinesProducer")$methods()} and |
|
60 |
+ \code{getRefClass("ReadLinesProducer")$help()}. |
|
54 | 61 |
|
55 | 62 |
} |
56 | 63 |
|
... | ... |
@@ -1,10 +1,11 @@ |
1 | 1 |
\name{Consumer-class} |
2 | 2 |
\Rdversion{1.1} |
3 | 3 |
\docType{class} |
4 |
+\alias{Consumer} |
|
4 | 5 |
\alias{Consumer-class} |
5 | 6 |
\alias{show,Consumer-method} |
6 | 7 |
|
7 |
-\title{Class "Consumer"} |
|
8 |
+\title{Class defining methods for all consumers} |
|
8 | 9 |
|
9 | 10 |
\description{ |
10 | 11 |
|
... | ... |
@@ -19,56 +20,24 @@ |
19 | 20 |
|
20 | 21 |
\section{Methods}{ |
21 | 22 |
Methods defined on this class include: |
22 |
- \describe{ |
|
23 |
- \item{stream}{\code{signature(x = "Consumer", ...)}: see |
|
24 |
- \code{?stream}.} |
|
25 |
- \item{show}{\code{signature(object = "Consumer")}: Display the |
|
26 |
- stream.} |
|
27 |
- } |
|
28 |
-} |
|
29 | 23 |
|
30 |
-\section{Fields}{ |
|
31 | 24 |
\describe{ |
32 | 25 |
|
33 |
- \item{\code{inputPipe}:}{Object of class \code{Streamer}, |
|
34 |
- representing the \code{Producer} or \code{Consumer} connected |
|
35 |
- up-stream to it and from which records are yielded.} |
|
36 |
- |
|
37 |
- The \code{Consumer} class inherits the fields \code{verbose} and |
|
38 |
- \code{inUse} from the virtual \code{Streamer} class. Please refer |
|
39 |
- to the \code{\link{Streamer}} class for more details. |
|
26 |
+ \item{stream}{Construct a stream from one \code{Producer} and one or |
|
27 |
+ more \code{Consumer}. See \code{?stream}.} |
|
40 | 28 |
|
41 | 29 |
} |
42 | 30 |
} |
43 | 31 |
|
44 |
-\section{Class-Based Methods}{ |
|
45 |
- \describe{ |
|
46 |
- \item{\code{initialize(..., inputPipe)}:}{A method to |
|
47 |
- initialize the fields of the \code{Consumer} class. |
|
48 |
- \describe{ |
|
49 |
- \item{\code{inputPipe}:}{An object of class \code{Streamer} |
|
50 |
- connected up-stream to it. The class could be a |
|
51 |
- \code{Consumer} or \code{Producer} which yields data to the |
|
52 |
- \code{Consumer} class.} |
|
53 |
- } |
|
54 |
- } |
|
55 |
- |
|
56 |
- \item{\code{reset()}:}{Return the result of delegating |
|
57 |
- \code{reset()} to the object in the field \code{inputPipe}.} |
|
58 |
- |
|
59 |
- \item{\code{yield()}:}{Return the result of delegating |
|
60 |
- \code{yield()} to the object in the field \code{inputPipe}.} |
|
61 |
- |
|
62 |
- \item{\code{inputs()}:}{Return a \code{character} vector |
|
63 |
- representing up-stream components.} |
|
64 |
- |
|
65 |
- \item{\code{status{}}:}{Reports the status of the \code{Consumer} |
|
66 |
- class. A \code{list} of the status of the length of the object in |
|
67 |
- the \code{.records} field, the classes connected to the |
|
68 |
- \code{inputPipe} field and the status of the fields of the virtual |
|
69 |
- class \code{Streamer} are returned.} |
|
32 |
+\section{Internal Class Fields and Methods}{ |
|
33 |
+ |
|
34 |
+ Internal fields of this class are are described with, e.g., |
|
35 |
+ \code{getRefClass("Consumer")$fields}. |
|
36 |
+ |
|
37 |
+ Internal methods of this class are described with |
|
38 |
+ \code{getRefClass("Consumer")$methods()} and |
|
39 |
+ \code{getRefClass("Consumer")$help()}. |
|
70 | 40 |
|
71 |
- } |
|
72 | 41 |
} |
73 | 42 |
|
74 | 43 |
\author{Martin Morgan \url{mtmorgan@fhcrc.org}} |
... | ... |
@@ -4,16 +4,14 @@ |
4 | 4 |
\alias{Downsample} |
5 | 5 |
\alias{Downsample-class} |
6 | 6 |
|
7 |
-\title{Class "Downsample"} |
|
7 |
+\title{Consumer class to down-sample data} |
|
8 | 8 |
|
9 | 9 |
\description{ |
10 | 10 |
|
11 | 11 |
A \code{\linkS4class{Consumer}}-class to select records with fixed |
12 | 12 |
probability, returning a yield of fixed size. Successive calls to |
13 | 13 |
\code{yield} result in sampling of subsequent records in the stream, |
14 |
- until the stream is exhausted. Users interact with this class through |
|
15 |
- the constructor \code{Downsample} and methods \code{\link{yield}}, |
|
16 |
- \code{\link{reset}}, and \code{\link{stream}}. |
|
14 |
+ until the stream is exhausted. |
|
17 | 15 |
|
18 | 16 |
} |
19 | 17 |
|
... | ... |
@@ -22,30 +20,29 @@ Downsample(probability=0.1, sampledSize=1e6, ...) |
22 | 20 |
} |
23 | 21 |
|
24 | 22 |
\arguments{ |
23 |
+ |
|
25 | 24 |
\item{probability}{A \code{numeric(1)} between 0, 1 indicating the |
26 | 25 |
probability with which a record should be retained.} |
26 |
+ |
|
27 | 27 |
\item{...}{Additional arguments, passed to the \code{$new} method of |
28 | 28 |
the underlying reference class. Currently unused.} |
29 |
+ |
|
29 | 30 |
\item{sampledSize}{A \code{integer(1)} indicating the number of |
30 | 31 |
records to return.} |
32 |
+ |
|
31 | 33 |
} |
32 | 34 |
|
33 |
-\section{Fields}{ |
|
34 |
- \describe{ |
|
35 |
- \item{\code{probability}:}{Object of class \code{numeric}. The |
|
36 |
- probability of including a record in the \code{yield}.} |
|
37 |
- \item{\code{sampledSize}:}{Object of class \code{integer} |
|
38 |
- storing the number of records to produced each time \code{yield} |
|
39 |
- is invoked.} |
|
40 |
- \item{\code{.buffer}:}{Object of class \code{ANY}, used internally |
|
41 |
- to store read but not yet parsed records.} |
|
42 |
- } |
|
43 |
-} |
|
35 |
+\section{Methods}{See \code{\link{Consumer}} Methods.} |
|
36 |
+ |
|
37 |
+\section{Internal Class Fields and Methods}{ |
|
38 |
+ |
|
39 |
+ Internal fields of this class are are described with, e.g., |
|
40 |
+ \code{getRefClass("Downsample")$fields}. |
|
41 |
+ |
|
42 |
+ Internal methods of this class are described with |
|
43 |
+ \code{getRefClass("Downsample")$methods()} and |
|
44 |
+ \code{getRefClass("Downsample")$help()}. |
|
44 | 45 |
|
45 |
-\section{Class-Based Methods}{ |
|
46 |
- \describe{ |
|
47 |
- \item{\code{.sample(x)}:}{Sample from amongst the incoming records.} |
|
48 |
- } |
|
49 | 46 |
} |
50 | 47 |
|
51 | 48 |
\author{Martin Morgan \url{mtmorgan@fhcrc.org}} |
... | ... |
@@ -2,21 +2,21 @@ |
2 | 2 |
\Rdversion{1.1} |
3 | 3 |
\docType{class} |
4 | 4 |
\alias{Producer-class} |
5 |
+\alias{Producer} |
|
5 | 6 |
\alias{lapply,Producer-method} |
6 | 7 |
\alias{sapply,Producer-method} |
7 |
-\alias{show,Producer-method} |
|
8 | 8 |
|
9 |
-\title{Class "Producer"} |
|
9 |
+\title{Class defining methods for all Producers} |
|
10 | 10 |
|
11 | 11 |
\description{ |
12 | 12 |
|
13 | 13 |
A virtual class representing components that can read data from |
14 | 14 |
connections, and yield records to the user or a \code{Consumer} |
15 | 15 |
instance. A \code{Producer} represents a source of data, responsible |
16 |
- for parsing a file into records to be passed to \code{Consumer} |
|
17 |
- classes. \code{Producer} and \code{Consumer} instances are associated |
|
18 |
- with each other through the \code{\link{stream}} function or using the |
|
19 |
- \code{\link{connect}} function. |
|
16 |
+ for parsing a file or other data source into records to be passed to |
|
17 |
+ \code{Consumer} classes. \code{Producer} and \code{Consumer} instances |
|
18 |
+ are associated with each other through the \code{\link{stream}} |
|
19 |
+ function or using the \code{\link{connect}} function. |
|
20 | 20 |
|
21 | 21 |
} |
22 | 22 |
|
... | ... |
@@ -26,6 +26,7 @@ |
26 | 26 |
} |
27 | 27 |
|
28 | 28 |
\arguments{ |
29 |
+ |
|
29 | 30 |
\item{X}{An instance of class \code{Producer}} |
30 | 31 |
|
31 | 32 |
\item{FUN}{A function to be applied to each successful \code{yield()} |
... | ... |
@@ -42,45 +43,36 @@ |
42 | 43 |
|
43 | 44 |
\section{Methods}{ |
44 | 45 |
|
45 |
- \code{lapply} and \code{sapply} apply \code{FUN} to each result |
|
46 |
- applied to \code{yield()}. Partial results on error can be recovered |
|
47 |
- using \code{\link{tryCatch}}, as illustrated below. Infinite producers |
|
48 |
- will of course exhaust memory. |
|
46 |
+ Methods defined on this class include: |
|
49 | 47 |
|
50 |
- Inherited methods defined on this class include: |
|
51 | 48 |
\describe{ |
52 |
- \item{stream}{\code{signature(x = "Producer", ...)}: see |
|
53 |
- \code{?stream}.} |
|
54 |
- \item{show}{\code{signature(object = "Streamer")}: Display the |
|
55 |
- stream.} |
|
56 |
- } |
|
57 |
-} |
|
58 | 49 |
|
59 |
-\section{Fields}{ |
|
60 |
- \describe{ |
|
50 |
+ \item{stream}{Construct a stream from one \code{Producer} and one or |
|
51 |
+ more \code{Consumer}. See \code{?stream}.} |
|
52 |
+ |
|
53 |
+ \item{yield}{Yield a single result (e.g., \code{data.frame}) from |
|
54 |
+ the Producer.} |
|
61 | 55 |
|
62 |
- The \code{Producer} class inherits the fields \code{verbose} and |
|
63 |
- \code{inUse} fields from the \code{Streamer} class. Please refer to |
|
64 |
- the \code{\link{Streamer}} class for more details. |
|
56 |
+ \item{reset}{Reset, if possible, the Producer.} |
|
57 |
+ |
|
58 |
+ \item{lapply, sapply}{Apply \code{FUN} to each result applied to |
|
59 |
+ \code{yield()}, simplifying (using \code{simplify2array}) if |
|
60 |
+ possible for \code{sapply}. Partial results on error can be |
|
61 |
+ recovered using \code{\link{tryCatch}}, as illustrated |
|
62 |
+ below. Infinite producers will of course exhaust memory.} |
|
65 | 63 |
|
66 | 64 |
} |
67 | 65 |
} |
68 | 66 |
|
69 |
-\section{Class-Based Methods}{ |
|
70 |
- \describe{ |
|
67 |
+\section{Internal Class Fields and Methods}{ |
|
71 | 68 |
|
72 |
- The \code{Producer} class inherits the methods \code{initialize}, |
|
73 |
- \code{msg}, \code{reset}, \code{status} and \code{yield} from the |
|
74 |
- \code{Streamer} virtual class. Please refer to the |
|
75 |
- \code{\link{Streamer}} class for more details. |
|
76 |
- |
|
77 |
- Derived classes should implement an appropriate \code{initialize} |
|
78 |
- method to initialize the fields of the derived class. Additionally, |
|
79 |
- a \code{yield} method should be implemented to return the contents |
|
80 |
- of the current stream. The default method for the base virtual |
|
81 |
- \code{Streamer} class returns a \code{list()} |
|
69 |
+ Internal fields of this class are are described with, e.g., |
|
70 |
+ \code{getRefClass("Producer")$fields}. |
|
71 |
+ |
|
72 |
+ Internal methods of this class are described with |
|
73 |
+ \code{getRefClass("Producer")$methods()} and |
|
74 |
+ \code{getRefClass("Producer")$help()}. |
|
82 | 75 |
|
83 |
- } |
|
84 | 76 |
} |
85 | 77 |
|
86 | 78 |
\author{Martin Morgan \url{mtmorgan@fhcrc.org}} |
87 | 79 |
deleted file mode 100644 |
... | ... |
@@ -1,37 +0,0 @@ |
1 |
-\name{RawToChar-class} |
|
2 |
-\Rdversion{1.1} |
|
3 |
-\docType{class} |
|
4 |
-\alias{RawToChar} |
|
5 |
-\alias{RawToChar-class} |
|
6 |
- |
|
7 |
-\title{Class "RawToChar"} |
|
8 |
- |
|
9 |
-\description{ |
|
10 |
- |
|
11 |
- A \code{\linkS4class{Consumer}}-class to convert \code{raw} (binary) |
|
12 |
- records to \code{char}, applying \code{rawToChar} to each record. |
|
13 |
- |
|
14 |
-} |
|
15 |
- |
|
16 |
-\usage{RawToChar(...)} |
|
17 |
- |
|
18 |
-\arguments{ |
|
19 |
- \item{...}{Arguments passed to the \code{\linkS4class{Consumer}}-class |
|
20 |
- constructors.} |
|
21 |
-} |
|
22 |
- |
|
23 |
-\section{Constructors}{ |
|
24 |
- Use \code{RawToChar} to construct instances of this class. |
|
25 |
-} |
|
26 |
- |
|
27 |
-\section{Fields}{There are no fields unique to this class.} |
|
28 |
- |
|
29 |
-\section{Methods}{There are no methods unique to this class.} |
|
30 |
- |
|
31 |
-\author{Martin Morgan \url{mtmorgan@fhcrc.org}} |
|
32 |
- |
|
33 |
-\seealso{\code{\link{stream}}} |
|
34 |
- |
|
35 |
-\examples{showClass("RawToChar")} |
|
36 |
- |
|
37 |
-\keyword{classes} |
38 | 0 |
deleted file mode 100644 |
... | ... |
@@ -1,37 +0,0 @@ |
1 |
-\name{Rev-class} |
|
2 |
-\Rdversion{1.1} |
|
3 |
-\docType{class} |
|
4 |
-\alias{Rev} |
|
5 |
-\alias{Rev-class} |
|
6 |
- |
|
7 |
-\title{Class "Rev"} |
|
8 |
- |
|
9 |
-\description{ |
|
10 |
- |
|
11 |
- A \code{\linkS4class{Consumer}}-class to reverse the order of |
|
12 |
- records. Note that the content of the \code{yield} is reversed, and |
|
13 |
- not the entire stream. |
|
14 |
- |
|
15 |
-} |
|
16 |
- |
|
17 |
-\usage{Rev(...)} |
|
18 |
- |
|
19 |
-\arguments{ |
|
20 |
- \item{...}{Arguments passed to the \code{\linkS4class{Consumer}}-class |
|
21 |
- constructors.} |
|
22 |
-} |
|
23 |
- |
|
24 |
-\section{Constructors}{Use \code{Rev} to construct instances of this class.} |
|
25 |
- |
|
26 |
-\section{Fields}{There are no fields unique to this class.} |
|
27 |
- |
|
28 |
-\section{Methods}{There are no methods unique to this class.} |
|
29 |
- |
|
30 |
-\author{Martin Morgan \url{mtmorgan@fhcrc.org}} |
|
31 |
- |
|
32 |
-\seealso{\code{\link{stream}}} |
|
33 |
- |
|
34 |
-\examples{showClass("Rev")} |
|
35 |
- |
|
36 |
-\keyword{classes} |
|
37 |
- |
... | ... |
@@ -4,7 +4,7 @@ |
4 | 4 |
\alias{Seq-class} |
5 | 5 |
\alias{Seq} |
6 | 6 |
|
7 |
-\title{Class "Seq"} |
|
7 |
+\title{Producer class to generate (numeric) sequences} |
|
8 | 8 |
|
9 | 9 |
\description{ |
10 | 10 |
|
... | ... |
@@ -40,6 +40,8 @@ Seq(from = 1L, to=.Machine$integer.max, by = 1L, yieldSize=1L, |
40 | 40 |
Use \code{Seq} to construct instances of this class. |
41 | 41 |
} |
42 | 42 |
|
43 |
+\section{Methods}{See \code{\link{Producer}} Methods.} |
|
44 |
+ |
|
43 | 45 |
\section{Internal Class Fields and Methods}{ |
44 | 46 |
|
45 | 47 |
Internal fields of this class are are described with |
... | ... |
@@ -4,9 +4,10 @@ |
4 | 4 |
\alias{Stream-class} |
5 | 5 |
\alias{[[,Stream,numeric-method} |
6 | 6 |
\alias{length,Stream-method} |
7 |
-\alias{show,Stream-method} |
|
7 |
+\alias{lapply,Stream-method} |
|
8 |
+\alias{sapply,Stream-method} |
|
8 | 9 |
|
9 |
-\title{Class "Stream"} |
|
10 |
+\title{Class to represent a Producer and zero or more Consumers} |
|
10 | 11 |
|
11 | 12 |
\description{ |
12 | 13 |
|
... | ... |
@@ -19,45 +20,72 @@ |
19 | 20 |
|
20 | 21 |
} |
21 | 22 |
|
23 |
+\usage{ |
|
24 |
+\S4method{length}{Stream}(x) |
|
25 |
+\S4method{[[}{Stream,numeric}(x, i, j, ...) |
|
26 |
+\S4method{lapply}{Stream}(X, FUN, ...) |
|
27 |
+\S4method{sapply}{Stream}(X, FUN, ..., simplify=TRUE, USE.NAMES=TRUE) |
|
28 |
+} |
|
29 |
+ |
|
30 |
+\arguments{ |
|
31 |
+ |
|
32 |
+ \item{x, X}{An instance of class \code{Stream}.} |
|
33 |
+ |
|
34 |
+ \item{FUN}{A function to be applied to each successful \code{yield()} |
|
35 |
+ of \code{X}.} |
|
36 |
+ |
|
37 |
+ \item{i, j}{Numeric index of the ith stream element (\code{j} is |
|
38 |
+ ignored by this method).} |
|
39 |
+ |
|
40 |
+ \item{...}{For \code{lapply}, \code{sapply}, additional arguments to |
|
41 |
+ \code{FUN}.} |
|
42 |
+ |
|
43 |
+ \item{simplify}{See \code{?base::sapply}.} |
|
44 |
+ |
|
45 |
+ \item{USE.NAMES}{See \code{?base::sapply} but note that names do not |
|
46 |
+ usually make sense for instances of class \code{Producer}.} |
|
47 |
+ |
|
48 |
+} |
|
49 |
+ |
|
22 | 50 |
\section{Constructors}{ |
23 | 51 |
Instances from this class are constructed with calls to \code{stream}; |
24 | 52 |
see \code{?stream} |
25 | 53 |
} |
26 | 54 |
|
27 | 55 |
\section{Methods}{ |
28 |
- This class inherits the following methods: |
|
29 |
- \describe{ |
|
30 |
- \item{reset}{\code{signature(x = "Streamer", ...)}: see |
|
31 |
- \code{?reset}.} |
|
32 |
- \item{yield}{\code{signature(x = "Streamer", ...)}: see |
|
33 |
- \code{?yield}.} |
|
34 |
- } |
|
56 |
+ |
|
35 | 57 |
Methods defined on this class include: |
58 |
+ |
|
36 | 59 |
\describe{ |
37 |
- \item{length}{\code{signature(x = "Stream")}: the number of |
|
38 |
- components in this stream} |
|
39 |
- \item{[[}{\code{signature(x = "Stream", i = "numeric")}: The |
|
40 |
- \code{i}th component (including inputs) of this stream. } |
|
41 |
- \item{show}{\code{signature(object = "Stream")}: Display the |
|
60 |
+ |
|
61 |
+ \item{length}{The number of components in this stream.} |
|
62 |
+ |
|
63 |
+ \item{[[}{The \code{i}th component (including inputs) of this |
|
42 | 64 |
stream.} |
43 |
- } |
|
44 |
-} |
|
45 | 65 |
|
46 |
-\section{Fields}{ |
|
47 |
- \describe{ |
|
48 |
- \item{\code{inputPipe}:}{Object of class \code{ANY} ~~ } |
|
49 |
- \item{\code{verbose}:}{A \code{logical(1)} instance indicating |
|
50 |
- whether methods invoked on the class should be reported to the |
|
51 |
- user.} |
|
66 |
+ \item{yield}{Yield a single result (e.g., \code{data.frame}) from |
|
67 |
+ the stream.} |
|
68 |
+ |
|
69 |
+ \item{reset}{Reset, if possible, each component of the stream.} |
|
70 |
+ |
|
71 |
+ \item{lapply, sapply}{Apply \code{FUN} to each result applied to |
|
72 |
+ \code{yield()}, simplifying (using \code{simplify2array}) if |
|
73 |
+ possible for \code{sapply}. Partial results on error can be |
|
74 |
+ recovered using \code{\link{tryCatch}}, as illustrated |
|
75 |
+ on the help page \code{\link{Producer}}.} |
|
76 |
+ |
|
52 | 77 |
} |
78 |
+ |
|
53 | 79 |
} |
54 | 80 |
|
55 |
-\section{Class-Based Methods}{ |
|
81 |
+\section{Internal Class Fields and Methods}{ |
|
82 |
+ |
|
83 |
+ Internal fields of this class are are described with, e.g., |
|
84 |
+ \code{getRefClass("FunctionProducer")$fields}. |
|
56 | 85 |
|
57 |
- The following methods are inherited (from the corresponding class): |
|
58 |
- initialize ("Streamer"), yield ("Streamer"), msg ("Streamer"), yield |
|
59 |
- ("Consumer"), initialize ("Consumer"), reset ("Consumer"), reset |
|
60 |
- ("Streamer"), inputs ("Consumer") |
|
86 |
+ Internal methods of this class are described with |
|
87 |
+ \code{getRefClass("FunctionProducer")$methods()} and |
|
88 |
+ \code{getRefClass("FunctionProducer")$help()}. |
|
61 | 89 |
|
62 | 90 |
} |
63 | 91 |
|
... | ... |
@@ -3,7 +3,7 @@ |
3 | 3 |
\docType{class} |
4 | 4 |
\alias{Streamer-class} |
5 | 5 |
|
6 |
-\title{Class "Streamer"} |
|
6 |
+\title{Class defining methods shared by all classes} |
|
7 | 7 |
\description{ |
8 | 8 |
|
9 | 9 |
A virtual base class from which all classes in the Streamer package |
... | ... |
@@ -12,42 +12,20 @@ |
12 | 12 |
} |
13 | 13 |
|
14 | 14 |
\section{Methods}{ |
15 |
- \describe{ |
|
16 |
- \item{reset}{\code{signature(x = "Streamer")}: see \code{?reset}.} |
|
17 |
- \item{yield}{\code{signature(x = "Streamer")}: see \code{?yield}.} |
|
18 |
- } |
|
19 |
-} |
|
20 |
- |
|
21 |
-\section{Fields}{ |
|
22 |
- \describe{ |
|
23 |
- \item{\code{verbose}:}{A \code{logical(1)} instance indicating |
|
24 |
- whether methods invoked on the class should be reported to the |
|
25 |
- user.} |
|
26 |
- \item{\code{inUse}:}{ A \code{logical(1)} instance indicating whether |
|
27 |
- the object instantiated has been used in a stream.} |
|
28 |
- } |
|
29 |
-} |
|
30 | 15 |
|
31 |
-\section{Class-Based Methods}{ |
|
32 |
- \describe{ |
|
16 |
+ See \code{Stream}, \code{Producer}, and \code{Consumer} Methods. |
|
33 | 17 |
|
34 |
- \item{\code{initialize(..., verbose = FALSE)}:}{Initialize |
|
35 |
- \code{Streamer}, setting \code{verbose} and \code{inUse} fields, |
|
36 |
- returning \code{.self} invisibly.} |
|
37 |
- |
|
38 |
- \item{\code{msg(fmt, ...)}:}{Use \code{msg} to print |
|
39 |
- \code{sprintf(fmt, ...)} messages to user.} |
|
18 |
+} |
|
40 | 19 |
|
41 |
- \item{\code{reset()}:}{Reset \code{Streamer}; this default method is |
|
42 |
- a no-op.} |
|
20 |
+\section{Internal Class Fields and Methods}{ |
|
43 | 21 |
|
44 |
- \item{\code{yield()}:}{Yield default value \code{list()}.} |
|
22 |
+ Internal fields of this class are are described with, e.g., |
|
23 |
+ \code{getRefClass("Streamer")$fields}. |
|
45 | 24 |
|
46 |
- \item{\code{status()}:}{Reports the status of the \code{Streamer} |
|
47 |
- class. A \code{list} of the status of \code{verbose} and |
|
48 |
- \code{inUse} fields is returned.} |
|
25 |
+ Internal methods of this class are described with |
|
26 |
+ \code{getRefClass("Streamer")$methods()} and |
|
27 |
+ \code{getRefClass("Streamer")$help()}. |
|
49 | 28 |
|
50 |
- } |
|
51 | 29 |
} |
52 | 30 |
|
53 | 31 |
\author{Martin Morgan \url{mtmorgan@fhcrc.org}} |
... | ... |
@@ -4,7 +4,7 @@ |
4 | 4 |
\alias{Team-class} |
5 | 5 |
\alias{Team} |
6 | 6 |
|
7 |
-\title{Class \code{"Team"}} |
|
7 |
+\title{Consumer class to enable parallel evaluation} |
|
8 | 8 |
|
9 | 9 |
\description{ |
10 | 10 |
|
... | ... |
@@ -37,64 +37,17 @@ |
37 | 37 |
\section{Constructors}{ |
38 | 38 |
Use \code{Team} to contruct instances of this class. |
39 | 39 |
} |
40 |
-\section{Fields}{ |
|
41 |
- Class-specific fields, intended for internal use: |
|
42 |
- \describe{ |
|
43 | 40 |
|
44 |
- \item{\code{tasks}:}{Object of class \code{list} to contain |
|
45 |
- in-process tasks.} |
|
41 |
+\section{Methods}{See \code{\link{Consumer}} Methods.} |
|
46 | 42 |
|
47 |
- \item{\code{FUN}:}{Object of class \code{function}, the function to |
|
48 |
- be evaulated.} |
|
43 |
+\section{Internal Class Fields and Methods}{ |
|
49 | 44 |
|
50 |
- \item{\code{mc.set.seed, silent}:}{Object of class \code{logical}, |
|
51 |
- see \code{?mcparallel}.} |
|
45 |
+ Internal fields of this class are are described with, e.g., |
|
46 |
+ \code{getRefClass("Team")$fields}. |
|
52 | 47 |
|
53 |
- \item{\code{.id}:}{Object of class \code{integer}, a sequential |
|
54 |
- identifier indexing tasks that have been consumed.} |
|
55 |
- |
|
56 |
- \item{\code{.yid}:}{Object of class \code{integer}, a sequential |
|
57 |
- identifier indexing tasks that have been yielded.} |
|
58 |
- |
|
59 |
- } |
|
60 |
- |
|
61 |
- Inherited fields: see \code{\linkS4class{Consumer}}. |
|
62 |
- |
|
63 |
-} |
|
64 |
- |
|
65 |
-\section{Class-Based Methods}{ |
|
66 |
- |
|
67 |
- Intended for internal use. |
|
68 |
- \describe{ |
|
69 |
- |
|
70 |
- \item{\code{initialize(...)}:}{Initialize the task pool and task id |
|
71 |
- \code{.id} and yield id \code{.yid} indexes.} |
|
72 |
- |
|
73 |
- \item{\code{status()}:}{Status of each class; one of \sQuote{IDLE}, |
|
74 |
- \sQuote{YIELD} (computation in process), \sQuote{VALUE} (result |
|
75 |
- available), \sQuote{ERROR}, and \sQuote{DONE} (end-of-stream |
|
76 |
- recieved).} |
|
77 |
- |
|
78 |
- \item{\code{valued()}, \code{yielding()}, |
|
79 |
- \code{idle()}:}{\code{logical} vector indicating corresponding |
|
80 |
- task status.} |
|
81 |
- |
|
82 |
- \item{\code{names()}:}{Task names, derived from \code{.id}.} |
|
83 |
- |
|
84 |
- \item{\code{consume(value)}:}{Create and fork a task to process |
|
85 |
- \code{value}, obtained from the upstream yield. The task has |
|
86 |
- \code{name} equal to \code{.id} and status \sQuote{YIELD}; |
|
87 |
- \code{.id} is incremented.} |
|
88 |
- |
|
89 |
- \item{\code{collect()}:}{Collect completed tasks, updating status to |
|
90 |
- \sQuote{VALUE}, \sQuote{ERROR}, or \sQuote{DONE}.} |
|
91 |
- |
|
92 |
- \item{\code{yield()}:}{Return the next value, in the same order as |
|
93 |
- upstream.} |
|
94 |
- |
|
95 |
- \item{\code{show()}:}{Display information on the team.} |
|
96 |
- |
|
97 |
- } |
|
48 |
+ Internal methods of this class are described with |
|
49 |
+ \code{getRefClass("Team")$methods()} and |
|
50 |
+ \code{getRefClass("Team")$help()}. |
|
98 | 51 |
|
99 | 52 |
} |
100 | 53 |
|
101 | 54 |
deleted file mode 100644 |
... | ... |
@@ -1,55 +0,0 @@ |
1 |
-\name{Utility-class} |
|
2 |
-\Rdversion{1.1} |
|
3 |
-\docType{class} |
|
4 |
-\alias{Utility-class} |
|
5 |
- |
|
6 |
-\title{Class "Utility"} |
|
7 |
- |
|
8 |
-\description{ |
|
9 |
- |
|
10 |
- A virtual class containing components that are required to create light weight |
|
11 |
- \code{Consumer} classes that process data from other \code{Producer} or |
|
12 |
- \code{Consumer} classes. Users can inherit from the \code{Utility}-class to |
|
13 |
- create their own \code{Consumer}-classes that performs some operation on the |
|
14 |
- records passed down from a class upstream. The classes \code{RawToChar} and |
|
15 |
- \code{Rev} implemented in the \code{Streamer}-package derive from the |
|
16 |
- \code{Utility}-class. |
|
17 |
-} |
|
18 |
- |
|
19 |
-\section{Fields}{ |
|
20 |
- \describe{ |
|
21 |
- |
|
22 |
- The \code{Utility} class inherits the fields \code{verbose} adn |
|
23 |
- \code{inUse} fields from the \code{Streamer} class. Please refer to |
|
24 |
- the \code{\link{Streamer}} class for more details. |
|
25 |
- |
|
26 |
- The \code{Utility} class inherits the fields \code{inputPipe}, |
|
27 |
- and \code{.records} from the \code{Consumer} class. Please refer to |
|
28 |
- the \code{\linkS4class{Consumer}-class} class for more details. |
|
29 |
- } |
|
30 |
-} |
|
31 |
- |
|
32 |
-\section{Class-Based Methods}{ |
|
33 |
- \describe{ |
|
34 |
- |
|
35 |
- The \code{ConnectionProducer} class inherits the methods |
|
36 |
- \code{initialize}, \code{msg}, \code{reset}, \code{status} and |
|
37 |
- \code{yield} from the \code{Streamer} virtual class. Please refer to |
|
38 |
- the \code{\link{Streamer}} class for more details. |
|
39 |
- |
|
40 |
- Derived classes should implement an appropriate \code{yield} method to |
|
41 |
- return the contents of the current stream. The default method for the base |
|
42 |
- virtual \code{Streamer} class returns a \code{list()} |
|
43 |
- } |
|
44 |
-} |
|
45 |
- |
|
46 |
-\author{Martin Morgan \url{mtmorgan@fhcrc.org}} |
|
47 |
- |
|
48 |
-\seealso{ |
|
49 |
- \code{\link{Streamer-package}}, \code{\linkS4class{Consumer}-class}, |
|
50 |
- \code{\linkS4class{Streamer}-class}. |
|
51 |
-} |
|
52 |
- |
|
53 |
-\examples{showClass("ConnectionProducer")} |
|
54 |
- |
|
55 |
-\keyword{classes} |
56 | 0 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,65 @@ |
1 |
+\name{Utility-class} |
|
2 |
+\Rdversion{1.1} |
|
3 |
+\docType{class} |
|
4 |
+\alias{Utility-classes} |
|
5 |
+\alias{Utility-class} |
|
6 |
+\alias{RawToChar} |
|
7 |
+\alias{RawToChar-class} |
|
8 |
+\alias{Rev} |
|
9 |
+\alias{Rev-class} |
|
10 |
+ |
|
11 |
+\title{Consumer classes with simple functionality, e.g., RawToChar, Rev} |
|
12 |
+ |
|
13 |
+\description{ |
|
14 |
+ |
|
15 |
+ \code{Utility} is a virtual class containing components to create |
|
16 |
+ light weight \code{Consumer} classes. |
|
17 |
+ |
|
18 |
+ \code{RawToChar} is a class to convert \code{raw} (binary) records to |
|
19 |
+ \code{char}, applying \code{rawToChar} to each record. |
|
20 |
+ |
|
21 |
+ \code{Rev} reverses the order of current task. |
|
22 |
+ |
|
23 |
+} |
|
24 |
+ |
|
25 |
+\usage{ |
|
26 |
+RawToChar(...) |
|
27 |
+Rev(...) |
|
28 |
+} |
|
29 |
+ |
|
30 |
+\arguments{ |
|
31 |
+ |
|
32 |
+ \item{...}{Arguments passed to the |
|
33 |
+ \code{\linkS4class{Consumer}}-class.} |
|
34 |
+ |
|
35 |
+} |
|
36 |
+ |
|
37 |
+\section{Construction}{ |
|
38 |
+ |
|
39 |
+ Use constructors \code{RawToChar}, \code{Rev}. |
|
40 |
+ |
|
41 |
+} |
|
42 |
+ |
|
43 |
+\section{Methods}{See \code{\link{Consumer}} Methods.} |
|
44 |
+ |
|
45 |
+\section{Internal Class Fields and Methods}{ |
|
46 |
+ |
|
47 |
+ Internal fields of this class are are described with, e.g., |
|
48 |
+ \code{getRefClass("Utility")$fields}. |
|
49 |
+ |
|
50 |
+ Internal methods of this class are described with |
|
51 |
+ \code{getRefClass("Utility")$methods()} and |
|
52 |
+ \code{getRefClass("Utility")$help()}. |
|
53 |
+ |
|
54 |
+} |
|
55 |
+ |
|
56 |
+\author{Martin Morgan \url{mtmorgan@fhcrc.org}} |
|
57 |
+ |
|
58 |
+\seealso{ |
|
59 |
+ \code{\link{Streamer-package}}, \code{\linkS4class{Consumer}-class}, |
|
60 |
+ \code{\linkS4class{Streamer}-class}. |
|
61 |
+} |
|
62 |
+ |
|
63 |
+\examples{showClass("Utility")} |
|
64 |
+ |
|
65 |
+\keyword{classes} |
... | ... |
@@ -1,13 +1,7 @@ |
1 | 1 |
\name{connect} |
2 | 2 |
\alias{connect} |
3 | 3 |
|
4 |
-\title{ |
|
5 |
- |
|
6 |
- Connect \code{Producer} and \code{Consumer} streams together and |
|
7 |
- return a named \code{list} of \code{stream}'s that the user can invoke |
|
8 |
- the method \code{yield} on. |
|
9 |
- |
|
10 |
-} |
|
4 |
+\title{Function to create a complex stream} |
|
11 | 5 |
|
12 | 6 |
\description{ |
13 | 7 |
|