node.R 10.3 KB
Newer Older
1
2
# Testing reference classes

3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
#
#' Node
#'
#' This is a base class representing a node in a DAG. Is not intended to be used by a regular user.  Developers only here!
#'
#' @docType class
#' @name Node
#' @importFrom R6 R6Class
#' @keywords DAG node
#' @return Object of \code{\link{Node}}
#' @format Object of \code{\link{R6Class}} with methods for constructing a DAG.
#' @field parents a list of parent nodes
#' @field children a list of child nodes
#' @field name a tag name applied to the node
#' @section Methods:
#' \describe{
19
#'   \item{\code{new(parents = list(), children = list(), name)}}{creates a new \link{Node} with parent nodes, child nodes, and a name.}
20
21
22
23
24
25
#'   \item{\code{logDensity()}}{calculate the log probability density/mass function evaluated at the current node value.}
#'   \item{\code{addChild(node)}}{add \code{node} as a child.  Returns \code{node}.}
#'   \item{\code{addParent(node)}}{add \code{node} as a parent.  Returns \code{node}.}
#'   \item{\code{removeParent(name)}}{remove the parent node named \code{name}.  Returns \code{node}.}
#'   \item{\code{removeChild(name)}}{remove the child node named \code{name}.  Returns \code{node}.}
#'   }
26
27
28
Node <- R6::R6Class(
  "Node",
  public = list(
29
    name = NA,
30
31
    parents = NA,
    children = NA,
32
33
34
35
    initialize = function(parents = list(), children = list(), name) {
      self$name <- name
      self$parents <- parents
      self$children <- children
36
    },
37
38
39
40
41
42
43
44
    logDensity = function() {
      "Return the log probability density|mass function"
      1
    },
    addChild = function(node, name) {
      if(missing(name)) {
        name = node$name
      }
45
      self$children[[name]] <- node
46
      node$parents[[self$name]] <- self
47
48
      node
    },
49
50
    addParent = function(node, name) {
      if(missing(name)) name <- node$name
51
      self$parents[[name]] <- node
52
      node$children[[self$name]] <- self
53
54
55
56
57
58
59
60
61
62
63
64
65
      node
    },
    removeChild = function(name) {
      node <- self$children[[name]]
      self$children[[name]] <- NULL
      node
    },
    removeParent = function(name) {
      node <- self$parents[[name]]
      self$parents[[name]] <- NULL
      node
    }
  )
66
67
)

68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90


#' StochasticNode
#'
#' Represents a stochastic node in a DAG
#'
#' Derived from \link{Node}, please see base class documentation.
#'
#' @docType class
#' @name StochasticNode
#'
#' @importFrom R6 R6Class
#' @export
#' @keywords DAG node
#' @return Object of \code{\link{StochasticNode}}
#' @format Object of \code{\link{R6Class}} with methods for constructing a DAG.
#'
#' @field data contains the node's data
#' @section Methods:
#' \describe{
#'   \item{\code{logPosterior()}}{return the value of the log posterior distribution of the node.}
#'   \item{\code{getData()}}{returns the node's data.}
#'   }
91
92
93
94
95
96
97
98
99
100
101
102
103
StochasticNode <- R6::R6Class(
  "StochasticNode",
  inherit = Node,
  public = list(
    data = NA,
    logDensity = function()
      1,
    logPosterior = function()
      self$logDensity() + sum(sapply(self$children, function(node)
        node$logDensity())),
    getData = function()
      self$data
  )
104
105
)

106

107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
#' DataNode
#'
#' Represents a static data node in a DAG.
#'
#' Derived from \link{Node}, please see base class documentation.
#'
#' @docType class
#' @name DataNode
#'
#' @importFrom R6 R6Class
#' @export
#' @keywords DAG node
#' @return Object of \code{\link{DataNode}}
#' @format Object of \code{\link{R6Class}} with methods for constructing a DAG.
#' @field data the data
#'
#' @section Methods:
#' \describe{
#'   \item{\code{getData()}}{returns the node's data.}
#'   }
127
128
129
130
DataNode <- R6::R6Class("DataNode",
                    inherit = Node,
                    public = list(
                      data = NA,
131
132
                      initialize = function(data, name) {
                        super$initialize(name=name)
133
134
135
136
137
                        self$data <- data
                      },
                      getData = function()
                        self$data
                    )
138
139
)

