記事の目的
無限混合ガウスモデルの周辺化ギブスサンプリングをRで実装することです。
参考書籍: 佐藤一誠. ノンパラメトリックベイズ. 講談社. 2016
目次
1. モデルの説明
2. 使用データ
3. 分散固定の混合ガウスモデルのギブスサンプリング
4. クラスタリング確認
1. モデルの説明
グラフィカルモデル、生成過程は前回と大体同じです。
ディリクレ分布の仮定が少し違います。
2. 使用データ
> X <- iris[,1:4]
> D <- ncol(X)
> N <- nrow(X)
> head(X)
Sepal.Length Sepal.Width Petal.Length Petal.Width
1 5.1 3.5 1.4 0.2
2 4.9 3.0 1.4 0.2
3 4.7 3.2 1.3 0.2
4 4.6 3.1 1.5 0.2
5 5.0 3.6 1.4 0.2
6 5.4 3.9 1.7 0.4
>
3. 分散固定の混合ガウスモデルの周辺化ギブスサンプリング
library(dplyr)
library(mvtnorm)
# (1)
K <- 1
# (2)
z <- rep(1:K,N)[1:N]
# (3)
m0 <- rep(0, D)
r <- 1
a0 <- 1
b0 <- 1
# (4)
m <- matrix(NA, nrow=K, ncol=D)
alpha <- 15
t <- matrix(NA, nrow=N, ncol=K)
n <- {}
max.iter <- 30
a <- 2*a0+(N-1)*D
x.av <- X %>% apply(2, mean)
t1 <- {}
set.seed(100)
for(s in 1:max.iter){
t <- matrix(NA, nrow=N, ncol=K)
m <- matrix(NA, nrow=K, ncol=D)
x.av <- matrix(rep(x.av,each=N-1), nrow=N-1, ncol=D)
x.k.i <- matrix(NA, nrow=K, ncol=D)
# (ⅰ)
for(i in 1:N){
X.i <- X[-i,]
rownames(X.i) <- 1:(N-1)
z.i <- z[-i]
x.av.i <- X.i %>% apply(2, mean)
for(k in 1:K){
# x.k\i
x.k.i[k,] <- X.i[z.i==k,] %>% apply(2, mean)
# n\i
n[k] <- z.i[z.i==k] %>% length()
# m\i
m[k,] <- n[k]*x.k.i[k,]/(n[k]+r)
}
#b\i
b <- 2*b0+(unlist(X.i-x.av) %*% unlist(X.i-x.av))+(N-1)*r/N*(unlist(x.av.i) %*% unlist(x.av.i))
for(k in 1:K){
t[i,k] <- dmvt(as.numeric(X[i,]), delta=m[k,], df=a, sigma=(1+1/N)*b[1]*diag(D))*((n[k])/(N-1+alpha))
}
t1[i] <- dmvt(as.numeric(X[i,]), delta=m0, df=2*a0, sigma=(1+1/r)*b0*diag(D))*(alpha/(N-1+alpha))
z_prob <- append(t[i,], t1[i])/ sum(append(t[i,], t1[i]))
z[i] <- rmultinom(1, 1, z_prob) %>% which.max()
}
K <- z %>% unique() %>% length()
}
4. クラスタリング確認
前回同様t分布が違うと思います。
今回はエラーで終わりました間違いが分かり次第修正します、、、