Browse code

remove ParallelConnector and related classes

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

Martin Morgan authored on 04/09/2012 21:04:52
Showing 8 changed files

1 1
deleted file mode 100644
... ...
@@ -1,25 +0,0 @@
1
-.ParallelConnector <-
2
-    setRefClass("ParallelConnector", contains="Consumer",
3
-                fields=list(.upstream="ANY"))
4
-
5
-.ParallelConnector$methods(
6
-    yield = function() 
7
-   {  
8
-        "Read data from childProcess"
9
-        if (verbose) msg(".ParallelConnector$yield()")   
10
-        if(is(.self$inputPipe, "uninitializedField")
11
-           || is(.self$.upstream, "uninitializedField")) 
12
-        {
13
-            stop("ParallelConnector not connected to a valid stream")
14
-        
15
-        } else {
16
-        
17
-            res <- readChild(.self$.upstream)
18
-            if(is.raw(res)) unserialize(res) else res 
19
-        
20
-        }
21
-    })
22
-
23
-ParallelConnector <- function(...)
24
-    .ParallelConnector$new(...)
25
-
26 0
deleted file mode 100644
... ...
@@ -1,62 +0,0 @@
1
-## TOut
2
-
3
-.TOut <- setRefClass("TOut", 
4
-    contains="Consumer",
5
-    fields=list(.start = "numeric"))
6
-
7
-.TOut$methods(
8
-    initialize =function(...) 
9
-    {  
10
-       "initialize TOut"
11
-        callSuper(..., .start = 1L)
12
-    },
13
-    yield = function() 
14
-    {
15
-        "Calls yield on the inputPipe"
16
-        if (verbose) msg(".TOut$yield()")
17
-        inputPipe$.add(inputPipe$yield())
18
-        dat <- inputPipe$.records
19
-        inputPipe$.dump()
20
-        dat
21
-    })
22
-
23
-TOut <- function(...) .TOut$new(...)
24
-
25
-## TConnector
26
-
27
-.TConnector <- setRefClass("TConnector", 
28
-    contains = "Consumer",
29
-    fields = list(
30
-        .records = "list",
31
-        .tOuts="list"
32
-    ))
33
-    
34
-.TConnector$methods(
35
-    initialize = function(...) 
36
-    {   
37
-        "initialize TConnector"
38
-        callSuper(..., .tOuts = list())
39
-    },   
40
-    .add = function(input)
41
-    { 
42
-        ".add (incomplete) 'input'"
43
-        if (verbose) msg("TConnector$.add()")
44
-        .self$.records <- c(.records, input)
45
-        .self    
46
-    },
47
-    .dump = function() 
48
-    {    
49
-        "Clear .records that are used"
50
-        if (verbose) msg("TConnector$.dump()")
51
-        mn <- min(sapply(.tOuts, function(x) x$.start))
52
-        if (mn != 1L) {
53
-            for(i in seq_along(.tOuts))
54
-                .self$.tOuts[[i]]$.start <- .tOuts[[i]]$.start - mn +1L
55
-            .self$.records[seq_len(mn - 1L)] <- NULL
56
-        }
57
-        .self
58
-   })
59
-
60
-TConnector <- function(...) .TConnector$new(...)
61
-
62
-
63 0
deleted file mode 100644
... ...
@@ -1,32 +0,0 @@
1
-.YConnector <- setRefClass("YConnector",
2
-    contains = "Consumer",
3
-    fields = list(.upstream="list", .fun="function"
4
-    ))
5
-    
6
-.YConnector$methods(
7
-    initialize = function(..., fun) 
8
-    {
9
-        "initialize YConnector"
10
-        if(missing(fun))
11
-            fun <- function(...) as.list(...)
12
-        callSuper(..., .upstream=list(), .fun=fun)
13
-    },
14
-    yield = function() 
15
-    {
16
-        "yield data from stream"
17
-        args <- lapply(.self$.upstream, function(k) {
18
-                       k$yield()
19
-                   })
20
-        do.call(.self$.fun, args)
21
-    },
22
-    show = function()
23
-    {
24
-        callSuper()
25
-        upstream <- paste(sapply(.upstream, "class"), collapse = " ,")
26
-        upstream[!nzchar(upstream)] <- "uninitialized field"
27
-        txt <- sprintf("upstream: %s", upstream)
28
-        cat(strwrap(txt, exdent=2), sep="\n")
29
-    })
30
-
31
-YConnector <- function(fun, ...)
32
-    .YConnector$new(fun=fun, ...)
33 0
deleted file mode 100644
... ...
@@ -1,58 +0,0 @@
1
-\name{ParallelConnector-class}
2
-\Rdversion{1.1}
3
-\docType{class}
4
-\alias{ParallelConnector-class}
5
-\alias{ParallelConnector}
6
-\title{Class "ParallelConnector"}
7
-
8
-\description{
9
-
10
-  The \code{ParallelConnector} \code{\linkS4class{Consumer}}-class can
11
-  be used to parallelize the computations done by blocks directly
12
-  connected to the \code{ParallelConnector} and all blocks down-stream
13
-  to the \code{ParallelConnector}. i.e Computations performed by the
14
-  block directly connected up-stream to the \code{ParallelConnector} and
15
-  all blocks connected down-stream to the \code{ParallelConnector} in a
16
-  stream happen simultaneously.
17
-
18
-}
19
-
20
-\usage{ParallelConnector(...)}
21
-
22
-\arguments{
23
-  \item{...}{Additional arguments to be passed to the constructor.}
24
-}
25
-
26
-\section{Constructors}{
27
-  Use \code{ParallelConnector} to construct instances of this class.
28
-}
29
-
30
-\section{Fields}{
31
-  \describe{
32
-    \item{\code{.upstream}:}{Object of class \code{ANY}. The output of a
33
-      call to the \code{mcparallel} function from the
34
-      \code{parallel}-package. This field is internal to the
35
-      \code{ParallelConnector} class and will be populated by a call to
36
-      the \code{stream} method or the \code{connect} function used to
37
-      connect the \code{ParallelConnector} to other blocks in a
38
-      \code{stream}.}
39
-  }
40
-}
41
-
42
-\section{Methods}{
43
-  \describe{
44
-    \item{\code{initialize(...)}:}{Initializes the fields of the
45
-        \code{ParallelConnector} class.}
46
-    \item{\code{yield()}:}{Reads data from the child processes and converts the
47
-        result (which must be a list of \code{raw}) into a vector of
48
-        \code{character}.}
49
-  }
50
-}
51
-
52
-\author{Nishant Gopalakrishnan, Martin Morgan}
53
-
54
-\seealso{\code{\link{stream}}}
55
-
56
-\examples{showClass("ParallelConnector")}
57
-
58
-\keyword{classes}
59 0
deleted file mode 100644
... ...
@@ -1,92 +0,0 @@
1
-\name{TConnector-class}
2
-\Rdversion{1.1}
3
-\docType{class}
4
-\alias{TConnector}
5
-\alias{TConnector-class}
6
-
7
-\title{Class "TConnector"}
8
-
9
-\description{
10
-
11
-  A \code{\linkS4class{Consumer}}-class that is used to connect the
12
-  output of one stream to several \code{Consumer} \code{stream}s that
13
-  perform different operations on the records. The \code{TConnector}
14
-  manages the records supplied to it to ensure that all streams get
15
-  access to \emph{all} records passed to the TConnector.
16
-
17
-  A \code{TConnector} can be connected to other \code{Producer} and
18
-  \code{Consumer} objects using the \code{\link{connect}} function.
19
-}
20
-
21
-\usage{TConnector(...)}
22
-
23
-\arguments{
24
-  \item{...}{Arguments passed to the \code{\linkS4class{Consumer}}-class
25
-    constructors.}
26
-}
27
-
28
-\section{Constructors}{
29
-  Use \code{TConnector} to construct instances of this class.
30
-}
31
-
32
-\section{Fields}{
33
-  \describe{
34
-
35
-    \item{\code{.records}:}{ A temporary buffer used to save records
36
-      retrieved from the \code{Producer} or \code{Consumer} class
37
-      connector up-stream to the \code{TConnector}. This field is used
38
-      internally by class methods and is not intended to be manipulated
39
-      directly by the user.}
40
-
41
-    \item{\code{.tOuts}:}{A \code{list} of objects of class \code{TOut}
42
-      of length equal to the number of streams connected down-stream to
43
-      it. This field is used internally by the \code{TConnector}-class
44
-      method and not intended to be manipulated directly by the user.}
45
-
46
-   }
47
-}
48
-
49
-\section{Methods}{
50
-  \describe{
51
-
52
-    \item{\code{.add()}:}{An internal method to add records to the
53
-      internal buffer(\code{.records}).}
54
-
55
-    \item{\code{.dump()}:}{An internal method to remove records that
56
-      have been passed down to all the down-stream classes (and are no
57
-      longer needed) from the internal buffer(\code{.records}).}
58
-
59
-  }
60
-}
61
-
62
-\author{Nishant Gopalakrishnan \url{ngopalak@fhcrc.org}}
63
-
64
-\seealso{\code{\link{stream}},\code{\link{YConnector}}, \code{\link{connect}} }
65
-
66
-\examples{
67
-
68
-### Two Streams b, c1 and b, c2 connected with a Tconnector t
69
-fl <- system.file("extdata", "s_1_sequence.txt", package="Streamer")
70
-b <- RawInput(fl, 100L, reader=rawReaderFactory(1e4))
71
-### c1 and c2 return different number of records
72
-c1 <- RawToChar()
73
-c2 <- RawToChar()
74
-t <- TConnector()
75
-
76
-### Connect the blocks together using the connect function
77
-blocks <- list(b=b, c1=c1, c2=c2, t=t)
78
-df <- data.frame(from = c("b", "t", "t"), 
79
-                 to = c("t", "c1", "c2"))
80
-res <- connect(blocks, df)
81
-
82
-### yield on c2 returns 20 records 
83
-yield(res$c2)
84
-### yield on c1 returns the same records as with yield on c2 
85
-### 10 records at a time
86
-yield(res$c1)
87
-yield(res$c1)
88
-
89
-}
90
-
91
-\keyword{classes}
92
-
93 0
deleted file mode 100644
... ...
@@ -1,57 +0,0 @@
1
-\name{TOut-class}
2
-\Rdversion{1.1}
3
-\docType{class}
4
-\alias{TOut}
5
-\alias{TOut-class}
6
-
7
-\title{Class "TOut"}
8
-
9
-\description{
10
-
11
-  A \code{\linkS4class{Consumer}}-class that is used internally to connect 
12
-  several \code{Consumer} streams to a \code{TConnector}-class.
13
- 
14
-  This class is only for use by functions internal to the \code{Streamer}
15
-  package. The \code{TOut}-class is responsible for filing the \code{.records}
16
-  field of the \code{TConnector} with adequate number of records.
17
-}
18
-
19
-\usage{TOut(...)}
20
-
21
-\arguments{
22
-  \item{...}{Arguments passed to the \code{\linkS4class{Consumer}}-class
23
-    constructors.}
24
-}
25
-
26
-\section{Constructors}{
27
-  Use \code{TOut} to construct instances of this class.
28
-}
29
-
30
-\section{Fields}{
31
-  \describe{
32
-
33
-    \item{\code{.start}:}{A \code{integer(1)} indicating the start
34
-      position of the record to be read next.}
35
-
36
-  }
37
-}
38
-
39
-\section{Methods}{
40
-  \describe{
41
-
42
-    \item{\code{.add(input)}:}{Temporarily store records fro sbusequent
43
-      use.}
44
-
45
-    \item{\code{.dump()}:}{Remove records not required for subsequent
46
-      use.}
47
-  }
48
-}
49
-
50
-\author{Nishant Gopalakrishnan \url{ngopalak@fhcrc.org}}
51
-
52
-\seealso{\code{\link{TConnector}}}
53
-
54
-\examples{showClass("TOut")}
55
-
56
-\keyword{classes}
57
-
58 0
deleted file mode 100644
... ...
@@ -1,103 +0,0 @@
1
-\name{YConnector-class}
2
-\Rdversion{1.1}
3
-\docType{class}
4
-\alias{YConnector}
5
-\alias{YConnector-class}
6
-
7
-\title{Class "YConnector"}
8
-
9
-\description{
10
-
11
-  The \code{YConnector} \code{\linkS4class{Consumer}}-class can be used to 
12
-  combine the output of multiple \code{stream}'s together. The output records of
13
-  the \code{stream}'s are combined using a user supplied function (\code{fun}) 
14
-  passed to the constructor of the \code{YConnector} class. The output of the
15
-  \code{YConnector} can then be used to feed a \code{Consumer}-class connected 
16
-  down-stream to it.
17
-
18
-  The \code{YConnector} can be connector to other \code{Producer} and
19
-  \code{Consumer} objects using the \code{\link{connect}} function.
20
-
21
-}
22
-
23
-\section{Methods}{
24
-  Methods defined on this class include:
25
-  \describe{
26
-
27
-      \item{show}{\code{signature(object = "YConnector")}: Displays the
28
-        names of the up-stream components to which the
29
-        \code{YConnector}-class has been connected.}
30
-
31
-  }
32
-}
33
-
34
-\usage{YConnector(fun, ...)}
35
-
36
-\arguments{
37
-
38
-   \item{fun}{A \code{function} that is used to combine the output of
39
-     the streams connected up-stream to the \code{YConnector}. The
40
-     function \code{fun} takes named arguments. The names correspond to
41
-     the names of the objects passed to the \code{connect} function used
42
-     to connect the \code{YConnector} to up-stream \code{Streamer}
43
-     classes.}
44
-
45
-  \item{...}{Arguments passed to the \code{\linkS4class{Consumer}}-class
46
-    constructors.}
47
-
48
-}
49
-
50
-
51
-\section{Constructors}{
52
-  Use \code{YConnector} to construct instances of this class.
53
-}
54
-
55
-\section{Fields}{
56
-  \describe{
57
-
58
-    \item{\code{.fun}:}{User defined \code{function} to combine the
59
-      output of several streams. The function is applied on the named
60
-      outputs obtained by calling the \code{yield} method on the named
61
-      streams connected upstream to it.}
62
-
63
-    \item{\code{.upstream}:}{A named \code{list} of objects connected
64
-      up-stream to the \code{YConnector}-class. This field is meant to
65
-      be internal to the class and is only modified by using the
66
-      \code{connect} function to connect the \code{YConnector} to other
67
-      \code{Streamer} objects.}
68
-
69
-  }
70
-}
71
-
72
-\section{Methods}{There are no methods unique to this class.}
73
-
74
-\author{Nishant Gopalakrishnan \url{ngopalak@fhcrc.org}}
75
-
76
-\seealso{\code{\link{stream}},\code{\link{TConnector}}, \code{\link{connect}} }
77
-
78
-\examples{
79
-
80
-fl <- system.file("extdata", "s_1_sequence.txt", package="Streamer")
81
-#### Blocks for stream1 
82
-b1 <- RawInput(fl, 100L, reader=rawReaderFactory(1e4))
83
-c1 <- RawToChar()
84
-
85
-#### Blocks for stream2
86
-b2 <- RawInput(fl, 100L, reader=rawReaderFactory(1e4))
87
-c2 <- RawToChar()
88
-#### YConnector with function list for combining the blocks
89
-y <- YConnector(fun=list)
90
-
91
-blocks <- structure(list(b1,c1, b2, c2, y), 
92
-                    names = c("b1", "c1", "b2", "c2","y"))
93
-df <- data.frame(from =c("b1", "b2", "c1", "c2"), to = c("c1", "c2", "y", "y"))
94
-#### Connect the blocks using the connect function
95
-res <- connect(blocks, df)
96
-y
97
-
98
-#### Yield data from the y connector
99
-yield(res$y)
100
-}
101
-
102
-\keyword{classes}
103
-
104 0
deleted file mode 100644
... ...
@@ -1,71 +0,0 @@
1
-\name{connect}
2
-\alias{connect}
3
-
4
-\title{Function to create a complex stream}
5
-
6
-\description{
7
-
8
-  The function \code{connect} can be used to connect \code{Producer} and
9
-  \code{Consumer} components together.
10
-  
11
-  For simple streams, it may be more appropriate to use the
12
-  \code{\link{stream}} method. The \code{connect} function is useful for
13
-  connecting together more complex \code{stream}s involving classes such
14
-  as \code{YConnector}, \code{TConnector}, \code{ParallelConnector} etc
15
-  which cannot be handled by the \code{stream} method.
16
-
17
-  The \code{connect} function returns a named list of possible
18
-  \code{stream}s from the connection information provided by the
19
-  user. The user can then call \code{yield} on the streams to obtain
20
-  records.
21
-
22
-}
23
-
24
-\usage{
25
-connect(blocks, df)
26
-}
27
-
28
-\arguments{
29
-
30
-  \item{blocks}{A named list of instances of classes \code{Consumer} and
31
-    \code{Producer} to the connected together in a \code{stream}}
32
-
33
-  \item{df}{ A \code{data.frame} with two columns: "from" and "to" which
34
-    are character vectors corresponding to the names of the blocks.
35
-    Each row of \code{df} describes a connection between \code{Consumer}
36
-    or \code{Producer} blocks.}
37
-
38
-}
39
-
40
-\details{
41
-
42
-  Arguments \code{blocks} must consist of a named list of a single
43
-  \code{Producer} and zero or more \code{Consumer} components.
44
-
45
-}
46
-
47
-\value{A named \code{list} of instances of class \code{\linkS4class{Stream}}.}
48
-
49
-\author{Nishant Gopalakrishnan \url{ngopalak@fhcrc.org}}
50
-
51
-\seealso{\code{\link{yield}},\code{\link{connect}}, 
52
-    \code{\linkS4class{Stream}-class}.}
53
-
54
-\examples{
55
-###  A simple stream involving a Producer and Consumer class 
56
-fl <- system.file("extdata", "s_1_sequence.txt", package="Streamer")
57
-b <- RawInput(fl, 100L, reader=rawReaderFactory(1e4))
58
-c <- RawToChar()
59
-
60
-###  Create a named list of the blocks to be connected together
61
-blocks <- list(b=b, c=c)
62
-
63
-## Create a data.frame that describes the connection between blocks
64
-df <- data.frame(from ="b", to = "c")
65
-res <- connect(blocks, df)
66
-yield(res$c)
67
-reset(res$c)
68
-while (length(yield(res$c))) cat("tick\n")
69
-}
70
-
71
-\keyword{manip}