140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162


#' FormulaNode
#'
#' Represents a formula node in a DAG.  Inherit from this node to specify some kind of
#' formula within the DAG, e.g. a linear predictor and/or link function.  Override the
#' FormulaNode$getData() method to apply your own function.
#'
#' Derived from \link{Node}, please see base class documentation.
#'
#' @docType class
#' @name FormulaNode
#'
#' @importFrom R6 R6Class
#' @export
#' @keywords DAG node
#' @return Object of \code{\link{FormulaNode}}
#' @format Object of \code{\link{R6Class}} with methods for constructing a DAG.
#'
#' @section Methods:
#' \describe{
#'   \item{\code{getData()}}{returns the node's transformed data.}
#'   }
163
164
165
166
167
168
169
170
171
172
173
174
FormulaNode <- R6::R6Class(
  "FormulaNode",
  inherit = Node,
  public = list(
    getData = function() {
      sapply(self$children, function(child)
        child$getData())
    },
    logDensity = function()
      sapply(self$children, function(node)
        node$logDensity())
  )
175
176
177
178
)



179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
#' PoissonNode
#'
#' Represents a Poisson distribution node in a DAG
#'
#' Derived from \link{StochasticNode}, please see base class documentation.
#'
#' @docType class
#' @name PoissonNode
#'
#' @importFrom R6 R6Class
#' @export
#' @keywords DAG node
#' @return Object of \code{\link{PoissonNode}}
#' @format Object of \code{\link{R6Class}} with methods for constructing a DAG.
#'
#' @section Methods:
#' \describe{
#'   \item{\code{new(data, lambda, offset)}}{create a PoissonNode, with mean \link{Node} \code{lambda}, and offset \link{Node} \code{offset}.}
#'   }
198
199
200
201
PoissonNode <- R6::R6Class(
  "PoissonNode",
  inherit = StochasticNode,
  public = list(
202
203
    initialize = function(data, lambda = NULL, offset = NULL, name) {
      super$initialize(name = name)
204
      self$data <- data
205
      if (!is.null(lambda))
206
        self$addParent(lambda, 'lambda')
207
      if (!is.null(offset))
208
        self$addParent(offset, 'offset')
209
210
    },
    logDensity = function() {
211
212
      lambda <- as.data.frame(sapply(self$parents,
                                     function(parent) parent$getData()))
213
      lambda <- apply(lambda, 1, prod)
214
215
216
      sum(dpois(self$data, lambda, log = T))
    }
  )
217
218
)

219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240

#' GammaNode
#'
#' Represents a Gamma distribution node in a DAG.  Requires parent nodes for shape and rate respectively as
#' specified in \link{dgamma}.
#'
#' Derived from \link{StochasticNode}, please see base class documentation.
#'
#' @docType class
#' @name GammaNode
#'
#' @importFrom R6 R6Class
#' @export
#' @keywords DAG node
#' @return Object of \code{\link{GammaNode}}
#' @format Object of \code{\link{R6Class}} with methods for constructing a DAG.
#'
#' @section Methods:
#' \describe{
#'   \item{\code{new(data, shape=1, rate=1)}}{Create a Gamma node with data \code{data} and Nodes
#'    \code{shape} and \code{rate} as specified in \link{dgamma}.}
#'   }
241
242
243
244
GammaNode <- R6::R6Class(
  "GammaNode",
  inherit = StochasticNode,
  public = list(
245
246
    initialize = function(data, shape, rate, name) {
      super$initialize(name = name)
247
      self$data <- data
248
249
250
      self$addParent(shape, 'shape')
      self$addParent(rate, 'rate')
      #self$parents <- list(shape=shape, rate=rate)
251
252
    },
    logDensity = function()
253
254
      dgamma(self$data, self$parents$shape$getData(),
             self$parents$rate$getData(), log = T)
255
  )
256
257
)

