はじめに
『ベイズ推論による機械学習入門』の学習時のノートです。基本的な内容は「数式の行間を読んでみた」とそれを「RとPythonで組んでみた」になります。「数式」と「プログラム」から理解するのが目標です。
この記事は、4.3.2項の内容です。「観測モデルをポアソン混合分布」、「事前分布をガンマ分布とディリクレ分布」とするポアソン混合モデルに対するギブスサンプリングをR言語で実装します。
省略してある内容等ありますので、本とあわせて読んでください。初学者な自分が理解できるレベルまで落として書き下していますので、分かる人にはかなりくどくなっています。同じような立場の人のお役に立てれば幸いです。
【数式読解編】
【他の節の内容】
【この節の内容】
・Rでやってみる
人工的に生成したデータを用いて、ベイズ推論を行ってみましょう。アルゴリズム4.2を参考に実装します。
利用するパッケージを読み込みます。
# 4.3.2項で利用するパッケージ library(tidyverse) library(MCMCpack)
MCMCpackパッケージのディリクレ分布に従う乱数生成関数rdirichlet()を使います。
・観測モデルの設定
まずは、観測モデルを設定します。この例では、$K$個の観測モデルをポアソン分布$\mathrm{Poi}(x_n | \lambda_k)$とします。また、各データに対する$K$個の観測モデルの割り当てをカテゴリ分布$\mathrm{Cat}(\mathbf{s}_n | \boldsymbol{\pi})$によって行います。
観測モデルのパラメータと混合比率を設定します。
# K個の真のパラメータを指定 lambda_truth_k <- c(10, 25, 40) # 真の混合比率を指定 pi_truth_k <- c(0.35, 0.25, 0.4) # クラスタ数を取得 K <- length(lambda_truth_k)
観測モデルの$K$個のパラメータ$\boldsymbol{\lambda} = \{\lambda_1, \lambda_2, \cdots, \lambda_K\}$をlambda_truth_kとして、$\lambda_k \geq 0$の値を指定します。
混合比率パラメータ$\boldsymbol{\pi} = (\pi_1, \pi_2, \cdots, \pi_K)$をpi_truth_kとして、$\sum_{k=1}^K \pi_k = 1$、$\pi_k \geq 0$の値を指定します。
この2つのパラメータの値を求めるのがここでの目的です。
設定したモデルをグラフで確認しましょう。グラフ用の点を作成します。
# 作図用のxの点を作成 x_vec <- seq(0, 2 * max(lambda_truth_k)) # 確認 x_vec[1:5]
## [1] 0 1 2 3 4
作図用に、ポアソン分布に従う変数$x_n$がとり得る非負の整数をseq()で作成してx_vecとします。この例では、0から$\boldsymbol{\lambda}$の最大値の2倍を範囲とします。
ポアソン混合分布の確率を計算します。
# 観測モデルを計算 model_prob <- 0 for(k in 1:K) { # クラスタkの分布の確率を計算 tmp_prob <- dpois(x = x_vec, lambda = lambda_truth_k[k]) # K個の分布の加重平均を計算 model_prob <- model_prob + pi_truth_k[k] * tmp_prob }
$K$個のパラメータlambda_truth_kを使って、x_vecの値ごとに次の式で確率を計算します。
$K$個のポアソン分布に対して、$\boldsymbol{\pi}$を使って加重平均をとります。
ポアソン分布の確率は、dpois()で計算できます。データの引数xにx_vec、パラメータの引数lambdaにlambda_truth_k[k]を指定します。
この計算をfor()ループでK回繰り返し行います。各パラメータによって求めた$K$回分の確率をpi_truth_k[k]で割り引いてmodel_probに加算していきます。
計算結果をデータフレームに格納します。
# 観測モデルをデータフレームに格納 model_df <- tibble( x = x_vec, prob = model_prob ) # 確認 head(model_df)
## # A tibble: 6 x 2 ## x prob ## <int> <dbl> ## 1 0 0.0000159 ## 2 1 0.000159 ## 3 2 0.000794 ## 4 3 0.00265 ## 5 4 0.00662 ## 6 5 0.0132
ggplot2パッケージを利用して作図するには、データフレームを渡す必要があります。
観測モデルを作図します。
# 観測モデルを作図 ggplot(model_df, aes(x = x, y = prob)) + geom_bar(stat = "identity", position = "dodge", fill = "blue", color = "blue") + # 真の分布 labs(title = "Poisson Mixture Model", subtitle = paste0("lambda=(", paste0(lambda_truth_k, collapse = ", "), ")"))
$K$個の分布を重ねたような分布になります。ただし、総和が1となるようにしているため、$K$個の分布そのものよりも1つ１つの山が小さく(確率値が小さく)なっています。
・データの生成
続いて、構築したモデルに従ってデータを生成します。先に、潜在変数$\mathbf{S} = \{\mathbf{s}_1, \mathbf{s}_2, \cdots, \mathbf{s}_N\}$、$\mathbf{s}_n = (s_{n,1}, s_{n,2}, \cdots, s_{n,K})$を生成し、各データに割り当てられたクラスタに従い観測データ$\mathbf{X} = \{x_1, x_2, \cdots, x_N\}$を生成します。
$N$個の潜在変数$\mathbf{S}$を生成します。
# (観測)データ数を指定 N <- 250 # クラスタを生成 s_truth_nk <- rmultinom(n = N, size = 1, prob = pi_truth_k) %>% t()
生成するデータ数$N$をNとして値を指定します。
カテゴリ分布に従う乱数は、多項分布に従う乱数生成関数rmultinom()のsize引数を1にすることで生成できます。また、試行回数の引数nにN、確率(パラメータ)の引数probにpi_truth_kを指定します。生成した$N$個の$K$次元ベクトルをs_truth_nkとします。ただし、クラスタが行でデータが列方向に並んで出力されるので、t()で転置しておきます。
結果は次のようになります。
# 確認 s_truth_nk[1:5, ]
## [,1] [,2] [,3] ## [1,] 1 0 0 ## [2,] 0 0 1 ## [3,] 0 0 1 ## [4,] 0 0 1 ## [5,] 0 1 0
これが本来は観測できない潜在変数であり、真のクラスタです。各行がデータを表し、値が1の列番号が割り当てられたクラスタ番号を表します。
s_truth_nkから各データのクラスタ番号を抽出します。
# クラスタ番号を抽出 s_truth_n <- which(t(s_truth_nk) == 1, arr.ind = TRUE) %>% .[, "row"] # 確認 s_truth_n[1:5]
## [1] 1 3 3 3 2
which()を使って行(データ)ごとに要素が1の列番号を抽出します。
各データのクラスタに従い$N$個のデータを生成します。
# (観測)データを生成 x_n <- rpois(n = N, lambda = lambda_truth_k[s_truth_n])
ポアソン分布に従う乱数は、rpois()で生成できます。試行回数の引数nにN、パラメータの引数lambdaにlambda_truth_k[s_truth_n]を指定します。各データのクラスタ番号s_truth_nを添字に使うことで、各データのクラスタに対応したパラメータ$\lambda_k$をlambda_truth_kから取り出すことができます。生成した$N$個のデータをx_nとします。式(4.28)を再現して、lambdaにapply(lambda_truth_k^t(s_truth_nk), 2, prod)を渡しても生成できます。
観測したデータとクラスタ番号をデータフレームに格納します。
# 観測データをデータフレームに格納 x_df <- tibble( x_n = x_n, cluster = as.factor(s_truth_n) ) # 確認 head(x_df)
## # A tibble: 6 x 2 ## x_n cluster ## <int> <fct> ## 1 11 1 ## 2 32 3 ## 3 48 3 ## 4 57 3 ## 5 28 2 ## 6 14 1
観測データは非負の整数、クラスタは1からKの整数になっているのを確認できます。
観測データをヒストグラムで確認しましょう。
# 観測データのヒストグラムを作成 ggplot() + geom_histogram(data = x_df, aes(x = x_n, y = ..density..), binwidth = 1) + # 観測データ geom_bar(data = model_df, aes(x = x, y = prob), stat = "identity", position = "dodge", alpha = 0, color = "red", linetype = "dashed") + # 真の分布 labs(title = "Poisson Mixture Model", subtitle = paste0("N=", N, ", lambda=(", paste0(lambda_truth_k, collapse = ", "), ")"), x = "x")
真の分布を重ねて描画しています。
また、クラスタもヒストグラムで確認しましょう。
# クラスタのヒストグラムを作成 ggplot() + geom_histogram(data = x_df, aes(x = x_n, fill = cluster), binwidth = 1, position = "identity", alpha = 0.5) + # クラスタ labs(title = "Poisson Mixture Model", subtitle = paste0("N=", N, ", lambda=(", paste0(lambda_truth_k, collapse = ", "), ")", ", pi=(", paste0(pi_truth_k, collapse = ", "), ")"), x = "x")
どちらの分布もデータが十分に大きいと真の分布に近づきます。
・事前分布の設定
次に、観測モデル(観測データの分布)$p(\mathbf{X} | \boldsymbol{\lambda})$と潜在変数の分布$p(\mathbf{S} | \boldsymbol{\pi})$に対する共役事前分布を設定します。ポアソン分布のパラメータ$\boldsymbol{\lambda}$に対する事前分布$p(\boldsymbol{\lambda})$としてガンマ分布$\mathrm{Gam}(\boldsymbol{\lambda} | a, b)$、カテゴリ分布のパラメータ$\boldsymbol{\pi}$に対する事前分布$p(\boldsymbol{\pi})$としてディリクレ分布$p(\boldsymbol{\pi} | \boldsymbol{\alpha})$を設定します。
$\boldsymbol{\lambda}$の事前分布と$\boldsymbol{\pi}$の事前分布のパラメータ(超パラメータ)を設定します。
# lambdaの事前分布のパラメータを指定 a <- 1 b <- 1 # piの事前分布のパラメータを指定 alpha_k <- rep(2, K)
ガンマ分布のパラメータ$a,\ b$をそれぞれa, bとして、$a > 0,\ b > 0$の値を指定します。
ディリクレ分布のパラメータ$\boldsymbol{\alpha} = (\alpha_1, \alpha_2, \cdots, \alpha_K)$をalpha_kとして、$\alpha_k > 0$の値を指定します。
超パラメータを設定できたので、$\boldsymbol{\lambda}$の事前分布を確認しましょう。グラフ用の点を作成して、確率密度を計算します。
# 作図用のlambdaの点を作成 lambda_vec <- seq(0, 2 * max(lambda_truth_k), length.out = 1000) # lambdaの事前分布を計算 prior_df <- tibble( lambda = lambda_vec, density = dgamma(x = lambda, shape = a, rate = b) )
ガンマ分布に従う変数$\lambda_k$がとり得る0以上の値をseq()で作成してlambda_vecとします。この例では、0から$\boldsymbol{\lambda}$の最大値の2倍を範囲とします。length.out引数を使うと指定した要素数で等間隔に切り分けます。by引数を使うと切り分ける間隔を指定できます。処理が重い場合は、この値を調整してください。
作成したlambda_vecの値ごとに確率密度を計算します。ガンマ分布の確率密度は、dgamma()で計算できます。データの引数xにlambda_vec、shape引数にa、rate引数にbを指定します。
作成したデータフレームは次のようになります。
# 確認 head(prior_df)
## # A tibble: 6 x 2 ## lambda density ## <dbl> <dbl> ## 1 0 1 ## 2 0.0801 0.923 ## 3 0.160 0.852 ## 4 0.240 0.786 ## 5 0.320 0.726 ## 6 0.400 0.670
$\boldsymbol{\lambda}$の事前分布を作図します。
# lambdaの事前分布を作図 ggplot(prior_df, aes(x = lambda, y = density)) + geom_line(color = "purple") + # 事前分布 geom_vline(xintercept = lambda_truth_k, color = "red", linetype = "dashed") + # 真の値 labs(title = "Gamma Distribution", subtitle = paste0("a=", b, ", b=", b), x = expression(lambda))
真の値を垂直線geom_vline()で描画しています。
$\pi$の事前分布(と事後分布)については省略します。詳しくは、3.2.2項「カテゴリ分布の学習と予測」をご参照ください。
・初期値の設定
設定した事前分布に従いパラメータ$\boldsymbol{\lambda},\ \boldsymbol{\pi}$を生成して初期値とします。
それぞれ事前分布に従い$\boldsymbol{\lambda}$と$\boldsymbol{\pi}$をサンプルします。
# lambdaを生成 lambda_k <- rgamma(n = K, shape = a, rate = b) # piを生成 pi_k <- MCMCpack::rdirichlet(n = 1, alpha = alpha_k) %>% as.vector()
ガンマ分布に従う乱数はdgamma()で生成できます。データ数の引数nにKを指定します。他の引数については、dgamma()と同じです。生成した$K$個のパラメータをlambda_kとします。
ディリクレ分布に従う乱数は、MCMCpackパッケージのrdirichlet()で生成できます。マトリクスで出力されるため、as.vector()でベクトルに変換しておきます。
生成したパラメータを確認します。
# 確認
lambda_k
pi_k
## [1] 0.6803569 0.4242782 0.5192103 ## [1] 0.2258970 0.4898581 0.2842449
パラメータの初期値を使った分布を確認します。
# 初期値による混合分布を計算 init_prob <- 0 for(k in 1:K) { # クラスタkの分布の確率を計算 tmp_prob <- dpois(x = x_vec, lambda_k[k]) # K個の分布の加重平均を計算 init_prob <- init_prob + tmp_prob * pi_k[k] } # 初期値による分布をデータフレームに格納 init_df <- tibble( x = x_vec, prob = init_prob ) # 初期値による分布を作図 ggplot(init_df, aes(x = x, y = prob)) + geom_bar(stat = "identity", position = "dodge", fill = "purple", color = "purple") + # 初期値による分布 geom_bar(data = model_df, aes(x = x, y = prob), stat = "identity", position = "dodge", alpha = 0, color = "red", linetype = "dashed") + # 真の分布 labs(title = "Poisson Mixture Model", subtitle = paste0("iter:", 0, ", lambda=(", paste0(round(lambda_k, 2), collapse = ", "), ")"))
観測モデルのときと同様に作図します。
・ギブスサンプリング
ギブスサンプリングによりパラメータと潜在変数を推定します。
・コード全体
eta_nkとs_nkについては添字を使って代入するため、予め変数を用意しておく必要があります。
また、後で各パラメータの更新値や分布の推移を確認するために、それぞれ試行ごとにtrace_***に値を保存していきます。
# 試行回数を指定 MaxIter <- 100 # 変数を作成 eta_nk <- matrix(0, nrow = N, ncol = K) s_nk <- matrix(0, nrow = N, ncol = K) # 推移の確認用の受け皿を作成 trace_s_in <- matrix(0, nrow = MaxIter + 1, ncol = N) trace_a_ik <- matrix(0, nrow = MaxIter + 1, ncol = K) trace_b_ik <- matrix(0, nrow = MaxIter + 1, ncol = K) trace_alpha_ik <- matrix(0, nrow = MaxIter + 1, ncol = K) trace_lambda_ik <- matrix(0, nrow = MaxIter + 1, ncol = K) trace_pi_ik <- matrix(0, nrow = MaxIter + 1, ncol = K) # 初期値を記録 trace_s_in[1, ] <- rep(NA, N) trace_a_ik[1, ] <- rep(a, K) trace_b_ik[1, ] <- rep(b, K) trace_alpha_ik[1, ] <- alpha_k trace_lambda_ik[1, ] <- lambda_k trace_pi_ik[1, ] <- pi_k # ギブスサンプリング for(i in 1:MaxIter) { for(n in 1:N) { # 潜在変数の事後分布のパラメータを計算:式(4.38) tmp_eta_k <- exp(x_n[n] * log(lambda_k) - lambda_k + log(pi_k)) eta_nk[n, ] <- tmp_eta_k / sum(tmp_eta_k) # 正規化 # クラスタをサンプル:式(4.37) s_nk[n, ] <- rmultinom(n = 1, size = 1, prob = eta_nk[n, ]) %>% as.vector() } # lambdaの事後分布のパラメータを計算:式(4.42) a_hat_k <- colSums(s_nk * x_n) + a b_hat_k <- colSums(s_nk) + b # lambdaをサンプル:式(4.41) lambda_k <- rgamma(n = K, shape = a_hat_k, rate = b_hat_k) # piの事後分布のパラメータを計算:式(4.45) alpha_hat_k <- colSums(s_nk) + alpha_k # piをサンプル:式(4.44) pi_k <- MCMCpack::rdirichlet(n = 1, alpha = alpha_hat_k) %>% as.vector() # i回目のパラメータを記録 trace_s_in[i + 1, ] <- which(t(s_nk) == 1, arr.ind = TRUE) %>% .[, "row"] trace_a_ik[i + 1, ] <- a_hat_k trace_b_ik[i + 1, ] <- b_hat_k trace_alpha_ik[i + 1, ] <- alpha_hat_k trace_lambda_ik[i + 1, ] <- lambda_k trace_pi_ik[i + 1, ] <- pi_k # 動作確認 #print(paste0(i, ' (', round(i / MaxIter * 100, 1), '%)')) }
・処理の確認
続いて、ギブスサンプリングで行う処理を確認していきます。
・潜在変数$\mathbf{S}$のサンプリング
$\mathbf{s}_n$の条件付き分布(事後分布)$p(\mathbf{s}_n | \mathbf{X}, \boldsymbol{\lambda}, \boldsymbol{\pi})$のパラメータを計算して、新たな$\mathbf{s}_n$を生成します。
for(n in 1:N) { # ハイパーパラメータeta_nを計算:式(4.38) tmp_eta_k <- exp(x_n[n] * log(lambda_k) - lambda_k + log(pi_k)) eta_nk[n, ] <- tmp_eta_k / sum(tmp_eta_k) # 正規化 # 潜在変数s_nをサンプリング:式(4.37) s_nk[n, ] <- rmultinom(n = 1, size = 1, prob = eta_nk[n, ]) %>% as.vector() }
$n$番目のデータの潜在変数$\mathbf{s}_n$の事後分布(カテゴリ分布)のパラメータ$\boldsymbol{\eta}_n = (\eta_{n,1}, \eta_{n,2}, \cdots, \eta_{n,K})$の各項を次の式で計算します。
右辺の計算結果をtmp_eta_kとします。さらに、総和が1になるように
で正規化して、結果をeta_nkとします。
ちなみに、式(4.38)の$\exp(\cdot)$の括弧の中を$\tilde{\eta}_{n,k}$とすると、正規化の式は$\frac{\exp (\tilde{\eta}_{n,k})}{\sum_{k'=1}^K \exp (\tilde{\eta}_{n,k'})}$となります。これはソフトマックス関数の計算になります。オーバーフローが起きる場合は、「ソフトマックス関数のオーバーフロー対策【ゼロつく1のノート(数学)】 - からっぽのしょこ」を参考にしてください。
更新したパラメータeta_nk[n, ]を持つカテゴリ分布に従い$\boldsymbol{s}_n$をサンプルします。
結果は次のようになります。
# 確認 round(eta_nk[n, ], 5) s_nk[n, ]
## [1] 0.00000 0.98054 0.01945 ## [1] 0 1 0
この処理をfor()ループで$N$回繰り返すことで、全ての潜在変数のサンプルが得られます。
更新した$\mathbf{S}$を用いて、パラメータ$\boldsymbol{\lambda},\ \boldsymbol{\pi}$を更新します。
・観測モデルのパラメータ$\boldsymbol{\lambda}$のサンプリング
$\boldsymbol{\lambda}$の条件付き分布(事後分布)$p(\boldsymbol{\lambda} | \mathbf{X}, \mathbf{S})$のパラメータを計算して、新たな$\boldsymbol{\lambda}$を生成します。
# lambdaの事後分布のパラメータを計算:式(4.42) a_hat_k <- colSums(s_nk * x_n) + a b_hat_k <- colSums(s_nk) + b # lambdaをサンプル:式(4.41) lambda_k <- rgamma(n = K, shape = a_hat_k, rate = b_hat_k)
$\boldsymbol{\lambda}$の条件付き分布($K$個のガンマ分布)のパラメータ$\hat{\mathbf{a}} = \{\hat{a}_1, \hat{a}_2, \cdots, \hat{a}_K\}$、$\hat{\mathbf{b}} = \{\hat{b}_1, \hat{b}_2, \cdots, \hat{b}_K\}$の各項を
で計算して、結果をa_hat_k, b_hat_kとします。
a_hat_k, b_hat_kを用いて、新たな$\boldsymbol{\lambda}$をサンプルします。
結果は次のようになります。
# 確認
a_hat_k
b_hat_k
lambda_k
## [1] 4056 875 1489 ## [1] 101 90 62 ## [1] 40.405048 9.119092 24.597096
ちなみに、$\hat{a}_k$の計算式に関して、$s_{n,k} x_n$の計算は
x_n[1:5] s_nk[1:5, ] * x_n[1:5]
## [1] 11 32 48 57 28 ## [,1] [,2] [,3] ## [1,] 0 11 0 ## [2,] 0 0 32 ## [3,] 48 0 0 ## [4,] 57 0 0 ## [5,] 0 0 28
各観測データをクラスタごとに仕分ける操作であり、$\sum_{n=1}^N s_{n,k} x_n$は
colSums(s_nk[1:5, ] * x_n[1:5])
## [1] 105 11 60
割り当てられたクラスタごとに観測データの値の和をとる操作と言えます。また、$\sum_{n=1}^N s_{n,k}$の計算は
s_nk[1:5, ] colSums(s_nk[1:5, ])
## [,1] [,2] [,3] ## [1,] 0 1 0 ## [2,] 0 0 1 ## [3,] 1 0 0 ## [4,] 1 0 0 ## [5,] 0 0 1 ## [1] 2 1 2
各クラスタを割り当てられたデータ数です。
・混合比率パラメータ$\boldsymbol{\pi}$のサンプリング
$\boldsymbol{\pi}$の条件付き分布(事後分布)$p(\boldsymbol{\pi} | \mathbf{X}, \mathbf{S})$のパラメータを計算して、新たな$\boldsymbol{\pi}$を生成します。
# piの事後分布のパラメータを計算:式(4.45) alpha_hat_k <- colSums(s_nk) + alpha_k # piをサンプル:式(4.44) pi_k <- MCMCpack::rdirichlet(n = 1, alpha = alpha_hat_k) %>% as.vector()
$\boldsymbol{\pi}$の条件付き分布(ディリクレ分布)のパラメータ$\hat{\boldsymbol{\alpha}} = (\hat{\alpha}_1, \hat{\alpha}_2, \cdots, \hat{\alpha}_K)$の各項を
で計算して、結果をalpha_hat_kとします。
alpha_hat_kを用いて、新たな$\boldsymbol{\pi}$をサンプルします。
$\boldsymbol{\lambda},\ \boldsymbol{\pi}$が得られました。今度は、更新した$\boldsymbol{\lambda},\ \boldsymbol{\pi}$を用いて、潜在変数$\mathbf{S}$を更新します。この処理を指定した回数繰り返し行います。
・推論結果の確認
・最後のパラメータの確認
超パラメータa_hat_kとb_hat_kの最後の更新値を用いて、$\boldsymbol{\lambda}$の事後分布を計算します。
# lambdaの事後分布をデータフレームに格納 posterior_lambda_df <- tibble() for(k in 1:K) { # クラスタkのlambdaの事後分布を計算 tmp_posterior_df <- tibble( lambda = lambda_vec, density = dgamma(x = lambda, shape = a_hat_k[k], rate = b_hat_k[k]), cluster = as.factor(k) ) # 結果を結合 posterior_lambda_df <- rbind(posterior_lambda_df, tmp_posterior_df) }
$K$個のガンマ分布を計算して、データフレームに格納していきます。
作成したデータフレームは次のようになります。
# 確認 head(posterior_lambda_df)
## # A tibble: 6 x 3 ## lambda density cluster ## <dbl> <dbl> <fct> ## 1 0 0 1 ## 2 0.0801 0 1 ## 3 0.160 0 1 ## 4 0.240 0 1 ## 5 0.320 0 1 ## 6 0.400 0 1
$\boldsymbol{\lambda}$の事後分布を作図します。
# lambdaの事後分布を作図 ggplot(posterior_lambda_df, aes(x = lambda, y = density, color = cluster)) + geom_line() + # 事後分布 geom_vline(xintercept = lambda_truth_k, color = "red", linetype = "dashed") + # 真の値 labs(title = "Gamma Distribution:Gibbs Sampling", subtitle = paste0("iter:", MaxIter, ", N=", N, ", a=(", paste0(a_hat_k, collapse = ", "), ")", ", b=(", paste0(b_hat_k, collapse = ", "), ")"), x = expression(lambda))
事前分布のときと同様に作図できます。
3つのガンマ分布がそれぞれ3つの真の値付近をピークとする分布を推定できています。
パラメータlambda_kとpi_kの最後のサンプルを用いて、混合分布を計算します。
# 最後のサンプルによる混合分布を計算 res_prob <- 0 for(k in 1:K) { # クラスタkの分布の確率を計算 tmp_prob <- dpois(x = x_vec, lambda = lambda_k[k]) # K個の分布の加重平均を計算 res_prob <- res_prob + pi_k[k] * tmp_prob } # 最後のサンプルによる分布をデータフレームに格納 res_df <- tibble( x = x_vec, prob = res_prob ) # 最後のサンプルによる分布を作図 ggplot() + geom_bar(data = res_df, aes(x = x, y = prob), stat = "identity", position = "dodge", fill = "purple", color = "purple") + # 最後のサンプルによる分布 geom_bar(data = model_df, aes(x = x, y = prob), stat = "identity", position = "dodge", alpha = 0, color = "red", linetype = "dashed") + # 真の分布 labs(title = "Poisson Mixture Model:Gibbs Sampling", subtitle = paste0("iter:", MaxIter, ", N=", N, ", lambda=(", paste0(round(lambda_k, 2), collapse = ", "), ")", ", pi=(", paste0(round(pi_k, 2), collapse = ", "), ")"))
観測モデルのときと同様にして作図できます。
潜在変数s_nkの最後のサンプルを使って、クラスタのヒストグラムを作成します。
# 最後のクラスタをデータフレームに格納 s_df <- tibble( x_n = x_n, cluster = which(t(s_nk) == 1, arr.ind = TRUE) %>% .[, "row"] %>% as.factor() ) # 最後のクラスタのヒストグラムを作成 ggplot() + geom_histogram(data = s_df, aes(x = x_n, fill = cluster), binwidth = 1, position = "identity", alpha = 0.5) + # 最後のクラスタ geom_histogram(data = x_df, aes(x = x_n, color = cluster), binwidth = 1, position = "identity", alpha = 0, linetype = "dashed") + # 真のクラスタ labs(title = "Poisson Mixture Model:Gibbs Sampling", subtitle = paste0("iter:", MaxIter, ", N=", N, ", lambda=(", paste0(round(lambda_k, 2), collapse = ", "), ")", ", pi=(", paste0(round(pi_k, 2), collapse = ", "), ")"), x = "x")
観測データのときと同様にして作図できます。
クラスタはランダムに決まるため、クラスタ番号は一致しません。
・超パラメータの推移の確認
超パラメータの更新値の推移を確認します。
・コード(クリックで展開)
各パラメータの学習ごとの値を格納したマトリクスtrace_***をtidyr::pivot_longer()で縦長のデータフレームに変換して作図します。
# aの推移をデータフレームに格納 trace_a_df <- dplyr::as_tibble(trace_a_ik) %>% # データフレームに変換 cbind(iteration = 0:MaxIter) %>% # 試行回数の列を追加 tidyr::pivot_longer( cols = -iteration, # 変換しない列 names_to = "cluster", # 現列名を格納する列名 names_prefix = "V", # 現列名の頭から取り除く文字列 names_ptypes = list(cluster = factor()), # 現列名を値とする際の型 values_to = "value" # 現セルを格納する列名 ) # 縦持ちに変換 # aの推移を作図 ggplot(trace_a_df, aes(x = iteration, y = value, color = cluster)) + geom_line() + labs(title = "Gibbs Sampling", subtitle = expression(hat(bold(a))))
# bの推移をデータフレームに格納 trace_a_df <- dplyr::as_tibble(trace_b_ik) %>% # データフレームに変換 cbind(iteration = 0:MaxIter) %>% # 試行回数の列を追加 tidyr::pivot_longer( cols = -iteration, # 変換しない列 names_to = "cluster", # 現列名を格納する列名 names_prefix = "V", # 現列名の頭から取り除く文字列 names_ptypes = list(cluster = factor()), # 現列名を値とする際の型 values_to = "value" # 現セルを格納する列名 ) # 縦持ちに変換 # bの推移を作図 ggplot(trace_a_df, aes(x = iteration, y = value, color = cluster)) + geom_line() + labs(title = "Gibbs Sampling", subtitle = expression(hat(bold(b))))
# alphaの推移を作図 trace_alpha_df <- dplyr::as_tibble(trace_alpha_ik) %>% # データフレームに変換 cbind(iteration = 0:MaxIter) %>% # 試行回数の列を追加 tidyr::pivot_longer( cols = -iteration, # 変換しない列 names_to = "cluster", # 現列名を格納する列名 names_prefix = "V", # 現列名の頭から取り除く文字列 names_ptypes = list(cluster = factor()), # 現列名を値とする際の型 values_to = "value" # 現セルを格納する列名 ) # 縦持ちに変換 # alphaの推移を作図 ggplot(trace_alpha_df, aes(x = iteration, y = value, color = cluster)) + geom_line() + labs(title = "Gibbs Sampling", subtitle = expression(hat(alpha)))
・パラメータの推移の確認
パラメータのサンプルの推移を確認します。
・コード(クリックで展開)
同様に作図します。それぞれ真の値***_truthを水平線geom_hline()で描画しておきます。
# lambdaの推移をデータフレームに格納 trace_lambda_df <- dplyr::as_tibble(trace_lambda_ik) %>% # データフレームに変換 cbind(iteration = 0:MaxIter) %>% # 試行回数の列を追加 tidyr::pivot_longer( cols = -iteration, # 変換しない列 names_to = "cluster", # 現列名を格納する列名 names_prefix = "V", # 現列名の頭から取り除く文字列 names_ptypes = list(cluster = factor()), # 現列名を値とする際の型 values_to = "value" # 現セルを格納する列名 ) # 縦持ちに変換 # lambdaの推移を作図 ggplot(trace_lambda_df, aes(x = iteration, y = value, color = cluster)) + geom_line() + # 推定値 geom_hline(yintercept = lambda_truth_k, color = "red", linetype = "dashed") + # 真の値 labs(title = "Gibbs Sampling", subtitle = expression(hat(lambda)))
# piの推移をデータフレームに格納 trace_pi_df <- dplyr::as_tibble(trace_pi_ik) %>% # データフレームに変換 cbind(iteration = 0:MaxIter) %>% # 試行回数の列を追加 tidyr::pivot_longer( cols = -iteration, # 変換しない列 names_to = "cluster", # 現列名を格納する列名 names_prefix = "V", # 現列名の頭から取り除く文字列 names_ptypes = list(cluster = factor()), # 現列名を値とする際の型 values_to = "value" # 現セルを格納する列名 ) # 縦持ちに変換 # piの推移を作図 ggplot(trace_pi_df, aes(x = iteration, y = value, color = cluster)) + geom_line() + # 推定値 geom_hline(yintercept = pi_truth_k, color = "red", linetype = "dashed") + # 真の値 labs(title = "Gibbs Sampling", subtitle = expression(hat(pi)))
試行回数が増えるに従って真の値に近づいているのを確認できます。
・おまけ：アニメーションによる推移の確認
gganimateパッケージを利用して、各分布の推移のアニメーション(gif画像)を作成するためのコードです。
・コード(クリックで展開)
# 追加パッケージ library(gganimate)
・パラメータの事後分布の推移
作図用のデータフレームを作成します。
# lambdaの事後分布をデータフレームに格納 trace_posterior_lambda_df <- tibble() for(i in 1:(MaxIter + 1)) { for(k in 1:K) { # クラスタkの事後分布を計算 tmp_posterior_df <- tibble( lambda = lambda_vec, density = dgamma(x = lambda, shape = trace_a_ik[i, k], rate = trace_b_ik[i, k]), cluster = as.factor(k), label = paste0( "iter:", i - 1, ", N=", N, ", a=(", paste0(trace_a_ik[i, ], collapse = ", "), ")", ", b=(", paste0(trace_b_ik[i, ], collapse = ", "), ")" ) %>% as.factor() ) # 結果を結合 trace_posterior_lambda_df <- rbind(trace_posterior_lambda_df, tmp_posterior_df) } # 動作確認 #print(paste0((i - 1), ' (', round((i - 1) / MaxIter * 100, 1), '%)')) }
各試行における計算結果を同じデータフレームに格納していく必要があります。
分布の推移をgif画像で出力します。
# lambdaの事後分布を作図 trace_graph <- ggplot() + geom_line(data = trace_posterior_lambda_df, aes(x = lambda, y = density, color = cluster)) + # lambdaの事後分布 geom_vline(xintercept = lambda_truth_k, color = "red", linetype = "dashed") + # 真の値 gganimate::transition_manual(label) + # フレーム labs(title = "Gamma Distribution:Gibbs Sampling", subtitle = "{current_frame}", x = expression(lambda)) # gif画像を作成 gganimate::animate(trace_graph, nframes = MaxIter + 1, fps = 10)
各フレームの順番を示す列をgganimate::transition_manual()に指定します。初期値を含むため、フレーム数はMaxIter + 1です。
・パラメータのサンプルの推移
・コード(クリックで展開)
作図用のデータフレームを作成します。
# 作図用のデータフレームを作成 trace_model_df <- tibble() trace_cluster_df <- tibble() for(i in 1:(MaxIter + 1)) { # i回目の混合分布を計算 res_prob <- 0 for(k in 1:K) { # クラスタkの分布の確率を計算 tmp_prob <- dpois(x = x_vec, trace_lambda_ik[i, k]) # K個の分布の加重平均を計算 res_prob <- res_prob + tmp_prob * trace_pi_ik[i, k] } # i回目のサンプルによる分布をデータフレームに格納 res_df <- tibble( x = x_vec, prob = res_prob, label = paste0( "iter:", i - 1, ", N=", N, ", lambda=(", paste0(round(trace_lambda_ik[i, ], 2), collapse = ", "), ")", ", pi=(", paste0(round(trace_lambda_ik[i, ], 2), collapse = ", "), ")" ) %>% as.factor() ) # i回目のクラスタをデータフレームに格納 s_df <- tibble( x_n = x_n, cluster = as.factor(trace_s_in[i, ]), label = paste0( "iter=", i - 1, ", N=", N, ", lambda=(", paste0(round(trace_lambda_ik[i, ], 2), collapse = ", "), ")", ", pi=(", paste0(round(trace_lambda_ik[i, ], 2), collapse = ", "), ")" ) %>% as.factor() ) # i回目の結果を結合 trace_model_df <- rbind(trace_model_df, res_df) trace_cluster_df <- rbind(trace_cluster_df, s_df) # 動作確認 #print(paste0((i - 1), ' (', round((i - 1) / MaxIter * 100, 1), '%)')) }
・サンプルしたパラメータによる分布の推移
# アニメーション用に複製 rep_model_df <- tibble( x = rep(model_df[["x"]], times = MaxIter + 1), prob = rep(model_df[["prob"]], times = MaxIter + 1), label = trace_model_df[["label"]] ) # 分布の推移を作図 trace_graph <- ggplot() + geom_bar(data = trace_model_df, aes(x = x, y = prob), stat = "identity", fill = "purple") + # 推定した分布 geom_bar(data = rep_model_df, aes(x = x, y = prob), stat = "identity", alpha = 0, color = "red", linetype = "dashed") + # 真の分布 ylim(c(0, 0.1)) + gganimate::transition_manual(label) + # フレーム labs(title = "Poisson Mixture Model:Gibbs Sampling", subtitle = "{current_frame}") # gif画像を作成 gganimate::animate(trace_graph, nframes = MaxIter + 1, fps = 10)
(ylim()を越えるバーは表示されないっぽい。)
・クラスタのヒストグラムの推移
# アニメーション用に複製 rep_x_df <- tibble( x_n = rep(x_n, times = MaxIter + 1), cluster = rep(as.factor(s_truth_n), times = MaxIter + 1), label = trace_cluster_df[["label"]] ) # クラスタの推移を作図 trace_graph <- ggplot() + geom_histogram(data = trace_cluster_df, aes(x = x_n, fill = cluster), binwidth = 1, position = "identity", alpha = 0.5) + # 推定したクラスタ geom_histogram(data = rep_x_df, aes(x = x_n, color = cluster), binwidth = 1, position = "identity", alpha = 0, linetype = "dashed") + # 真のクラスタ gganimate::transition_manual(label) + # フレーム labs(title = "Poisson Mixture Model:Gibbs Sampling", subtitle = "{current_frame}", x = "x") # gif画像を作成 gganimate::animate(trace_graph, nframes = MaxIter + 1, fps = 10)
参考文献
- 須山敦志『ベイズ推論による機械学習入門』(機械学習スタートアップシリーズ)杉山将監修,講談社,2017年.
おわりに
混合モデルって結局、事後分布の近似、パラメータの推定、データのクラスタリングのどれを一番重視しているんだ？事例による？
【次節の内容】
- 2021/07/07：加筆修正しました。その際に数式読解編と記事を分割しました。
