bnp

commit 0bc102f69d584cb9f751fd60dd15a56d2d4fb7e8
parent 0d0b1ad18a4140b8f8a8b9bbc3b3dde078617695
Author: Jared Tobin <jared@jtobin.ca>
Date:   Sun, 13 Mar 2016 22:18:03 +1300

Misc fixes.

Diffstat:
M
finite-gaussian-mixture/src/fmm_multivariate_generative.r
 | 
16
+++++++---------
M
finite-gaussian-mixture/src/simulation_multivariate.r
 | 
6
++++--
M
finite-gaussian-mixture/src/simulation_multivariate_conditional.r
 | 
1
+

3 files changed, 12 insertions(+), 11 deletions(-)
diff --git a/finite-gaussian-mixture/src/fmm_multivariate_generative.r b/finite-gaussian-mixture/src/fmm_multivariate_generative.r
@@ -16,21 +16,19 @@ location_model  = function(k, l, r) {
 
 precision_model = function(k, b, w) rinvwishart(k, b, solve(w))
 
-parameter_model = function(m, k, n) {
+parameter_model = function(m, k, b, n) {
   p  = mixing_model(k, 1)
   c  = label_model(n, p)
   mu = location_model(k, rep(0, m), diag(0.05, m))
-  s  = precision_model(k, 2, diag(1, m))
-  list(c, mu, s)
-  }
+  s  = precision_model(k, b, diag(1, m))
+  list(n = c, m = mu, s = s)
+}
 
 data_model = function(config) {
-  raw    = mapply(safe_rmvnorm, config[[1]], config[[2]], config[[3]])
-  frame  = function(m) data.frame(x = m[,1], y = m[,2])
-  lapply(raw, frame)
-  }
+  mapply(safe_rmvnorm, config$n, config$m, config$s)
+}
 
-model = function(m, k, n) parameter_model(m, k, n) %>% data_model
+model = function(m, k, b, n) parameter_model(m, k, b, n) %>% data_model
 
 # FIXME (jtobin): checkme, not correct
 lmodel = function(y, z, p, m, s) {
diff --git a/finite-gaussian-mixture/src/simulation_multivariate.r b/finite-gaussian-mixture/src/simulation_multivariate.r
@@ -7,12 +7,14 @@ source('fmm_multivariate_generative.r')
 
 config = list(
     m = 2
+  , v = 2
   , k = 4
   , n = 10000
   )
 
-d      = model(config$m, config$k, config$n)
-melted = melt(d, id.vars = c('x', 'y'))
+d      = model(config$m, config$k, config$v, config$n)
+framed = lapply(d, function(mat) { data.frame(x = mat[,1], y = mat[,2]) })
 
+melted = melt(framed, id.vars = c('x', 'y'))
 p = ggplot(melted, aes(x, y, colour = factor(L1))) + geom_point(alpha = 0.2)
 
diff --git a/finite-gaussian-mixture/src/simulation_multivariate_conditional.r b/finite-gaussian-mixture/src/simulation_multivariate_conditional.r
@@ -25,6 +25,7 @@ origin = list(
   , s = precision_model(config$k, config$b, config$w)
   )
 
+# FIXME generate a known/non-pathological configuration first, to test
 d = melt(model(config$m, config$k, config$n), id.vars = c('x', 'y'))
 
 set.seed(990909)