Post on 02-Sep-2019
バイオインフォマティクス特論1 パラメータ推定
1-1. 二項分布を使った推定藤 博幸
「ベイズ統計で実践モデリング」 ではMCMCによる
パラメータ推定 と
モデル選択
が⾏われている。
この講義でもその順番で進める
1-1. 二項分布を使った推論1-1-1. ⽐率を推定する
1-1-2. ⽐率の差
1-1-3. 共通の⽐率を推論する
1-1-1. 比率を推定する「ベイズ統計で実践モデリング」 第3章 ⼆項分布を使った推論3.1 ⽐率を推定する
n回コイントスをして、k回表が出たコインの表が出る割合θを求める
θの事後分布を求める
問題をグラフィカルモデルで表現θ
k
n n回コイントス
コインはθの割合で表が出る。
k回表が観測
連続値 離散値
⾮観測変数(確率変数)
観測変数
依存関係
尤度と事前分布θ
k
n
θが与えられた時、n回のコイントス中k回表が出る確率(尤度)は⼆項分布に従う
𝑘~𝐵 𝑛, 𝜃 =𝑛!
𝑘! 𝑛 − 𝑘 !𝜃* 1 − 𝜃 ,-*
θがどのような値をとるのかの情報がない。⼀様分布を無情報事前分布として⽤いるベータ分布Beta(1,1)は⼀様分布になる。𝜽
𝜃~𝐵𝑒𝑡𝑎(1,1)
ベータ分布
𝑏𝑒𝑡𝑎 𝑥; 𝛼, 𝛽 =9:;< =-9 >;<
? @,A (0 ≤ 𝑥 ≤ 1)
B(α, β)はベータ関数パラメータα, βは正の実数
Rでベータ分布の密度関数をパラメータの値を変えてプロットしてみる code2.1.R
x <- seq(0,1.0, 0.01) alpha <- 5 beta <- 1 y1 <- dbeta(x, alpha, beta)
alpha <- 1 beta <- 3 y2 <- dbeta(x, alpha, beta)
alpha <- 2 beta <- 2 y3 <- dbeta(x, alpha, beta)
alpha<- 1 beta <- 1 y4 <- dbeta(x, alpha, beta)
plot(x, y1, ty='l') par(new=T)plot(x, y2, col="red", ty='l', ylim=c(0,2.5), yaxt="n") par(new=T)plot(x, y3, col="yellow", ty='l', ylim=c(0,2.5), yaxt="n") par(new=T)plot(x, y4, col="green", ty='l', ylim=c(0,2.5), yaxt="n")
Jagsでのモデルの記述Rate_1.txt
# Inferring a Ratemodel{
# Prior Distribution for Rate Thetatheta ~ dbeta(1,1)# Observed Countsk ~ dbin(theta,n)
}
θ
k
n
事前分布
尤度
R2jagsによるMCMCサンプリングRate_1_jags.R
# clears workspace: rm(list=ls())
# sets working directories:setwd("/Users/toh/Desktop/Code/ParameterEstimation/Binomial")
library(R2jags)
k <- 5n <- 10
data <- list("k", "n") # to be passed on to JAGS
変数のクリア
Rate_1.txtとRate_1_jags.Rのあるディレクトリへの移動
パッケージの読み込み
観測変数の設定
myinits <- list(list(theta = 0.1), #chain 1 starting valuelist(theta = 0.9)) #chain 2 starting value
# parameters to be monitored:parameters <- c("theta")
# The following command calls JAGS with specific options.# For a detailed description see the R2jags documentation.samples <- jags(data, inits=myinits, parameters,
model.file ="Rate_1.txt", n.chains=2, n.iter=20000, n.burnin=1, n.thin=1, DIC=T)
θの初期値の設定
モニターするパラメータの設定
Jagsを呼び出してθをサンプリング
samples <- jags(data, inits=myinits, parameters,model.file ="Rate_1.txt", n.chains=2, n.iter=20000, n.burnin=1, n.thin=1, DIC=T)
data:観測値inits:初期値parameters:モニタするパラメータmodel.file: Jagsのモデルの指定n.chains: 2回MCMC異なる初期値からMCMCを行うn.iter:1回のMCMCのサンプリングの回数n.burnin: burn inのサイズn.thin: thiningのサイズDIC: 逸脱情報量基準(Deviance Information Criterion)モデル選択の時に用いるが、ベイズ統計家でも必ずしも受け入れられている訳ではない。 TRUEで計算される。
# The commands below are useful for a quick overview:print(samples) # a rough summarytraceplot(samples) # traceplot (press <enter> repeatedly to see the chains)
# Collect posterior samples across all chains:theta <- samples$BUGSoutput$sims.list$theta
# Now let's plot a histogram for theta. # First, some options to make the plot look better:par(cex.main = 1.5, mar = c(5, 6, 4, 5) + 0.1, mgp = c(3.5, 1, 0), cex.lab = 1.5,
font.lab = 2, cex.axis = 1.3, bty = "n", las=1)Nbreaks <- 80y <- hist(theta, Nbreaks, plot=F)plot(c(y$breaks, max(y$breaks)), c(0,y$density,0), type="S", lwd=2, lty=1,
xlim=c(0,1), ylim=c(0,10), xlab="Rate", ylab="Posterior Density") # NB. ylim=c(0,10) defines the range of the y-axis. Adjust the upper value# in case your posterior distribution falls partly outside this range.
max(c(samples$BUGSoutput$sims.array[,1,][,2], samples$BUGSoutput$sims.array[,2,][1,2]))min(c(samples$BUGSoutput$sims.array[,1,][,2], samples$BUGSoutput$sims.array[,2,][1,2]))summary(c(samples$BUGSoutput$sims.array[,1,][,2], samples$BUGSoutput$sims.array[,2,][,2]))
mixingの確認
2つのchainでサンプルされたθを⼀つにまとめる
θの事後分布の表⽰
2つのchainそれぞれについての解析
> print(samples) # a rough summaryInference for Bugs model at "Rate_1.txt", fit using jags, 2 chains, each with 20000 iterations (first 1 discarded) n.sims = 39998 iterations saved
mu.vect sd.vect 2.5% 25% 50% 75% 97.5% Rhat n.efftheta 0.500 0.138 0.236 0.403 0.500 0.598 0.764 1.001 40000deviance 3.658 1.214 2.805 2.890 3.192 3.929 7.115 1.001 18000For each parameter, n.eff is a crude measure of effective sample size,and Rhat is the potential scale reduction factor (at convergence, Rhat=1).
DIC info (using the rule, pD = var(deviance)/2)pD = 0.7 and DIC = 4.4
2つのchainをまとめたθの要約
traceplotは、R2jagsの関数
> summary(theta) V1
Min. :0.05863 1st Qu.:0.40288 Median :0.50008 Mean :0.50032 3rd Qu.:0.59791 Max. :0.94687
> max(c(samples$BUGSoutput$sims.array[,1,][,2], samples$BUGSoutput$sims.array[,2,][1,2]))[1] 0.9468675> min(c(samples$BUGSoutput$sims.array[,1,][,2], samples$BUGSoutput$sims.array[,2,][,2]))[1] 0.05862784> summary(c(samples$BUGSoutput$sims.array[,1,][,2], samples$BUGSoutput$sims.array[,2,][,2
Min. 1st Qu. Median Mean 3rd Qu. Max. 0.05863 0.40288 0.50008 0.50032 0.59791 0.94687
chain1のθ chain2のθ
1.1.2 2つの比率の差「ベイズ統計で実践モデリング」 第3章 ⼆項分布を使った推論3.2 2つの⽐率の差
1.1.2 2つの比率の差違うコインでそれぞれコイントス
n1回トス, k1回表が出る n2回トス, k2回表が出る
表が出る⽐率θ1表が出る⽐率θ2
問題をグラフィカルモデルで表現
θ1
k1
n1
θ2
k2
n2
δ𝑘=~𝐵 𝑛=, 𝜃=𝑘E~𝐵 𝑛E, 𝜃E
𝜃=~𝐵𝑒𝑡𝑎(1,1)𝜃E~𝐵𝑒𝑡𝑎(1,1)
𝛿 ← 𝜃= − 𝜃E
尤度
事前分布
⽐率の差
確定変数(deterministic variable)を表すノード
Jagsでのモデルの記述Rate_2.txt
# Difference Between Two Ratesmodel{
# Observed Countsk1 ~ dbin(theta1,n1)k2 ~ dbin(theta2,n2)# Prior on Ratestheta1 ~ dbeta(1,1)theta2 ~ dbeta(1,1)# Difference Between Ratesdelta <- theta1-theta2
}
尤度
事前分布
# clears workspace: rm(list=ls())
# sets working directories:setwd("/Users/toh/Desktop/Code/ParameterEstimation/Binomial")
library(R2jags)
k1 <- 5k2 <- 7n1 <- 10n2 <- 10
data <- list("k1", "k2", "n1", "n2") # to be passed on to JAGS
R2jagsによるMCMCサンプリングRate_2_jags.R 変数のクリア
Rate_2.txtとRate_2_jags.Rのあるディレクトリへの移動
パッケージの読み込み
観測変数の設定
myinits <- list(list(theta1 = 0.1, theta2 = 0.9))
# parameters to be monitored:parameters <- c("delta", "theta1", "theta2")
# The following command calls JAGS with specific options.# For a detailed description see the R2jags documentation.samples <- jags(data, inits=myinits, parameters,
model.file ="Rate_2.txt", n.chains=1, n.iter=10000, n.burnin=1, n.thin=1, DIC=T)
θ1とθ2の初期値の設定何故list(list())となっているのか?ヒント:n.chainsの設定
モニターするパラメータの設定
Jagsを呼び出してθをサンプリング
delta <- samples$BUGSoutput$sims.list$delta
# Now let's plot a histogram for delta. # First, some options to make the plot look better:par(cex.main = 1.5, mar = c(5, 6, 4, 5) + 0.1, mgp = c(3.5, 1, 0), cex.lab = 1.5,
font.lab = 2, cex.axis = 1.3, bty = "n", las=1)Nbreaks <- 80y <- hist(delta, Nbreaks, plot=F)plot(c(y$breaks, max(y$breaks)), c(0,y$density,0), type="S", lwd=2, lty=1,
xlim=c(-1,1), ylim=c(0,10), xlab="Difference in Rates", ylab="Posterior Density")
サンプリングされたδ(⽐率の差)を取り出して、その事後分布を作成
# mean of delta:mean(delta)# median of delta:median(delta)# mode of delta, estimated from the "density" smoother:density(delta)$x[which(density(delta)$y==max(density(delta)$y))]# 95% credible interval for delta:quantile(delta, c(.025,.975))
δの点推定, 区間推定
> mean(delta)[1] -0.1658759> median(delta)[1] -0.1681818> density(delta)$x[which(density(delta)$y==max(density(delta)$y))][1] -0.1562157> quantile(delta, c(.025,.975))
2.5% 97.5%-0.5316203 0.2167374 95%信⽤区間
平均
メジアン
モード
1.1.3 共通の比率を推論する「ベイズ統計で実践モデリング」 第3章 ⼆項分布を使った推論3.3 共通の⽐率を推論する
1.1.3 共通の比率を推論する同じコインを2⼈が独⽴にコイントス
n1回トス, k1回表が出る n2回トス, k2回表が出る
表が出る⽐率θ
問題をグラフィカルモデルで表現
k1
n1
k2
n2
𝑘=~𝐵 𝑛=, 𝜃𝑘E~𝐵 𝑛E, 𝜃
𝜃~𝐵𝑒𝑡𝑎(1,1)
尤度
事前分布
𝜽
問題をグラフィカルモデルで表現プレート記法
ki
ni
𝑘H~𝐵 𝑛H , 𝜃
𝜃~𝐵𝑒𝑡𝑎(1,1)
尤度
事前分布
𝜽
独⽴なグラフの繰り返しを閉じた⻑⽅形で囲んで表すfor ループのような表現
i
Jagsでのモデルの記述Rate_3.txt
# Inferring a Common Ratemodel{
# Observed Countsk1 ~ dbin(theta,n1)k2 ~ dbin(theta,n2)# Prior on Single Rate Thetatheta ~ dbeta(1,1)
}
尤度
事前分布
R2jagsによるMCMCサンプリングRate_3_jags.R
# clears workspace: rm(list=ls())
# sets working directories:setwd("/Users/toh/Desktop/Code/ParameterEstimation/Binomial")
library(R2jags)
k1 <- 5k2 <- 7n1 <- 10n2 <- 10
data <- list("k1", "k2", "n1", "n2") # to be passed on to JAGS
変数のクリア
Rate_2.txtとRate_2_jags.Rのあるディレクトリへの移動
パッケージの読み込み
観測変数の設定
myinits <- list(list(theta = 0.5))
# parameters to be monitored:parameters <- c("theta")
# The following command calls JAGS with specific options.# For a detailed description see the R2jags documentation.samples <- jags(data, inits=myinits, parameters,
model.file ="Rate_3.txt", n.chains=1, n.iter=1000, n.burnin=1, n.thin=1, DIC=T)
θの初期値の設定
モニターするパラメータの設定
Jagsを呼び出してθをサンプリング
theta <- samples$BUGSoutput$sims.list$theta
# Now let's plot a histogram for theta. # First, some options to make the plot look better:par(cex.main = 1.5, mar = c(5, 6, 4, 5) + 0.1, mgp = c(3.5, 1, 0),
cex.lab = 1.5, font.lab = 2, cex.axis = 1.3, bty = "n", las=1)Nbreaks <- 80y <- hist(theta, Nbreaks, plot=F)plot(c(y$breaks, max(y$breaks)), c(0,y$density,0), type="S", lwd=2, lty=1,
xlim=c(0,1), ylim=c(0,10), xlab="Rate", ylab="Posterior Density")
samplesの中からθのサンプルを取り出す
θの事後分布をプロット
θの点推定、区間推定> mean(theta)[1] 0.5908549> median(theta)[1] 0.5866773> density(theta)$x[which(density(theta)$y==max(density(theta)$y))][1] 0.5824454> quantile(theta, c(.025, .975))
2.5% 97.5%0.3983661 0.7934511
まとめ問題からグラフィカルモデルを作る
グラフィカルモデルからjagsのモデルを記述する
Rのスクリプトを記述(1)ワークスペースへの移動(2)ワークスペースのクリア(3)R2jagsの読み込み(4)観測データの記述(5)パラメータの初期値の設定(6)モニターするパラメータの設定(7)Jagsを実⾏しMCMCによるサンプリングを実⾏(8)サンプリング結果を可視化、点推定、区間推定