commit 804f7c2aac8401a4e1fb5ec153a025be49687a14
parent 309f8268dbe45adc940ffbf30209e33b644eb19a
Author: Jared Tobin <jared@jtobin.ca>
Date: Wed, 16 Mar 2016 20:26:08 +1300
Add collapsed simulation.
Diffstat:
2 files changed, 58 insertions(+), 51 deletions(-)
diff --git a/finite-gaussian-mixture/src/fmm_multivariate_conditional_collapsed.r b/finite-gaussian-mixture/src/fmm_multivariate_conditional_collapsed.r
@@ -1,6 +1,7 @@
require(mvtnorm)
cluster_statistics = function(cluster, l, b, w) {
+ m = ncol(cluster)
n = nrow(cluster)
ybar = colMeans(cluster)
centered = as.matrix(cluster) - ybar
@@ -20,9 +21,9 @@ cluster_statistics = function(cluster, l, b, w) {
# FIXME (jtobin): more efficient to cache sufficient statistics in gibbs loop
conditional_label_model = function(y, k, z, a, l, r, b, w) {
- m = ncol(y)
cluster_labels = seq(k)
rows = sample(seq(nrow(y)))
+ m = ncol(y)
initial_clusters = sapply(
cluster_labels
@@ -73,8 +74,7 @@ conditional_label_model = function(y, k, z, a, l, r, b, w) {
sapply(rows, relabel)
}
-inverse_model = function(n, y, k, a, l, r, b, w) {
- # FIXME (jtobin): add likelihood calculation
+inverse_model = function(n, k, y, a, l, r, b, w) {
gibbs = function(z0) {
list(z = conditional_label_model(y, k, z0, a, l, r, b, w))
}
@@ -88,51 +88,3 @@ inverse_model = function(n, y, k, a, l, r, b, w) {
acc
}
-
-
-# development
-
-require(reshape2) # FIXME move to sim
-require(ggplot2)
-require(gridExtra)
-
-d = list(
- t(replicate(250, rnorm(2, c(5, 5))))
- , t(replicate(250, rnorm(2, c(-5, -5))))
- , t(replicate(500, rnorm(2))))
-dn = lapply(d, function(j) { data.frame(x = j[,1], y = j[,2]) })
-m = melt(dn, id.vars = c('x', 'y'))
-
-dimension = 2
-
-config = list(
- k = 3
- , m = dimension
- , a = 1
- , l = rep(0, dimension)
- , r = diag(0.05, dimension)
- , b = 2
- , w = diag(1, dimension)
- , n = 1000
- )
-
-foo = inverse_model(100, y, 3, a, l, r, b, w)
-
-early = data.frame(x = y$x, y = y$y, variable = foo$z[1,])
-mid = data.frame(x = y$x, y = y$y, variable = foo$z[round(80),])
-late = data.frame(x = y$x, y = y$y, variable = foo$z[100 - 1,])
-
-p_early =
- ggplot(early, aes(x, y, colour = factor(variable), fill = factor(variable))) +
- geom_point(alpha = 0.5)
-
-p_mid =
- ggplot(mid, aes(x, y, colour = factor(variable), fill = factor(variable))) +
- geom_point(alpha = 0.5)
-
-p_late =
- ggplot(late, aes(x, y, value, colour = factor(variable), fill = factor(variable))) +
- geom_point(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
@@ -0,0 +1,55 @@
+require(ggplot2)
+require(gridExtra)
+require(reshape2)
+
+source('fmm_multivariate_conditional_collapsed.r')
+
+dimension = 2
+
+config = list(
+ k = 3
+ , m = dimension
+ , a = 1
+ , l = rep(0, dimension)
+ , r = diag(0.05, dimension)
+ , b = 2
+ , w = diag(1, dimension)
+ , n = 200
+ )
+
+set.seed(222)
+
+d = list(
+ t(replicate(250, rnorm(2, c(5, 5))))
+ , t(replicate(250, rnorm(2, c(-5, -5))))
+ , t(replicate(500, rnorm(2))))
+dn = lapply(d, function(j) { data.frame(x = j[,1], y = j[,2]) })
+m = melt(dn, id.vars = c('x', 'y'))
+
+set.seed(990909)
+
+params = inverse_model(
+ config$n, config$k, m[, c('x', 'y')]
+ , config$a
+ , config$l, config$r
+ , config$b, config$w
+ )
+
+early = data.frame(x = m$x, y = m$y, variable = params$z[1,])
+mid = data.frame(x = m$x, y = m$y, variable = params$z[round(config$n * 3 / 4),])
+late = data.frame(x = m$x, y = m$y, variable = params$z[config$n - 1,])
+
+p_early =
+ ggplot(early, aes(x, y, colour = factor(variable), fill = factor(variable))) +
+ geom_point(alpha = 0.5)
+
+p_mid =
+ ggplot(mid, aes(x, y, colour = factor(variable), fill = factor(variable))) +
+ geom_point(alpha = 0.5)
+
+p_late =
+ ggplot(late, aes(x, y, value, colour = factor(variable), fill = factor(variable))) +
+ geom_point(alpha = 0.5)
+
+inferred_plots = grid.arrange(p_early, p_mid, p_late, ncol = 3)
+
