commit d8f134cc44b1cf1b6fde34d8427af7f43a3b06bd
parent 450b9cf54c378aec8688c6f1665e629796bfefb0
Author: Jared Tobin <jared@jtobin.ca>
Date: Fri, 11 Mar 2016 23:24:42 +1300
Misc tweaks.
Diffstat:
6 files changed, 34 insertions(+), 18 deletions(-)
diff --git a/finite-gaussian-mixture/src/fmm_conditional.r b/finite-gaussian-mixture/src/fmm_conditional.r
@@ -113,7 +113,7 @@ inverse_model = function(n, k, y, a, l, r, b, w) {
p1 = conditional_mixing_model(y, k, z, a)
m1 = conditional_location_model(y, z, s0, l, r)
s1 = conditional_precision_model(y, z, m1, b, w)
- l = lmodel(y, z, p1, m1, s1)
+ l = lmodel(y, p1, m1, s1)
list(p = p1, m = m1, s = s1, z = z, l = l)
}
diff --git a/finite-gaussian-mixture/src/fmm_generative.r b/finite-gaussian-mixture/src/fmm_generative.r
@@ -21,11 +21,15 @@ data_model = function(config) {
model = function(k, n) parameter_model(k, n) %>% data_model
-lmodel = function(y, z, p, m, t) {
- clustered = data.frame(value = y, L1 = z)
- cluster = clustered$L1
- score = log(p[cluster]) +
- dnorm(clustered$value, m[cluster], sqrt(1 / p[cluster]), log = T)
- sum(score)
+lmodel = function(y, p, m, s) {
+ score = function(pr, mu, prec) { pr * dnorm(y, mu, sqrt(1 / prec)) }
+ by_cluster = mapply(score, p, m, s)
+ totalled = apply(by_cluster, MARGIN = 1, sum)
+
+ # NOTE (jtobin): adjusted for numerical stability
+ small = 1.379783e-316
+ adjusted = totalled
+ adjusted[which(adjusted == 0)] = small
+ sum(log(adjusted))
}
diff --git a/finite-gaussian-mixture/src/fmm_multivariate_conditional.r b/finite-gaussian-mixture/src/fmm_multivariate_conditional.r
@@ -88,15 +88,15 @@ conditional_precision_model = function(y, z, m, b, w) {
mapply(function(i, j) drop(rWishart(1, i, j)), a, bet, SIMPLIFY = F)
}
+# FIXME dubious
inverse_model = function(n, k, y, a, l, r, b, w) {
gibbs = function(p0, m0, s0) {
z = conditional_label_model(y, p0, m0, s0)
p1 = conditional_mixing_model(y, k, z, a)
m1 = conditional_location_model(y, z, s0, l, r)
s1 = conditional_precision_model(y, z, m1, b, w)
- # FIXME (jtobin): log scores
- # l = lmodel(y, z, p1, m1, s1)
- list(p = p1, m = m1, s = s1, z = z) # l = l)
+ l = lmodel(y, z, p1, m1, s1)
+ list(p = p1, m = m1, s = s1, z = z, l = l)
}
p0 = mixing_model(k, a)
@@ -118,8 +118,7 @@ inverse_model = function(n, k, y, a, l, r, b, w) {
# might be desirable to log some reduced ellipse dims
acc$s = params$s
acc$z = rbind(acc$z, params$z)
- # FIXME (jtobin): log scores
- # acc$l = c(acc$l, params$l)
+ acc$l = c(acc$l, params$l)
}
acc
}
diff --git a/finite-gaussian-mixture/src/fmm_multivariate_generative.r b/finite-gaussian-mixture/src/fmm_multivariate_generative.r
@@ -32,12 +32,15 @@ data_model = function(config) {
model = function(m, k, n) parameter_model(m, k, n) %>% data_model
-# FIXME (jtobin): checkme
-lmodel = function(y, z, p, m, t) {
+# FIXME (jtobin): checkme, not correct
+lmodel = function(y, z, p, m, s) {
+
clustered = cbind(y, L1 = z)
cluster = clustered$L1
+
score = log(p[cluster]) +
- dmvnorm(clustered$value, m[cluster], solve(p[cluster]), log = T)
+ dmvnorm(clustered$value, m[cluster], solve(s[cluster]), log = T)
+
sum(score)
}
diff --git a/finite-gaussian-mixture/src/simulation_conditional.r b/finite-gaussian-mixture/src/simulation_conditional.r
@@ -51,8 +51,8 @@ pm = ggplot(dm, aes(x = seq_along(value), y = value, colour = variable)) +
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, 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),])
diff --git a/finite-gaussian-mixture/src/simulation_multivariate_conditional.r b/finite-gaussian-mixture/src/simulation_multivariate_conditional.r
@@ -1,4 +1,4 @@
-set.seed(990909)
+set.seed(222)
require(ggplot2)
require(gridExtra)
@@ -36,3 +36,13 @@ params = inverse_model(
, config$b, config$w
)
+
+m_ts_plot = function(j) {
+ melted = as.data.frame(j, id.vars = c('V1', 'V2'))
+ ggplot(
+ melted
+ , aes(x = V1, y = V2, alpha = seq_along(V1), colour = seq_along(V1))) +
+ geom_line() + xlim(-2, 2) + ylim(-10, 10)
+}
+
+
