bnp

commit 1671a9bec6cb8fcb8d22e0064c892242d639c8ee
parent 3ce82bb59dacf0260fa2d458dec263a472c901b1
Author: Jared Tobin <jared@jtobin.ca>
Date:   Sat, 13 Feb 2016 09:51:52 +1300

Fixes to MVGMM.

Diffstat:
M
finite-gaussian-mixture/src/fmm_multivariate_generative.r
 | 
18
++++++++++++------

1 file changed, 12 insertions(+), 6 deletions(-)
diff --git a/finite-gaussian-mixture/src/fmm_multivariate_generative.r b/finite-gaussian-mixture/src/fmm_multivariate_generative.r
@@ -8,15 +8,21 @@ label_model     = function(n, p) drop(rmultinom(1, size = n, prob = p))
 location_model  = function(k, l, r) rmvnorm(k, l, solve(r))
 precision_model = function(k, b, w) rinvwishart(k, b, solve(w))
 
-parameter_model = function(k, n) {
+parameter_model = function(m, k, n) {
   p  = mixing_model(k, 1)
-  c  = lapply(label_model(n, p), list)
-  mu = apply(location_model(k, rep(0, k), diag(10, k)), MARGIN = 1, list)
-  s  = precision_model(k, 10, diag(1, k))
+
+  c  = delabel(lapply(label_model(n, p), list))
+
+  mu = delabel(apply(location_model(k, rep(0, m), diag(10, m)), MARGIN = 1, list))
+
+  s  = precision_model(k, 10, diag(1, m))
+
   list(c, mu, s)
   }
 
 # FIXME mapply not working here
+# want to get mapply to work on these weird structures i've cobbled together
+# mapply will work an delabelled lists
 data_model = function(config) {
   sampler = function(c, m, s) rmvnorm(c, m, solve(s))
   mapply(sampler, config[[1]], config[[2]], config[[3]])
@@ -29,7 +35,7 @@ model = function(k, n) {
 
 rinvwishart = function(n, v, S) {
   wishes = rWishart(n, v, solve(S))
-  invs   = apply(wishes, MARGIN = 3, function(x) list(solve(x)))
-  delabel(invs)
+  delabel(apply(wishes, MARGIN = 3, function(x) list(solve(x))))
   }
 
+delabel = function(x) { lapply(x, "[[", 1) }