bnp

commit 4136c0236c0cba3a4bf73134602decc2d30fbebb
parent 1671a9bec6cb8fcb8d22e0064c892242d639c8ee
Author: Jared Tobin <jared@jtobin.ca>
Date:   Sun, 14 Feb 2016 16:42:07 +1300

Get model working.

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

1 file changed, 11 insertions(+), 11 deletions(-)
diff --git a/finite-gaussian-mixture/src/fmm_multivariate_generative.r b/finite-gaussian-mixture/src/fmm_multivariate_generative.r
@@ -10,32 +10,32 @@ precision_model = function(k, b, w) rinvwishart(k, b, solve(w))
 
 parameter_model = function(m, k, n) {
   p  = mixing_model(k, 1)
-
   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]])
+  mapply(safe_rmvnorm, config[[1]], config[[2]], config[[3]])
   }
 
-model = function(k, n) {
-  config = parameter_model(k, n)
+model = function(m, k, n) {
+  config = parameter_model(m, k, n)
   data_model(config)
   }
 
+# utilities
+
 rinvwishart = function(n, v, S) {
   wishes = rWishart(n, v, solve(S))
   delabel(apply(wishes, MARGIN = 3, function(x) list(solve(x))))
   }
 
 delabel = function(x) { lapply(x, "[[", 1) }
+
+safe_rmvnorm = function(c, m, s) {
+  if (c <= 0) return(numeric(0))
+  else rmvnorm(c, m, solve(s))
+  }
+