R에서 혼합 가우스 모델 구현 (주변화 깁스 샘플링)

13641 단어 R

기사의 목적



혼합 가우스 모델의 주변화 깁스 샘플링을 R로 구현합니다.

참고 : 비 파라 메트릭 베이즈 포인트 프로세스 및 통계적 기계 학습 수리

목차



No.
목차

1

모델 설명

2

데이터 및 라이브러리

3

구현

4

확인



1. 모델 설명





2. 데이터 및 라이브러리



데이터는 iris의 데이터 세트를 사용합니다.
X <- iris[,1:4]
D <- ncol(X)
N <- nrow(X)
library(mvtnorm)
library(MCMCpack)
library(cluster)

3. 구현


#(1)Kを求める
K <- 3
#(2)muを乱数で初期化
set.seed(100)
z <- apply(rmultinom(N, 1, rep(1/K, K)), 2, which.max)
#(3)
a0 <- 1
b0 <- 1
alpha0 <- 1
#(4)(ⅰ)を繰り返す
max.iter <- 2
a <- 2*a0 + (N-1)*D
for(s in 1:max.iter){
  #(ⅰ)zのサンプリング
  for(i in 1:N){
    #bの計算
    b <- 2*b0 + sum(apply(X[-i,], 2, function(x) (x-mean(x))^2)) +
      (N-1)/N*sum(apply(X[-i,], 2, mean)^2)
    #mの計算
    n <- tapply(z[-i], z[-i], length)
    x.k <-  apply(X[-i,], 2, function(x) tapply(x, z[-i], mean))
    m <- as.vector(n/(n+1))*x.k
    #zのサンプリング
    tmp <- apply(m, 1, function(x) dmvt(X[i,], delta=x, df=a, sigma=solve(diag(D)*b/(1+1/N)), type="shifted", log=FALSE))*
      (n+alpha0)/(sum(n)+alpha0)
    z[i] <- which.max(rmultinom(1, 3, tmp))
  }
}

4. 확인



왼쪽이 정답이고 오른쪽이 구현의 결과입니다.
par(mfrow=c(1,2))
clusplot(X, iris[,5], color=TRUE, shade=FALSE, labels=4, lines=0)
clusplot(X, z, color=TRUE, shade=FALSE, labels=4, lines=0)

좋은 웹페이지 즐겨찾기