Browse code

FunctionProducer, FunctionConsumer classes

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/Streamer@68813 bc3139a8-67e5-0310-9ffc-ced21a209358

Martin Morgan authored on 25/08/2012 22:58:00
Showing 4 changed files

1 1
new file mode 100644
... ...
@@ -0,0 +1,65 @@
1
+## FunctionProducer
2
+
3
+.FunctionProducer <- 
4
+    setRefClass("FunctionProducer",
5
+        contains = "Producer",
6
+        fields = list(FUN = "function", RESET="function", state="ANY"))
7
+ 
8
+.FunctionProducer$methods(
9
+    reset = function()
10
+    {
11
+        "reset FunctionProducer"
12
+        if (verbose) msg("FunctionProducer$reset")
13
+        RESET(state)
14
+    },
15
+    yield = function()
16
+    {
17
+        "yield data from FunctionProducer"
18
+        if (verbose) msg("FunctionProducer$yield")
19
+        FUN()
20
+    })
21
+
22
+FunctionProducer <-
23
+    function(FUN, RESET, ..., state = NULL)
24
+{
25
+    if (missing(FUN))
26
+        FUN <- function() logical()
27
+    if (missing(RESET))
28
+        RESET = function(state)
29
+            stop("'reset()' not implemented for this FunctionProducer",
30
+                 call. = FALSE)
31
+    .FunctionProducer$new(FUN=FUN, RESET=RESET, state=state, ...)
32
+}
33
+
34
+## FunctionConsumer
35
+
36
+.FunctionConsumer <- 
37
+    setRefClass("FunctionConsumer",
38
+        contains = "Consumer",
39
+        fields = list(FUN = "function", RESET="function", state="ANY")) 
40
+ 
41
+.FunctionConsumer$methods(
42
+    reset = function()
43
+    {
44
+        "reset FunctionConsumer"
45
+        if (verbose) msg("FunctionConsumer$reset")
46
+        RESET(state)
47
+    },
48
+    yield = function()
49
+    {
50
+        "yield data from FunctionConsumer"
51
+        if (verbose) msg("FunctionConsumer$yield")
52
+        FUN(callSuper())
53
+    })
54
+
55
+FunctionConsumer <- function(FUN, RESET, ..., state=NULL)
56
+{
57
+    if (missing(FUN))
58
+        FUN = function(y) y
59
+    if (missing(RESET))
60
+        RESET = function(state)
61
+            stop("'reset()' no implemented for this FunctionConsumer",
62
+                 call.=FALSE)
63
+    .FunctionConsumer$new(FUN=FUN, RESET=RESET, state=state, ...)
64
+}
65
+
0 66
deleted file mode 100644
... ...
@@ -1,23 +0,0 @@
1
-.UserFunction <- 
2
-    setRefClass("UserFunction",
3
-        contains = "Consumer",
4
-        fields = list(FUN = "function")) 
5
- 
6
-.UserFunction$methods(
7
-    initialize = function(..., FUN)
8
-    {
9
-        "initialize myCons"
10
-        callSuper(..., FUN=FUN)
11
-    },
12
-    yield = function()
13
-    {
14
-        "yield data from UserFunction"
15
-        if (verbose) msg("UserFunction$yield")
16
-        FUN(callSuper())
17
-    })
18
-
19
-UserFunction <- function(FUN, ...)
20
-{
21
-    .UserFunction$new(FUN=FUN,...)
22
-}
23
-
24 0
new file mode 100644
... ...
@@ -0,0 +1,101 @@
1
+\name{FunctionProducerConsumer-classes}
2
+\Rdversion{1.1}
3
+\docType{class}
4
+
5
+\alias{FunctionProducerConsumer-classes}
6
+\alias{FunctionProducer}
7
+\alias{FunctionProducer-class}
8
+\alias{FunctionConsumer}
9
+\alias{FunctionConsumer-class}
10
+
11
+\title{Classes to create Producers and Consumers from functions}
12
+
13
+\description{
14
+
15
+  The \code{FunctionProducer} and \code{FunctionConsumer} classes
16
+  provide an easy way to quickly create \code{Producer} and
17
+  \code{Consumer} instances from user-provided functions.
18
+
19
+}
20
+
21
+\usage{
22
+FunctionProducer(FUN, RESET, ..., state=NULL)
23
+FunctionConsumer(FUN, RESET, ..., state=NULL)
24
+}
25
+
26
+\arguments{
27
+
28
+  \item{FUN}{User defined function to yield successive records in the
29
+    stream. The \code{FunctionProducer} function must return an object
30
+    of length 0 (e.g., \code{logical(0)}) when the stream is complete.}
31
+
32
+  \item{RESET}{An optional function of one arugment (\sQuote{state}) to
33
+    reset the stream to its original state. If missing, the stream
34
+    cannot be reset.}
35
+
36
+  \item{...}{Arguments passed to the \code{\linkS4class{Producer}}-class
37
+    or \code{\linkS4class{Consumer}}-class constructors.}
38
+
39
+  \item{state}{Any information, made available to \code{RESET}.}
40
+
41
+}
42
+
43
+\section{Constructors}{
44
+
45
+  Use \code{FunctionProducer} or \code{FunctionConsumer} to construct
46
+  instances of this class.
47
+
48
+}
49
+
50
+\section{Methods}{
51
+
52
+  See \code{\link{Producer}} and \code{\link{Consumer}} Methods.
53
+
54
+}
55
+
56
+\section{Internal Class Fields and Methods}{
57
+
58
+  Internal fields of this class are are described with, e.g.,
59
+  \code{getRefClass("FunctionProducer")$fields}.
60
+
61
+  Internal methods of this class are described with
62
+  \code{getRefClass("FunctionProducer")$methods()} and
63
+  \code{getRefClass("FunctionProducer")$help()}.
64
+
65
+}
66
+
67
+\author{Nishant Gopalakrishnan \url{ngopalak@fhcrc.org}}
68
+
69
+\seealso{\code{\link{stream}}}
70
+
71
+\examples{
72
+## A ProducerFunction
73
+producerFun <- function() 
74
+    ## produce the mean of 10 random uniform numbers
75
+    ## stop when the mean is greater than 0.8
76
+{
77
+    x <- mean(runif(10))
78
+    if (x > .8) numeric(0) else x
79
+}
80
+randomSampleMeans <- FunctionProducer(producerFun)
81
+result <- sapply(randomSampleMeans, c)
82
+length(result)
83
+head(result)
84
+
85
+## A FunctionConsumer:
86
+consumerFun <- function(y)
87
+    ## transform input by -10 log10
88
+{
89
+    -10 * log10(y)
90
+}
91
+
92
+neg10log10 <- FunctionConsumer(consumerFun)
93
+
94
+strm <- stream(randomSampleMeans, neg10log10)
95
+result <- sapply(strm, c)
96
+length(result)
97
+head(result)
98
+}
99
+
100
+\keyword{classes}
101
+
0 102
deleted file mode 100644
... ...
@@ -1,69 +0,0 @@
1
-\name{UserFunction-class}
2
-\Rdversion{1.1}
3
-\docType{class}
4
-\alias{UserFunction}
5
-\alias{UserFunction-class}
6
-
7
-\title{Class "UserFunction"}
8
-
9
-\description{
10
-
11
-  The \code{UserFunction} class is provided as a convenience class enabling
12
-  users to quickly create \code{Consumer}-classes that can be added to a stream
13
-  without having to go into more complex details about the implementation of the 
14
-  classes hierarchy provided by the \code{Streamer}-package.
15
-
16
-  The users pass in a function \code{fun} to the constructor of the
17
-  \code{UserFunction}-class to manipulate the records returned by
18
-  the class intended to be connected upstream. The constructor returns an
19
-  instance of the \code{UserFunction}-class with a with a
20
-  \code{yield} method that the user can directly invoke.
21
-}
22
-
23
-\usage{UserFunction(FUN, ...)}
24
-
25
-\arguments{
26
-   \item{FUN}{User defined function that operates on records yielded by the class
27
-       connected upstream.}
28
-  \item{...}{Arguments passed to the \code{\linkS4class{Consumer}}-class
29
-    constructors.}
30
-}
31
-
32
-\section{Constructors}{
33
-  Use \code{UserFunction} to construct instances of this class.
34
-}
35
-
36
-\section{Fields}{
37
-  \describe{
38
-
39
-    \item{\code{.FUN}:}{A user supplied\code{function} that operates on
40
-      records yielded by the class connected up-stream. }
41
-
42
-    }
43
-}
44
-
45
-\section{Methods}{There are no methods unique to this class.}
46
-
47
-\author{Nishant Gopalakrishnan \url{ngopalak@fhcrc.org}}
48
-
49
-\seealso{\code{\link{stream}}}
50
-
51
-\examples{
52
-f <- system.file("extdata", "s_1_sequence.txt", package="Streamer")
53
-b <- RawInput(f, 100L, reader=rawReaderFactory(1e4))
54
-### Create a user defined function to convert raw bytes to character
55
-myFun <- function(x) {
56
-    sapply(x, rawToChar)
57
-}
58
-
59
-#### Pass the function to the UserFunction constructor
60
-d <- UserFunction(myFun)
61
-
62
-#### Create a stream
63
-s <- stream(b, d)
64
-yield(s)
65
-
66
-}
67
-
68
-\keyword{classes}
69
-