258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278

#' DirichletNode
#'
#' Represents a d-dimensional Dirichlet distribution node in a DAG.
#'
#' Derived from \link{StochasticNode}, please see base class documentation.
#'
#' @docType class
#' @name DirichletNode
#'
#' @importFrom R6 R6Class
#' @export
#' @keywords DAG node
#' @return Object of \code{\link{DirichletNode}}
#' @format Object of \code{\link{R6Class}} with methods for constructing a DAG.
#'
#' @section Methods:
#' \describe{
#'   \item{\code{new(data, alpha)}}{Create a DirichletNode with data vector \code{data} (length > 1) and parameter vector
#'    \code{alpha}}.
#'   }
279
280
281
282
DirichletNode <- R6::R6Class(
  "DirichletNode",
  inherit = StochasticNode,
  public = list(
283
284
    initialize = function(data, alpha, name) {
      super$initialize(name = name)
285
      self$data <- data
286
      self$addParent(alpha, name = 'alpha')
287
288
    },
    logDensity = function() {
289
290
      lgamma(sum(self$parents$alpha$getData())) -
        sum(lgamma(self$parents$alpha$getData())) +
291
        sum((self$parents$alpha$getData() - 1) * log(self$data))
292
293
    }
  )
294
295
)

296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314

DirichletNode2 <- R6::R6Class(
  "DirichletNode2",
  inherit = StochasticNode,
  public = list(
    initialize = function(data, alpha, name) {
      super$initialize(name = name)
      self$data <- data
      self$addParent(alpha, name='alpha')
    },
    logDensity = function() {
      sum(dgamma(self$data, shape=self$parents$alpha$getData(), rate=1, log=T))
    },
    getData = function() {
      self$data / sum(self$data)
    }
  )
)

315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337

#' DirichletProcessNode
#'
#' Represents a Dirichlet process as a single node in a DAG.
#'
#' Derived from \link{StochasticNode}, please see base class documentation.
#'
#' @docType class
#' @name DirichletProcessNode
#'
#' @importFrom R6 R6Class
#' @export
#' @keywords DAG node
#' @return Object of \code{\link{DirichletProcessNode}}
#' @format Object of \code{\link{R6Class}} with methods for constructing a DAG.
#'
#' @section Methods:
#' \describe{
#'   \item{\code{new(theta, s, alpha, base, ...)}}{Create a DirichletProcessNode with value vector
#'   \code{theta} (length > 1), initial grouping vector \code{s}, concentration parameter \code{alpha}, and
#'   base distribution \code{base}.  Base should be a distribution function (dnorm, dgamma, etc) whose parameters
#'   are specified in \code{...}.}
#'   }
338
DirichletProcessNode <- R6::R6Class( # TODO: Make this accept a generic base distribution, not just Gamma
339
340
341
342
343
344
345
  "DirichletProcessNode",
  inherit = StochasticNode,
  public = list(
    theta = NA,
    s = NA,
    base = NA,
    conc = NA,
346
347
    baseShape = NA,
    baseRate = NA,
348
    idBucket = NA,
349
    initialize = function(theta, s, alpha, base, shape, rate, name) {
350
351
      super$initialize(name = name)
      self$conc <- alpha
352
353
354
      self$base <- dgamma
      self$baseShape <- shape
      self$baseRate <- rate
355
356
      self$idBucket <- queue()
      for(i in 1:length(s)) enqueue(self$idBucket, as.character(i))
357
      keys = replicate(length(theta), dequeue(self$idBucket))
358
      self$theta <- HashTable(keys, theta)
359
      self$s <- keys[s]
360
361
    },
    getData = function()
362
      self$theta$find(self$s),
363
    getDensity = function(i)
364
      sum(self$base(self$theta$find(self$s[i]),shape=self$baseShape, rate=self$baseRate ,log = T))
365
  )
366
367
)