Confuso com as variações do MCMC Metropolis-Hastings: Passeio aleatório, Passeio não aleatório, Independente, Metropolis

Nas últimas semanas, tenho tentado entender o MCMC e o (s) algoritmo (s) Metropolis-Hastings. Toda vez que acho que entendo, percebo que estou errado. A maioria dos exemplos de código que eu acho on-line implementa algo que não é consistente com a descrição. ie: Eles dizem que implementam Metropolis-Hastings, mas na verdade implementam metrópoles de passeio aleatório. Outros (quase sempre) ignoram silenciosamente a implementação da taxa de correção de Hastings porque estão usando uma distribuição de proposta simétrica. Na verdade, não encontrei um único exemplo simples que calcule a proporção até agora. Isso me deixa ainda mais confuso. Alguém pode me dar exemplos de código (em qualquer idioma) do seguinte:

• Algoritmo de metrópole-Hastings com caminhada não aleatória de baunilha com cálculo da taxa de correção de Hastings (mesmo que isso acabe sendo 1 ao usar uma distribuição de proposta simétrica).
• Algoritmo de Metropolis-Hastings da Baía Aleatória Caminhada.
• Algoritmo independente de Vanilla Metropolis-Hastings.

Não há necessidade de fornecer os algoritmos Metropolis porque, se não me engano, a única diferença entre Metropolis e Metropolis-Hastings é que os primeiros sempre amostram a partir de uma distribuição simétrica e, portanto, não têm a taxa de correção de Hastings. Não é necessário fornecer uma explicação detalhada dos algoritmos. Eu entendo o básico, mas estou meio confuso com todos os nomes diferentes para as diferentes variações do algoritmo Metropolis-Hastings, mas também com como você praticamente implementa a taxa de correção de Hastings no MH de caminhada não aleatória da Baunilha. Por favor, não copie e cole links que respondam parcialmente às minhas perguntas, porque provavelmente já os vi. Esses links me levaram a essa confusão. Obrigado.

Aqui você vai - três exemplos. Tornei o código muito menos eficiente do que seria em um aplicativo real para tornar a lógica mais clara (espero).

# 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)

Para o amostrador de baunilha, obtemos:

> 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 

que é uma baixa probabilidade de aceitação, mas ainda assim ... o ajuste da proposta ajudaria aqui ou a adoção de uma proposta diferente. Aqui estão os resultados da proposta de passeio aleatório:

> 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 

Resultados semelhantes, como se poderia esperar, e uma melhor probabilidade de aceitação (visando ~ 50% com um parâmetro).

E, para completar, o amostrador de independência:

> 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 

Como não se "adapta" à forma do posterior, tende a ter a menor probabilidade de aceitação e é mais difícil de se ajustar bem a esse problema.

Observe que, de um modo geral, preferimos propostas com caudas mais gordas, mas esse é outro assunto.

Vejo:

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

O artigo da Wikipedia é uma boa leitura complementar. Como você pode ver, o Metropolis também possui uma "taxa de correção", mas, como mencionado acima, Hastings introduziu uma modificação que permite distribuições de propostas não simétricas.

O algoritmo Metropolis é implementado no pacote R mcmcsob o comandometrop() .

Outros exemplos de código:

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/