bnp

Some older Bayesian nonparametrics research.
Log | Files | Refs | README | LICENSE

commit d8f134cc44b1cf1b6fde34d8427af7f43a3b06bd
parent 450b9cf54c378aec8688c6f1665e629796bfefb0
Author: Jared Tobin <jared@jtobin.ca>
Date:   Fri, 11 Mar 2016 23:24:42 +1300

Misc tweaks.

Diffstat:
Mfinite-gaussian-mixture/src/fmm_conditional.r | 2+-
Mfinite-gaussian-mixture/src/fmm_generative.r | 16++++++++++------
Mfinite-gaussian-mixture/src/fmm_multivariate_conditional.r | 9++++-----
Mfinite-gaussian-mixture/src/fmm_multivariate_generative.r | 9++++++---
Mfinite-gaussian-mixture/src/simulation_conditional.r | 4++--
Mfinite-gaussian-mixture/src/simulation_multivariate_conditional.r | 12+++++++++++-
6 files changed, 34 insertions(+), 18 deletions(-)

diff --git a/finite-gaussian-mixture/src/fmm_conditional.r b/finite-gaussian-mixture/src/fmm_conditional.r @@ -113,7 +113,7 @@ inverse_model = function(n, k, y, a, l, r, b, w) { p1 = conditional_mixing_model(y, k, z, a) m1 = conditional_location_model(y, z, s0, l, r) s1 = conditional_precision_model(y, z, m1, b, w) - l = lmodel(y, z, p1, m1, s1) + l = lmodel(y, p1, m1, s1) list(p = p1, m = m1, s = s1, z = z, l = l) } diff --git a/finite-gaussian-mixture/src/fmm_generative.r b/finite-gaussian-mixture/src/fmm_generative.r @@ -21,11 +21,15 @@ data_model = function(config) { model = function(k, n) parameter_model(k, n) %>% data_model -lmodel = function(y, z, p, m, t) { - clustered = data.frame(value = y, L1 = z) - cluster = clustered$L1 - score = log(p[cluster]) + - dnorm(clustered$value, m[cluster], sqrt(1 / p[cluster]), log = T) - sum(score) +lmodel = function(y, p, m, s) { + score = function(pr, mu, prec) { pr * dnorm(y, mu, sqrt(1 / prec)) } + by_cluster = mapply(score, p, m, s) + totalled = apply(by_cluster, MARGIN = 1, sum) + + # NOTE (jtobin): adjusted for numerical stability + small = 1.379783e-316 + adjusted = totalled + adjusted[which(adjusted == 0)] = small + sum(log(adjusted)) } diff --git a/finite-gaussian-mixture/src/fmm_multivariate_conditional.r b/finite-gaussian-mixture/src/fmm_multivariate_conditional.r @@ -88,15 +88,15 @@ conditional_precision_model = function(y, z, m, b, w) { mapply(function(i, j) drop(rWishart(1, i, j)), a, bet, SIMPLIFY = F) } +# FIXME dubious inverse_model = function(n, k, y, a, l, r, b, w) { gibbs = function(p0, m0, s0) { z = conditional_label_model(y, p0, m0, s0) p1 = conditional_mixing_model(y, k, z, a) m1 = conditional_location_model(y, z, s0, l, r) s1 = conditional_precision_model(y, z, m1, b, w) - # FIXME (jtobin): log scores - # l = lmodel(y, z, p1, m1, s1) - list(p = p1, m = m1, s = s1, z = z) # l = l) + l = lmodel(y, z, p1, m1, s1) + list(p = p1, m = m1, s = s1, z = z, l = l) } p0 = mixing_model(k, a) @@ -118,8 +118,7 @@ inverse_model = function(n, k, y, a, l, r, b, w) { # might be desirable to log some reduced ellipse dims acc$s = params$s acc$z = rbind(acc$z, params$z) - # FIXME (jtobin): log scores - # acc$l = c(acc$l, params$l) + acc$l = c(acc$l, params$l) } acc } diff --git a/finite-gaussian-mixture/src/fmm_multivariate_generative.r b/finite-gaussian-mixture/src/fmm_multivariate_generative.r @@ -32,12 +32,15 @@ data_model = function(config) { model = function(m, k, n) parameter_model(m, k, n) %>% data_model -# FIXME (jtobin): checkme -lmodel = function(y, z, p, m, t) { +# FIXME (jtobin): checkme, not correct +lmodel = function(y, z, p, m, s) { + clustered = cbind(y, L1 = z) cluster = clustered$L1 + score = log(p[cluster]) + - dmvnorm(clustered$value, m[cluster], solve(p[cluster]), log = T) + dmvnorm(clustered$value, m[cluster], solve(s[cluster]), log = T) + sum(score) } diff --git a/finite-gaussian-mixture/src/simulation_conditional.r b/finite-gaussian-mixture/src/simulation_conditional.r @@ -51,8 +51,8 @@ pm = ggplot(dm, aes(x = seq_along(value), y = value, colour = variable)) + ps = ggplot(ds, aes(x = seq_along(value), y = log(value), colour = variable)) + geom_line() -pl = ggplot(dl, aes(x = seq_along(value), y = value, colour = variable)) + - geom_line() +pl = ggplot(dl, aes(x = seq_along(value), y = value)) + + geom_line(colour = 'darkblue') early = data.frame(value = d$value, variable = params$z[1,]) mid = data.frame(value = d$value, variable = params$z[round(config$n / 2),]) diff --git a/finite-gaussian-mixture/src/simulation_multivariate_conditional.r b/finite-gaussian-mixture/src/simulation_multivariate_conditional.r @@ -1,4 +1,4 @@ -set.seed(990909) +set.seed(222) require(ggplot2) require(gridExtra) @@ -36,3 +36,13 @@ params = inverse_model( , config$b, config$w ) + +m_ts_plot = function(j) { + melted = as.data.frame(j, id.vars = c('V1', 'V2')) + ggplot( + melted + , aes(x = V1, y = V2, alpha = seq_along(V1), colour = seq_along(V1))) + + geom_line() + xlim(-2, 2) + ylim(-10, 10) +} + +