MCMC Metropolis-Hastingsバリエーションと混同：ランダムウォーク、非ランダムウォーク、独立、メトロポリス

過去数週間にわたって、MCMCとMetropolis-Hastingsアルゴリズムを理解しようと試みてきました。私はそれを理解すると思うたびに、自分が間違っていることに気づきます。私がオンラインで見つけたコード例のほとんどは、説明と一致しないものを実装しています。すなわち、彼らはメトロポリス・ヘイスティングスを実装すると言いますが、実際にはランダムウォーク・メトロポリスを実装します。他の（ほぼ常に）対称提案提案分布を使用しているため、ヘイスティングス補正率の実装を静かにスキップします。実際、これまでに比率を計算する簡単な例は見つかりませんでした。それは私をさらに混乱させます。誰かが次のコード例を（すべての言語で）教えてもらえますか？

• バニラノンランダムウォークメトロポリスヘイスティングスアルゴリズムとヘイスティングス補正率の計算（対称プロポーザル分布を使用する場合、これが1になる場合でも）。
• バニラランダムウォークメトロポリスヘイスティングスアルゴリズム。
• Vanilla Independent Metropolis-Hastingsアルゴリズム。

メトロポリスとメトロポリス-ヘイスティングスの唯一の違いは、最初のアルゴリズムが常に対称分布からサンプリングしているため、ヘイスティングス補正率がないため、メトロポリスアルゴリズムを提供する必要はありません。アルゴリズムの詳細な説明をする必要はありません。私は基本を理解していますが、Metropolis-Hastingsアルゴリズムのさまざまなバリエーションのすべての異なる名前と、Vanillaの非ランダムウォークMHにヘイスティングス補正率を実際に実装する方法と混同されています。ほとんどの場合既に質問を見たことがあるため、私の質問に部分的に答える貼り付けリンクをコピーしないでください。それらのリンクは私をこの混乱に導いた。ありがとうございました。

ここに行きます-3つの例。ロジックを明確にするために、実際のアプリケーションよりもコードの効率を大幅に下げました（願っています）。

# We'll assume estimation of a Poisson mean as a function of x
x <- runif(100)
y <- rpois(100,5*x)  # beta = 5 where mean(y[i]) = beta*x[i]

# Prior distribution on log(beta): t(5) with mean 2 
# (Very spread out on original scale; median = 7.4, roughly)
log_prior <- function(log_beta) dt(log_beta-2, 5, log=TRUE)

# Log likelihood
log_lik <- function(log_beta, y, x) sum(dpois(y, exp(log_beta)*x, log=TRUE))

# Random Walk Metropolis-Hastings 
# Proposal is centered at the current value of the parameter

rw_proposal <- function(current) rnorm(1, current, 0.25)
rw_p_proposal_given_current <- function(proposal, current) dnorm(proposal, current, 0.25, log=TRUE)
rw_p_current_given_proposal <- function(current, proposal) dnorm(current, proposal, 0.25, log=TRUE)

rw_alpha <- function(proposal, current) {
   # Due to the structure of the rw proposal distribution, the rw_p_proposal_given_current and
   # rw_p_current_given_proposal terms cancel out, so we don't need to include them - although
   # logically they are still there:  p(prop|curr) = p(curr|prop) for all curr, prop
   exp(log_lik(proposal, y, x) + log_prior(proposal) - log_lik(current, y, x) - log_prior(current))
}

# Independent Metropolis-Hastings
# Note: the proposal is independent of the current value (hence the name), but I maintain the
# parameterization of the functions anyway.  The proposal is not ignorable any more
# when calculation the acceptance probability, as p(curr|prop) != p(prop|curr) in general.

ind_proposal <- function(current) rnorm(1, 2, 1) 
ind_p_proposal_given_current <- function(proposal, current) dnorm(proposal, 2, 1, log=TRUE)
ind_p_current_given_proposal <- function(current, proposal) dnorm(current, 2, 1, log=TRUE)

ind_alpha <- function(proposal, current) {
   exp(log_lik(proposal, y, x)  + log_prior(proposal) + ind_p_current_given_proposal(current, proposal) 
       - log_lik(current, y, x) - log_prior(current) - ind_p_proposal_given_current(proposal, current))
}

# Vanilla Metropolis-Hastings - the independence sampler would do here, but I'll add something
# else for the proposal distribution; a Normal(current, 0.1+abs(current)/5) - symmetric but with a different
# scale depending upon location, so can't ignore the proposal distribution when calculating alpha as
# p(prop|curr) != p(curr|prop) in general

van_proposal <- function(current) rnorm(1, current, 0.1+abs(current)/5)
van_p_proposal_given_current <- function(proposal, current) dnorm(proposal, current, 0.1+abs(current)/5, log=TRUE)
van_p_current_given_proposal <- function(current, proposal) dnorm(current, proposal, 0.1+abs(proposal)/5, log=TRUE)

van_alpha <- function(proposal, current) {
   exp(log_lik(proposal, y, x)  + log_prior(proposal) + ind_p_current_given_proposal(current, proposal) 
       - log_lik(current, y, x) - log_prior(current) - ind_p_proposal_given_current(proposal, current))
}


# Generate the chain
values <- rep(0, 10000) 
u <- runif(length(values))
naccept <- 0
current <- 1  # Initial value
propfunc <- van_proposal  # Substitute ind_proposal or rw_proposal here
alphafunc <- van_alpha    # Substitute ind_alpha or rw_alpha here
for (i in 1:length(values)) {
   proposal <- propfunc(current)
   alpha <- alphafunc(proposal, current)
   if (u[i] < alpha) {
      values[i] <- exp(proposal)
      current <- proposal
      naccept <- naccept + 1
   } else {
      values[i] <- exp(current)
   }
}
naccept / length(values)
summary(values)

バニラサンプラーの場合、次のようになります。

> naccept / length(values)
[1] 0.1737
> summary(values)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  2.843   5.153   5.388   5.378   5.594   6.628 

これは受け入れられる可能性は低いですが、それでも...ここで提案を調整するか、別の提案を採用します。ランダムウォークの提案結果は次のとおりです。

> naccept / length(values)
[1] 0.2902
> summary(values)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  2.718   5.147   5.369   5.370   5.584   6.781 

希望するように、同様の結果と、より良い受け入れ確率（1つのパラメーターで最大50％を目指します）

そして、完全性のために、独立サンプラーは：

> naccept / length(values)
[1] 0.0684
> summary(values)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  3.990   5.162   5.391   5.380   5.577   8.802 

後部の形状に「適応」しないため、受入確率が最も低くなる傾向があり、この問題をうまく調整することは最も困難です。

一般的に言えば、私たちは太い尾を持つ提案を好むでしょうが、それはまったく別のトピックです。

見る：

$q()$${\bf x}$

Wikipediaの記事は良い相補の読み出しです。ご覧のとおり、メトロポリスにも「修正率」がありますが、前述のように、ヘイスティングスは非対称のプロポーザル配布を可能にする修正を導入しました。

Metropolisアルゴリズムはmcmc、コマンドでRパッケージに実装されていますmetrop()。

他のコード例：

http://www.mas.ncl.ac.uk/~ndjw1/teaching/sim/metrop/

http://pcl.missouri.edu/jeff/node/322

http://darrenjw.wordpress.com/2010/08/15/metropolis-hastings-mcmc-algorithms/