commit 2bb381165c2f8cfe2d288ade99d0cb315693341d
parent 91462bdb6e14d280a1f89d2d3c4f7d1b873177b1
Author: Jared Tobin <jared@jtobin.ca>
Date: Tue, 15 Mar 2016 18:53:10 +1300
Reorg.
Diffstat:
11 files changed, 296 insertions(+), 216 deletions(-)
diff --git a/finite-gaussian-mixture/demo/sim_fmm_1d.r b/finite-gaussian-mixture/demo/sim_fmm_1d.r
@@ -0,0 +1,18 @@
+require(ggplot2)
+require(reshape2)
+
+source('../src/fmm_generative.r')
+
+config = list(
+ k = 4
+ , n = 10000
+ )
+
+set.seed(42)
+
+d = model(config$k, config$n)
+melted = melt(d)
+
+p = ggplot(melted, aes(value, colour = factor(L1), fill = factor(L1))) +
+ geom_density(alpha = 0.5)
+
diff --git a/finite-gaussian-mixture/demo/sim_fmm_1d_conditional.r b/finite-gaussian-mixture/demo/sim_fmm_1d_conditional.r
@@ -0,0 +1,74 @@
+require(ggplot2)
+require(gridExtra)
+require(reshape2)
+
+source('../src/fmm_conditional.r')
+
+config = list(
+ k = 3
+ , a = 1
+ , l = 0
+ , r = 0.01
+ , b = 1
+ , w = 1
+ , n = 500
+ )
+
+origin = list(
+ p = mixing_model(config$k, config$a)
+ , m = location_model(config$k, config$l, config$r)
+ , s = precision_model(config$k, config$b, config$w)
+ )
+
+set.seed(990909)
+
+d = data.frame(
+ value = c(rnorm(250, -3, 0.25), rnorm(500, 0, 0.25), rnorm(250, 3, 0.25)))
+
+set.seed(990909)
+
+params = inverse_model(
+ config$n, config$k, d$value
+ , config$a, config$l, config$r
+ , config$b, config$w
+ )
+
+dp = melt(as.data.frame(params$p))
+dm = melt(as.data.frame(params$m))
+ds = melt(as.data.frame(params$s))
+dl = melt(as.data.frame(params$l))
+
+py = ggplot(d, aes(value)) + geom_histogram(alpha = 0.5, fill = 'darkblue')
+
+pp = ggplot(dp, aes(x = seq_along(value), y = value, colour = variable)) +
+ geom_line()
+
+pm = ggplot(dm, aes(x = seq_along(value), y = value, colour = variable)) +
+ geom_line()
+
+ps = ggplot(ds, aes(x = seq_along(value), y = log(value), colour = variable)) +
+ geom_line()
+
+pl = ggplot(dl, aes(x = seq_along(value), y = value)) +
+ geom_line(colour = 'darkblue')
+
+early = data.frame(value = d$value, variable = params$z[1,])
+mid = data.frame(value = d$value, variable = params$z[round(config$n / 2),])
+late = data.frame(value = d$value, variable = params$z[config$n - 1,])
+
+p_early =
+ ggplot(early, aes(value, colour = factor(variable), fill = factor(variable))) +
+ geom_histogram(alpha = 0.5)
+
+p_mid =
+ ggplot(mid, aes(value, colour = factor(variable), fill = factor(variable))) +
+ geom_histogram(alpha = 0.5)
+
+p_late =
+ ggplot(late, aes(value, colour = factor(variable), fill = factor(variable))) +
+ geom_histogram(alpha = 0.5)
+
+chain_plots = grid.arrange(py, pp, pm, ps, nrow = 2, ncol = 2)
+
+inferred_plots = grid.arrange(py, p_early, p_mid, p_late, nrow = 2, ncol = 2)
+
diff --git a/finite-gaussian-mixture/demo/sim_fmm_2d.r b/finite-gaussian-mixture/demo/sim_fmm_2d.r
@@ -0,0 +1,28 @@
+require(ggplot2)
+require(reshape2)
+
+source('../src/fmm_multivariate_generative.r')
+
+dimension = 2
+
+config = list(
+ k = 4
+ , l = rep(0, dimension)
+ , r = diag(0.05, dimension)
+ , b = dimension
+ , w = diag(1, dimension)
+ , n = 10000
+ )
+
+set.seed(42)
+
+d = model(
+ config$k, config$l, config$r
+ , config$b, config$w, 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/demo/sim_fmm_2d_conditional.r b/finite-gaussian-mixture/demo/sim_fmm_2d_conditional.r
@@ -0,0 +1,72 @@
+require(ggplot2)
+require(gridExtra)
+require(reshape2)
+
+source('../src/fmm_multivariate_conditional.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 = 1000
+ )
+
+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
+ )
+
+dp = melt(data.frame(params$p))
+dm = melt(lapply(params$m, data.frame), id.vars = c('x', 'y'))
+
+py = ggplot(m, aes(x, y)) + geom_point()
+
+pp = ggplot(dp, aes(seq_along(value), value, colour = variable)) +
+ geom_line() + facet_grid(. ~ variable)
+
+pm = ggplot(dm, aes(x, y, colour = factor(L1), fill = factor(L1))) +
+ geom_point(alpha = 0.5)
+
+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 / 2),])
+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)
+
+mean_convergence_plots =
+ ggplot(dm, aes(x, y, colour = factor(L1), fill = factor(L1))) +
+ geom_point(alpha = 0.2) + facet_grid(. ~ L1)
+
+chain_plots = grid.arrange(pp, mean_convergence_plots, nrow = 2)
+
+inferred_plots = grid.arrange(py, p_early, p_mid, p_late, nrow = 2, ncol = 2)
+
diff --git a/finite-gaussian-mixture/demo/sim_fmm_3d.r b/finite-gaussian-mixture/demo/sim_fmm_3d.r
@@ -0,0 +1,29 @@
+require(reshape2)
+require(scatterplot3d)
+
+source('../src/fmm_multivariate_generative.r')
+
+dimension = 3
+
+config_3d = list(
+ k = 4
+ , l = rep(0, dimension)
+ , r = diag(0.05, dimension)
+ , b = dimension
+ , w = diag(1, dimension)
+ , n = 10000
+ )
+
+set.seed(42)
+
+d_3d = model(
+ config_3d$k, config_3d$l, config_3d$r
+ , config_3d$b, config_3d$w, config_3d$n
+ )
+
+framed_3d = lapply(d_3d,
+ function(mat) { data.frame(x = mat[,1], y = mat[,2], z = mat[,3]) })
+melted_3d = do.call(rbind, framed_3d)
+
+scatterplot3d(melted_3d, highlight.3d = T, pch = 19)
+
diff --git a/finite-gaussian-mixture/demo/sim_fmm_3d_conditional.r b/finite-gaussian-mixture/demo/sim_fmm_3d_conditional.r
@@ -0,0 +1,73 @@
+require(ggplot2)
+require(gridExtra)
+require(reshape2)
+
+source('../src/fmm_multivariate_conditional.r')
+
+dimension = 3
+
+config = list(
+ k = 3
+ , m = dimension
+ , a = 1
+ , l = rep(0, dimension)
+ , r = diag(0.05, dimension)
+ , b = dimension
+ , w = diag(1, dimension)
+ , n = 5000
+ )
+
+set.seed(222)
+
+d = list(
+ t(replicate(250, rnorm(config$m, c(5, 5))))
+ , t(replicate(250, rnorm(config$m, c(-5, -5))))
+ , t(replicate(500, rnorm(config$m))))
+dn = lapply(d, function(j) { data.frame(x = j[,1], y = j[,2], z = j[,3]) })
+m = melt(dn, id.vars = c('x', 'y', 'z'))
+
+set.seed(990909)
+
+params = inverse_model(
+ config$n, config$k, m[, c('x', 'y', 'z')]
+ , config$a
+ , config$l, config$r
+ , config$b, config$w
+ )
+
+dp = melt(data.frame(params$p))
+
+dm = melt(lapply(params$m, data.frame), id.vars = c('x', 'y', 'z'))
+
+py = ggplot(m, aes(x, y)) + geom_point()
+
+pp = ggplot(dp, aes(seq_along(value), value, colour = variable)) +
+ geom_line() + facet_grid(. ~ variable)
+
+pm = ggplot(dm, aes(x, y, colour = factor(L1), fill = factor(L1))) +
+ geom_point(alpha = 0.5)
+
+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 / 2),])
+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)
+
+mean_convergence_plots =
+ ggplot(dm, aes(x, y, colour = factor(L1), fill = factor(L1))) +
+ geom_point(alpha = 0.2) + facet_grid(. ~ L1)
+
+chain_plots = grid.arrange(pp, mean_convergence_plots, nrow = 2)
+
+inferred_plots = grid.arrange(py, p_early, p_mid, p_late, nrow = 2, ncol = 2)
+
diff --git a/finite-gaussian-mixture/src/fmm_multivariate_conditional.r b/finite-gaussian-mixture/src/fmm_multivariate_conditional.r
@@ -100,7 +100,8 @@ inverse_model = function(n, k, y, a, l, r, b, w) {
, s = precision_model(k, b, w)
)
- acc = params
+ acc = params
+ acc$s = list(acc$s)
for (j in seq(n - 1)) {
params = gibbs(params$p, params$m, params$s)
diff --git a/finite-gaussian-mixture/src/simulation.r b/finite-gaussian-mixture/src/simulation.r
@@ -1,18 +0,0 @@
-set.seed(42)
-
-require(ggplot2)
-require(reshape2)
-
-source('fmm_generative.r')
-
-config = list(
- k = 4
- , n = 10000
- )
-
-d = model(config$k, config$n)
-melted = melt(d)
-
-p = ggplot(melted, aes(value, colour = factor(L1), fill = factor(L1))) +
- geom_density(alpha = 0.5)
-
diff --git a/finite-gaussian-mixture/src/simulation_conditional.r b/finite-gaussian-mixture/src/simulation_conditional.r
@@ -1,74 +0,0 @@
-set.seed(990909)
-
-require(ggplot2)
-require(gridExtra)
-require(reshape2)
-
-source('fmm_conditional.r')
-
-config = list(
- k = 3
- , a = 1
- , l = 0
- , r = 0.01
- , b = 1
- , w = 1
- , n = 500
- )
-
-origin = list(
- p = mixing_model(config$k, config$a)
- , m = location_model(config$k, config$l, config$r)
- , s = precision_model(config$k, config$b, config$w)
- )
-
-d = data.frame(
- value = c(rnorm(250, -3, 0.25), rnorm(500, 0, 0.25), rnorm(250, 3, 0.25)))
-
-set.seed(990909)
-
-params = inverse_model(
- config$n, config$k, d$value
- , config$a, config$l, config$r
- , config$b, config$w
- )
-
-dp = melt(as.data.frame(params$p))
-dm = melt(as.data.frame(params$m))
-ds = melt(as.data.frame(params$s))
-dl = melt(as.data.frame(params$l))
-
-py = ggplot(d, aes(value)) + geom_histogram(alpha = 0.5, fill = 'darkblue')
-
-pp = ggplot(dp, aes(x = seq_along(value), y = value, colour = variable)) +
- geom_line()
-
-pm = ggplot(dm, aes(x = seq_along(value), y = value, colour = variable)) +
- geom_line()
-
-ps = ggplot(ds, aes(x = seq_along(value), y = log(value), colour = variable)) +
- geom_line()
-
-pl = ggplot(dl, aes(x = seq_along(value), y = value)) +
- geom_line(colour = 'darkblue')
-
-early = data.frame(value = d$value, variable = params$z[1,])
-mid = data.frame(value = d$value, variable = params$z[round(config$n / 2),])
-late = data.frame(value = d$value, variable = params$z[config$n - 1,])
-
-p_early =
- ggplot(early, aes(value, colour = factor(variable), fill = factor(variable))) +
- geom_histogram(alpha = 0.5)
-
-p_mid =
- ggplot(mid, aes(value, colour = factor(variable), fill = factor(variable))) +
- geom_histogram(alpha = 0.5)
-
-p_late =
- ggplot(late, aes(value, colour = factor(variable), fill = factor(variable))) +
- geom_histogram(alpha = 0.5)
-
-chain_plots = grid.arrange(py, pp, pm, ps, nrow = 2, ncol = 2)
-
-inferred_plots = grid.arrange(py, p_early, p_mid, p_late, nrow = 2, ncol = 2)
-
diff --git a/finite-gaussian-mixture/src/simulation_multivariate.r b/finite-gaussian-mixture/src/simulation_multivariate.r
@@ -1,51 +0,0 @@
-require(ggplot2)
-require(reshape2)
-require(scatterplot3d)
-
-source('fmm_multivariate_generative.r')
-
-# 2d example
-
-config = list(
- k = 4
- , l = rep(0, 2)
- , r = diag(0.05, 2)
- , b = 2
- , w = diag(1, 2)
- , n = 10000
- )
-
-set.seed(42)
-
-d = model(
- config$k, config$l, config$r
- , config$b, config$w, 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)
-
-# 3d example
-
-config_3d = list(
- k = 4
- , l = rep(0, 3)
- , r = diag(0.05, 3)
- , b = 3
- , w = diag(1, 3)
- , n = 10000
- )
-
-set.seed(42)
-
-d_3d = model(
- config_3d$k, config_3d$l, config_3d$r
- , config_3d$b, config_3d$w, config_3d$n
- )
-
-framed_3d = lapply(d_3d,
- function(mat) { data.frame(x = mat[,1], y = mat[,2], z = mat[,3]) })
-melted_3d = do.call(rbind, framed_3d)
-scatterplot3d(melted_3d, highlight.3d = T, pch = 19)
-
diff --git a/finite-gaussian-mixture/src/simulation_multivariate_conditional.r b/finite-gaussian-mixture/src/simulation_multivariate_conditional.r
@@ -1,72 +0,0 @@
-require(ggplot2)
-require(gridExtra)
-require(reshape2)
-
-source('fmm_multivariate_conditional.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 = 1000
- )
-
-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
- )
-
-dp = melt(data.frame(params$p))
-dm = melt(lapply(params$m, data.frame), id.vars = c('x', 'y'))
-
-py = ggplot(m, aes(x, y)) + geom_point()
-
-pp = ggplot(dp, aes(seq_along(value), value, colour = variable)) +
- geom_line() + facet_grid(. ~ variable)
-
-pm = ggplot(dm, aes(x, y, colour = factor(L1), fill = factor(L1))) +
- geom_point(alpha = 0.5)
-
-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 / 2),])
-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)
-
-mean_convergence_plots =
- ggplot(dm, aes(x, y, colour = factor(L1), fill = factor(L1))) +
- geom_point(alpha = 0.2) + facet_grid(. ~ L1)
-
-chain_plots = grid.arrange(pp, mean_convergence_plots, nrow = 2)
-
-inferred_plots = grid.arrange(py, p_early, p_mid, p_late, nrow = 2, ncol = 2)
-
