bnp

commit 1e2922fa9d304cacee179b2385fc3d3bf3aca0d4
parent 700c0804390b6f4bdf10dfa563e5d9cef0ea7a7d
Author: Jared Tobin <jared@jtobin.ca>
Date:   Wed, 16 Mar 2016 23:22:01 +1300

Add 1d collapsed example.

Diffstat:
M
finite-gaussian-mixture/src/fmm_multivariate_conditional_collapsed.r
 | 
11
++++++-----
A
finite-gaussian-mixture/src/sim_fmm_1d_conditional_collapsed.r
 | 
57
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++
M
finite-gaussian-mixture/src/sim_fmm_2d_conditional_collapsed.r
 | 
6
+++---

3 files changed, 66 insertions(+), 8 deletions(-)
diff --git a/finite-gaussian-mixture/src/fmm_multivariate_conditional_collapsed.r b/finite-gaussian-mixture/src/fmm_multivariate_conditional_collapsed.r
@@ -1,10 +1,11 @@
 require(mvtnorm)
 
 cluster_statistics = function(cluster, l, b, w) {
-  m        = ncol(cluster)
-  n        = nrow(cluster)
-  ybar     = colMeans(cluster)
-  centered = as.matrix(cluster) - ybar
+  mclust   = as.matrix(cluster)
+  m        = ncol(mclust)
+  n        = nrow(mclust)
+  ybar     = colMeans(mclust)
+  centered = as.matrix(mclust) - ybar
   ss       = t(centered) %*% centered
   ln       = (l + n * ybar) / (1 + n)
   tn       =
@@ -41,7 +42,7 @@ conditional_label_model = function(y, k, z, a, l, r, b, w) {
   relabel = function(i) {
     old_label  = z[i]
     val        = y[i,]
-    y_censored = y[-i,]
+    y_censored = as.matrix(y[-i,])
     z_censored = z[-i]
     n_censored = sapply(
         cluster_labels
diff --git a/finite-gaussian-mixture/src/sim_fmm_1d_conditional_collapsed.r b/finite-gaussian-mixture/src/sim_fmm_1d_conditional_collapsed.r
@@ -0,0 +1,57 @@
+require(ggplot2)
+require(gridExtra)
+require(reshape2)
+
+source('fmm_multivariate_conditional_collapsed.r')
+
+dimension = 1
+
+config = list(
+    k = 3
+  , m = dimension
+  , a = 1
+  , l = rep(0, dimension)
+  , r = diag(0.05, dimension)
+  , b = 2
+  , w = diag(1, dimension)
+  , n = 50
+  )
+
+set.seed(222)
+
+d = list(
+    as.matrix(replicate(100, rnorm(config$m, 5)))
+  , as.matrix(replicate(100, rnorm(config$m, -5)))
+  , as.matrix(replicate(200, rnorm(config$m))))
+
+dn = lapply(d, function(j) { data.frame(x = j) })
+
+m  = melt(dn, id.vars = c('x'))
+
+set.seed(990909)
+
+params = inverse_model(
+    config$n, config$k, as.matrix(m[, c('x')])
+  , config$a
+  , config$l, config$r
+  , config$b, config$w
+  )
+
+early = data.frame(x = m$x, variable = params$z[1,])
+mid   = data.frame(x = m$x, variable = params$z[round(config$n * 1 / 2),])
+late  = data.frame(x = m$x, variable = params$z[config$n - 1,])
+
+p_early =
+  ggplot(early, aes(x, colour = factor(variable), fill = factor(variable))) +
+    geom_histogram(alpha = 0.5)
+
+p_mid =
+  ggplot(mid, aes(x, colour = factor(variable), fill = factor(variable))) +
+    geom_histogram(alpha = 0.5)
+
+p_late =
+  ggplot(late, aes(x, colour = factor(variable), fill = factor(variable))) +
+    geom_histogram(alpha = 0.5)
+
+inferred_plots = grid.arrange(p_early, p_mid, p_late, ncol = 3)
+
diff --git a/finite-gaussian-mixture/src/sim_fmm_2d_conditional_collapsed.r b/finite-gaussian-mixture/src/sim_fmm_2d_conditional_collapsed.r
@@ -20,9 +20,9 @@ config = list(
 set.seed(222)
 
 d = list(
-    t(replicate(100, rnorm(2, c(5, 5))))
-  , t(replicate(100, rnorm(2, c(-5, -5))))
-  , t(replicate(200, rnorm(2))))
+    t(replicate(100, rnorm(config$m, c(5, 5))))
+  , t(replicate(100, rnorm(config$m, c(-5, -5))))
+  , t(replicate(200, rnorm(config$m))))
 dn = lapply(d, function(j) { data.frame(x = j[,1], y = j[,2]) })
 m  = melt(dn, id.vars = c('x', 'y'))