Commit 530483c9 authored by Chris Jewell's avatar Chris Jewell
Browse files

Merged debugged origin/interface into Chris's local interface branch with...

Merged debugged origin/interface into Chris's local interface branch with HaldDP_Posterior factored out.

Merge branch 'interface' of fhm-chicas-code.lancs.ac.uk:jewell/sourceR-G into interface

# Conflicts:
#	R/interface.R
parents eb878fda f69b9e0d
This diff is collapsed.
......@@ -195,9 +195,10 @@ AdaptiveDirMRW <- R6::R6Class(
batchsize = NA,
node = NA,
tune = NA,
name = NA,
initialize = function(node, toupdate = function() 1:length(node$getData()),
tune = rep(0.1, length(node$getData())),
batchsize = 50) {
batchsize = 50, name = "name") {
self$toupdate = toupdate
self$naccept <- rep(0, length(node$getData()))
self$ncalls <- 0
......@@ -206,6 +207,7 @@ AdaptiveDirMRW <- R6::R6Class(
self$batchsize <- batchsize
self$tune <- tune
self$node <- node
self$name <- name
},
update = function() {
self$ncalls <- self$ncalls + 1
......@@ -312,9 +314,10 @@ AdaptiveLogDirMRW <- R6::R6Class(
batchsize = NA,
node = NA,
tune = NA,
name = NA,
initialize = function(node, toupdate = function() 1:length(node$getData()),
tune = rep(0.1, length(node$getData())),
batchsize = 50) {
batchsize = 50, name = "name") {
self$toupdate = toupdate
self$naccept <- rep(0, length(node$getData()))
self$ncalls <- rep(0, length(node$getData()))
......@@ -323,6 +326,7 @@ AdaptiveLogDirMRW <- R6::R6Class(
self$batchsize <- batchsize
self$tune <- tune
self$node <- node
self$name <- name
},
update = function() {
updIdx <- self$toupdate()
......@@ -339,6 +343,7 @@ AdaptiveLogDirMRW <- R6::R6Class(
pican <- self$node$logPosterior()
alpha <- pican - picur + log(self$node$data[j]/old_data[j])
if (is.finite(alpha) &
log(runif(1)) < alpha) {
self$acceptbatch[j] <- self$acceptbatch[j] + 1
......
......@@ -78,10 +78,8 @@ DPModel_impl <- R6::R6Class(
self$rNodes[[time]] <- list()
for (src in 1:length(Sources)) {
# Dirichlet prior on r, as a result of Dirichlet/Multinomial conjugacy on R.
a_r_full <- DataNode$new(data = a_r[, src, time] + X[, src, time], name = paste('a_r', time, src, sep = '_')) # Todo: Prior here
xcol <- R[, src, time] + 0.000001 # Added for numeric stability -- only affects starting values for r
xcol <- xcol/sum(xcol)
self$rNodes[[time]][[src]] <- DirichletNode$new(data = setNames(xcol, Type),
a_r_full <- DataNode$new(data = a_r[, src, time] + X[, src, time], name = paste('a_r', time, src, sep = '_'))
self$rNodes[[time]][[src]] <- DirichletNode$new(data = setNames(R[, src, time], Type),
alpha = a_r_full,
name = paste('r', time, src, sep = '_'))
}
......@@ -99,7 +97,7 @@ DPModel_impl <- R6::R6Class(
# Location specific alpha
alpha_tl <- DirichletNode$new(data = setNames(alpha[, time, location], Sources),
alpha = a_tl,
name = paste('alpha', time, location, sep = '_')) # Prior here
name = paste('alpha', time, location, sep = '_'))
# Construct the lambda_i node
lambdaPrime <- self$LambdaNode$new(k = k,
......
......@@ -286,7 +286,7 @@ DirichletNode <- R6::R6Class(
self$addParent(alpha, name = 'alpha')
},
logDensity = function() {
log(gtools::ddirichlet(self$data, self$parents$alpha$getData()))
sum((self$parents$alpha$getData() - 1) * log(self$data))
}
)
)
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment