Khả năng cận biên từ đầu ra Gibbs

Tôi đang sao chép từ đầu các kết quả trong Mục 4.2.1 của

Siddhartha Chib

Tạp chí của Hiệp hội Thống kê Hoa Kỳ, Tập. 90, số 432. (tháng 12 năm 1995), trang 1313-1321.

Đây là một hỗn hợp của mô hình chuẩn với số của các thành phần đã biết. $k\geq 1$

f (x ∣ w, μ, σ^{2}) = \prod_{i = 1}^{n} \sum_{j = 1}^{k} N (x_{i} ∣ μ_{j}, σ_{j}^{2}) . (*)

$f(x\mid w,\mu,\sigma^2) =\prod_{i=1}^n\sum_{j=1}^k \mathrm{N}(x_i\mid\mu_j,\sigma_j^2) \, . \qquad (*)$

Bộ lấy mẫu Gibbs cho mô hình này được triển khai bằng kỹ thuật tăng dữ liệu của Tanner và Wong. Một tập hợp các biến phân bổ giả sử các giá trị được giới thiệu và chúng tôi chỉ định rằng và . Theo sau đó, việc tích hợp trên sẽ mang lại khả năng ban đầu . $z=(z_1,\dots,z_n)$ $1,\dots,k$ $\Pr(z_i=j\mid w)=w_j$ $f(x_i\mid z,\mu,\sigma^2)=\mathrm{N}(x_i\mid\mu_{z_i},\sigma^2_{z_i})$ $z_i$ $(*)$

Bộ dữ liệu được hình thành bởi vận tốc của thiên hà từ chòm sao Corona Borealis. $82$

set.seed(1701)

x <- c(  9.172,  9.350,  9.483,  9.558,  9.775, 10.227, 10.406, 16.084, 16.170, 18.419, 18.552, 18.600, 18.927,
        19.052, 19.070, 19.330, 19.343, 19.349, 19.440, 19.473, 19.529, 19.541, 19.547, 19.663, 19.846, 19.856,
        19.863, 19.914, 19.918, 19.973, 19.989, 20.166, 20.175, 20.179, 20.196, 20.215, 20.221, 20.415, 20.629,
        20.795, 20.821, 20.846, 20.875, 20.986, 21.137, 21.492, 21.701, 21.814, 21.921, 21.960, 22.185, 22.209,
        22.242, 22.249, 22.314, 22.374, 22.495, 22.746, 22.747, 22.888, 22.914, 23.206, 23.241, 23.263, 23.484,
        23.538, 23.542, 23.666, 23.706, 23.711, 24.129, 24.285, 24.289, 24.366, 24.717, 24.990, 25.633, 26.960,
        26.995, 32.065, 32.789, 34.279 )

nn <- length(x)

Chúng tôi giả sử rằng , và là độc lập với một tiên nghiệm với $w$ $\mu_j$ $\sigma^2_j$

(w_{1}, \dots, w_{k}) \sim D i r (a_{1}, \dots, a_{k}), μ_{j} \sim N (μ_{0}, σ_{0}^{2}), σ_{j}^{2} \sim I G (\frac{ν_{0}}{2}, \frac{δ_{0}}{2}) .

$(w_1,\dots,w_k) \sim \mathrm{Dir}(a_1,\dots,a_k) \, , \quad \mu_j \sim \mathrm{N}(\mu_0,\sigma_0^2) \, , \quad \sigma^2_j\sim\mathrm{IG}\!\left(\frac{\nu_0}{2},\frac{\delta_0}{2}\right) \, .$

k <- 3

mu0 <- 20
va0 <- 100

nu0 <- 6
de0 <- 40

a <- rep(1, k)

Sử dụng Định lý Bayes, các điều kiện đầy đủ là trong đó với

\begin{aligned} w ∣ μ, σ^{2}, z, x & \sim D i r (a_{1} + n_{1}, \dots, a_{k} + n_{k}) \\ μ_{j} ∣ w, σ^{2}, z, x & \sim N (\frac{n_{j} m_{j} σ_{0}^{2} + μ_{0} σ_{j}^{2}}{n_{j} σ_{0}^{2} + σ_{j}^{2}}, \frac{σ_{0}^{2} σ_{j}^{2}}{n_{j} σ_{0}^{2} + σ_{j}^{2}}) \\ σ_{j}^{2} ∣ w, μ, z, x & \sim I G (\frac{ν_{0} + n_{j}}{2}, \frac{δ_{0} + δ_{j}}{2}) \\ Pr (z_{i} = j ∣ w, μ, σ^{2}, x) & α w_{j} \times \frac{1}{σ_{j}} e^{- (x_{Tôi} - μ_{j})^{2} / 2 σ_{j}^{2}} \end{aligned}

$\begin{align*} w \mid \mu,\sigma^2,z,x &\sim \mathrm{Dir}(a_1+n_1,\dots,a_k+n_k) \\ \mu_j \mid w, \sigma^2,z,x &\sim \mathrm{N}\!\left( \frac{n_j m_j\sigma_0^2+\mu_0\sigma_j^2}{n_j\sigma^2_0+\sigma^2_j}, \frac{\sigma^2_0\sigma^2_j}{n_j\sigma^2_0+\sigma^2_j}\right) \\ \sigma_j^2 \mid w,\mu,z,x &\sim \mathrm{IG}\!\left( \frac{\nu_0+n_j}{2},\frac{\delta_0+\delta_j}{2}\right) \\ \Pr(z_i=j\mid w,\mu,\sigma^2,x) &\propto w_j \times \frac{1}{\sigma_j}e^{-(x_i-\mu_j)^2/2\sigma_j^2} \end{align*}$

n_{j} = | L_{j} |, m_{j} = {\begin{cases} \frac{1}{n_{j}} \sum_{i \in L_{j}} x_{i} & i f n_{j} > 0 \\ 0 & o t h e r w i s e . \end{cases}, δ_{j} = \sum_{i \in L_{j}} (x_{i} - μ_{j})^{2},

$n_j = |L_j| \, , \qquad m_j = \begin{cases}\frac{1}{n_j}\sum_{i\in L_j} x_i &\;\mathrm{if}\; n_j>0 \\ 0 &\;\mathrm{otherwise.} \end{cases}\, , \qquad \delta_j = \sum_{i\in L_j} (x_i-\mu_j)^2 \, ,$

L_{j} = {i \in {1, \dots, n} : z_{i} = j}

$L_j=\{i\in\{1,\dots,n\}:z_i=j\}$ .

Mục tiêu là để tính toán một ước tính cho khả năng cận biên của mô hình. Phương pháp của Chib bắt đầu với lần chạy đầu tiên của bộ lấy mẫu Gibbs bằng cách sử dụng các điều kiện đầy đủ.

burn_in <- 1000
run     <- 15000

cat("First Gibbs run (full):\n")

N <- burn_in + run

w  <- matrix(1, nrow = N, ncol = k)
mu <- matrix(0, nrow = N, ncol = k)
va <- matrix(1, nrow = N, ncol = k)
z  <- matrix(1, nrow = N, ncol = nn)

n <- integer(k)
m <- numeric(k)
de <- numeric(k)

rdirichlet <- function(a) { y <- rgamma(length(a), a, 1); y / sum(y) }

pb <- txtProgressBar(min = 2, max = N, style = 3)
z[1,] <- sample.int(k, size = nn, replace = TRUE)
for (t in 2:N) {
    n <- tabulate(z[t-1,], nbins = k)
    w[t,] <- rdirichlet(a + n)
    m <- sapply(1:k, function(j) sum(x[z[t-1,]==j]))
    m[n > 0] <- m[n > 0] / n[n > 0]
    mu[t,] <- rnorm(k, mean = (n*m*va0+mu0*va[t-1,])/(n*va0+va[t-1,]), sd = sqrt(va0*va[t-1,]/(n*va0+va[t-1,])))
    de <- sapply(1:k, function(j) sum((x[z[t-1,]==j] - mu[t,j])^2))
    va[t,] <- 1 / rgamma(k, shape = (nu0+n)/2, rate = (de0+de)/2)
    z[t,] <- sapply(1:nn, function(i) sample.int(k, size = 1, prob = exp(log(w[t,]) + dnorm(x[i], mean = mu[t,], sd = sqrt(va[t,]), log = TRUE))))
    setTxtProgressBar(pb, t)
}
close(pb)

Từ lần chạy đầu tiên này, chúng tôi nhận được một điểm gần đúng về khả năng tối đa. Vì khả năng thực sự không bị ràng buộc, những gì thủ tục này có thể mang lại là một MAP địa phương gần đúng. $(w^*,\mu^*,\sigma^{2*})$

w  <- w[(burn_in+1):N,]
mu <- mu[(burn_in+1):N,]
va <- va[(burn_in+1):N,]
z  <- z[(burn_in+1):N,]
N  <- N - burn_in

log_L <- function(x, w, mu, va) sum(log(sapply(1:nn, function(i) sum(exp(log(w) + dnorm(x[i], mean = mu, sd = sqrt(va), log = TRUE))))))

ts <- which.max(sapply(1:N, function(t) log_L(x, w[t,], mu[t,], va[t,])))

ws <- w[ts,]
mus <- mu[ts,]
vas <- va[ts,]

Ước tính log của Chib về khả năng cận biên là

\begin{aligned} \log \hat{f (x)} & = \log L_{x} (w^{*}, μ^{*}, σ^{2 *}) + \log π (w^{*}, μ^{*}, σ^{2 *}) \\ - \log π (μ^{*} ∣ x) - \log π (σ^{2 *} ∣ μ^{*}, x) - \log π (w^{*} ∣ μ^{*}, σ^{2 *}, x) . \end{aligned}

$\begin{align} \log \widehat{f(x)} &= \log L_x(w^*,\mu^*,\sigma^{2*}) + \log \pi(w^*,\mu^*,\sigma^{2*}) \\ &- \log \pi(\mu^*\mid x) - \log \pi(\sigma^{2*}\mid \mu^*,x) - \log \pi(w^*\mid \mu^*,\sigma^{2*},x) \, . \end{align}$

Chúng tôi đã có hai điều khoản đầu tiên.

log_prior <- function(w, mu, va) {
    lgamma(sum(a)) - sum(lgamma(a)) + sum((a-1)*log(w))
    + sum(dnorm(mu, mean = mu0, sd = sqrt(va0), log = TRUE))
    + sum((nu0/2)*log(de0/2) - lgamma(nu0/2) - (nu0/2+1)*log(va) - de0/(2*va))
}

chib <- log_L(x, ws, mus, vas) + log_prior(ws, mus, vas)

Ước tính Rao-Blackwellized của là và có sẵn từ lần chạy Gibbs đầu tiên. $\pi(\mu^*\mid x)$

π (μ^{*} ∣ x) = \int \prod_{j = 1}^{k} N (μ_{j}^{*} | \frac{n_{j} m_{j} σ_{0}^{2} + μ_{0} σ_{j}^{2}}{n_{j} σ_{0}^{2} + σ_{j}^{2}}, \frac{σ_{0}^{2} σ_{j}^{2}}{n_{j} σ_{0}^{2} + σ_{j}^{2}}) p (σ^{2}, z ∣ x) d σ^{2} d z,

$\pi(\mu^*\mid x) = \int \prod_{j=1}^k \mathrm{N}\!\left(\mu_j^* \;\Bigg|\; \frac{n_j m_j\sigma_0^2+\mu_0\sigma_j^2}{n_j\sigma^2_0+\sigma^2_j}, \frac{\sigma^2_0\sigma^2_j}{n_j\sigma^2_0+\sigma^2_j}\right)\,p(\sigma^{2},z\mid x)\,d\sigma^2\,dz \, ,$

pi.mu_va.z.x <- function(mu, va, z) {
    n <- tabulate(z, nbins = k)
    m <- sapply(1:k, function(j) sum(x[z==j]))
    m[n > 0] <- m[n > 0] / n[n > 0]
    exp(sum(dnorm(mu, mean = (n*m*va0+mu0*va)/(n*va0+va), sd = sqrt(va0*va/(n*va0+va)), log = TRUE)))
}

chib <- chib - log(mean(sapply(1:N, function(t) pi.mu_va.z.x(mus, va[t,], z[t,]))))

Ước tính Rao-Blackwellized của là và được tính từ lần chạy Gibbs giảm thứ hai trong đó không được cập nhật, nhưng được thực hiện bằng ở mỗi bước lặp. $\pi(\sigma^{2*}\mid \mu^*,x)$

π (σ^{2 *} ∣ μ^{*}, x) = \int \prod_{j = 1}^{k} I G (σ_{j}^{2 *} | \frac{ν_{0} + n_{j}}{2}, \frac{δ_{0} + δ_{j}}{2}) p (z | μ^{*}, x) d z,

$\pi(\sigma^{2*}\mid \mu^*,x) = \int \prod_{j=1}^k \mathrm{IG}\!\left( \sigma^{2*}_j \;\Bigg|\; \frac{\nu_0+n_j}{2},\frac{\delta_0+\delta_j}{2}\right) \, p(z\mid\mu^*,x)\,dz \, ,$

μ_{j}

$\mu_j$

μ_{j}^{*}

$\mu^*_j$

cat("Second Gibbs run (reduced):\n")

N <- burn_in + run

w  <- matrix(1, nrow = N, ncol = k)
va <- matrix(1, nrow = N, ncol = k)
z  <- matrix(1, nrow = N, ncol = nn) 

pb <- txtProgressBar(min = 2, max = N, style = 3)
z[1,] <- sample.int(k, size = nn, replace = TRUE)
for (t in 2:N) {
    n <- tabulate(z[t-1,], nbins = k)
    w[t,] <- rdirichlet(a + n)
    de <- sapply(1:k, function(j) sum((x[z[t-1,]==j] - mus[j])^2))
    va[t,] <- 1 / rgamma(k, shape = (nu0+n)/2, rate = (de0+de)/2)
    z[t,] <- sapply(1:nn, function(i) sample.int(k, size = 1, prob = exp(log(w[t,]) + dnorm(x[i], mean = mus, sd = sqrt(va[t,]), log = TRUE))))
    setTxtProgressBar(pb, t)
}
close(pb)

w  <- w[(burn_in+1):N,]
va <- va[(burn_in+1):N,]
z  <- z[(burn_in+1):N,]
N  <- N - burn_in

pi.va_mu.z.x <- function(va, mu, z) {
    n <- tabulate(z, nbins = k)         
    de <- sapply(1:k, function(j) sum((x[z==j] - mu[j])^2))
    exp(sum(((nu0+n)/2)*log((de0+de)/2) - lgamma((nu0+n)/2) - ((nu0+n)/2+1)*log(va) - (de0+de)/(2*va)))
}

chib <- chib - log(mean(sapply(1:N, function(t) pi.va_mu.z.x(vas, mus, z[t,]))))

Theo cách tương tự, ước tính Rao-Blackwellized của là và được tính từ lần chạy Gibbs giảm thứ ba trong đó và không được cập nhật, nhưng được thực hiện bằng và tương ứng ở mỗi bước lặp. $\pi(w^*\mid \mu^*,\sigma^{2*},x)$

π (w^{*} | μ^{*}, σ^{2 *}, x) = = \int D Tôi r (w^{*} | {một}_{1} + n_{1}, Giáo dục, {một}_{k} + n_{k}) p (z | μ^{*}, σ^{2 *}, x) d z,

$\pi(w^*\mid \mu^*,\sigma^{2*},x) = \int \mathrm{Dir}(w^* \mid a_1+n_1,\dots,a_k+n_k) \, p(z\mid\mu^*,\sigma^{2*},x)\,dz \, ,$

μ_{j}

$\mu_j$

σ_{j}^{2}

$\sigma^2_j$

μ_{j}^{*}

$\mu^*_j$

σ_{j}^{2 *}

$\sigma^{2*}_j$

cat("Third Gibbs run (reduced):\n")

N <- burn_in + run

w  <- matrix(1, nrow = N, ncol = k)
z  <- matrix(1, nrow = N, ncol = nn) 

pb <- txtProgressBar(min = 2, max = N, style = 3)
z[1,] <- sample.int(k, size = nn, replace = TRUE)
for (t in 2:N) {
    n <- tabulate(z[t-1,], nbins = k)
    w[t,] <- rdirichlet(a + n)
    z[t,] <- sapply(1:nn, function(i) sample.int(k, size = 1, prob = exp(log(w[t,]) + dnorm(x[i], mean = mus, sd = sqrt(vas), log = TRUE))))
    setTxtProgressBar(pb, t)
}
close(pb)

w  <- w[(burn_in+1):N,]
z  <- z[(burn_in+1):N,]
N  <- N - burn_in

pi.w_z.x <- function(w, z) {
    n <- tabulate(z, nbins = k)
    exp(lgamma(sum(a+n)) - sum(lgamma(a+n)) + sum((a+n-1)*log(w)))
}

chib <- chib - log(mean(sapply(1:N, function(t) pi.w_z.x(ws, z[t,]))))

Sau khi tất cả điều này, chúng ta có được một đăng nhập ước tính đó là lớn hơn so với cái báo cáo của Chib: với Monte Carlo lỗi . $-217.9199$ $-224.138$ $.086$

Để kiểm tra xem bằng cách nào đó tôi đã làm rối tung các bộ lấy mẫu Gibbs, tôi đã thực hiện lại toàn bộ bằng cách sử dụng RJAGS. Các mã sau đây cho kết quả tương tự.

x <- c( 9.172,  9.350,  9.483,  9.558,  9.775, 10.227, 10.406, 16.084, 16.170, 18.419, 18.552, 18.600, 18.927, 19.052, 19.070, 19.330,
       19.343, 19.349, 19.440, 19.473, 19.529, 19.541, 19.547, 19.663, 19.846, 19.856, 19.863, 19.914, 19.918, 19.973, 19.989, 20.166,
       20.175, 20.179, 20.196, 20.215, 20.221, 20.415, 20.629, 20.795, 20.821, 20.846, 20.875, 20.986, 21.137, 21.492, 21.701, 21.814,
       21.921, 21.960, 22.185, 22.209, 22.242, 22.249, 22.314, 22.374, 22.495, 22.746, 22.747, 22.888, 22.914, 23.206, 23.241, 23.263,
       23.484, 23.538, 23.542, 23.666, 23.706, 23.711, 24.129, 24.285, 24.289, 24.366, 24.717, 24.990, 25.633, 26.960, 26.995, 32.065,
       32.789, 34.279 )

library(rjags)

nn <- length(x)

k <- 3

mu0 <- 20
va0 <- 100

nu0 <- 6
de0 <- 40

a <- rep(1, k)

burn_in <- 10^3

N <- 10^4

full <- "
    model {
        for (i in 1:n) {
            x[i] ~ dnorm(mu[z[i]], tau[z[i]])
            z[i] ~ dcat(w[])
        }
        for (i in 1:k) {
            mu[i] ~ dnorm(mu0, 1/va0)
            tau[i] ~ dgamma(nu0/2, de0/2)
            va[i] <- 1/tau[i]
        }
        w ~ ddirich(a)
    }
"
data <- list(x = x, n = nn, k = k, mu0 = mu0, va0 = va0, nu0 = nu0, de0 = de0, a = a)
model <- jags.model(textConnection(full), data = data, n.chains = 1, n.adapt = 100)
update(model, n.iter = burn_in)
samples <- jags.samples(model, c("mu", "va", "w", "z"), n.iter = N)

mu <- matrix(samples$mu, nrow = N, byrow = TRUE)
    va <- matrix(samples$va, nrow = N, byrow = TRUE)
w <- matrix(samples$w, nrow = N, byrow = TRUE)
    z <- matrix(samples$z, nrow = N, byrow = TRUE)

log_L <- function(x, w, mu, va) sum(log(sapply(1:nn, function(i) sum(exp(log(w) + dnorm(x[i], mean = mu, sd = sqrt(va), log = TRUE))))))

ts <- which.max(sapply(1:N, function(t) log_L(x, w[t,], mu[t,], va[t,])))

ws <- w[ts,]
mus <- mu[ts,]
vas <- va[ts,]

log_prior <- function(w, mu, va) {
    lgamma(sum(a)) - sum(lgamma(a)) + sum((a-1)*log(w))
    + sum(dnorm(mu, mean = mu0, sd = sqrt(va0), log = TRUE))
    + sum((nu0/2)*log(de0/2) - lgamma(nu0/2) - (nu0/2+1)*log(va) - de0/(2*va))
}

chib <- log_L(x, ws, mus, vas) + log_prior(ws, mus, vas)

cat("log-likelihood + log-prior =", chib, "\n")

pi.mu_va.z.x <- function(mu, va, z, x) {
    n <- sapply(1:k, function(j) sum(z==j))
    m <- sapply(1:k, function(j) sum(x[z==j]))
    m[n > 0] <- m[n > 0] / n[n > 0]
    exp(sum(dnorm(mu, mean = (n*m*va0+mu0*va)/(n*va0+va), sd = sqrt(va0*va/(n*va0+va)), log = TRUE)))
}

chib <- chib - log(mean(sapply(1:N, function(t) pi.mu_va.z.x(mus, va[t,], z[t,], x))))

cat("log-likelihood + log-prior - log-pi.mu_ =", chib, "\n")

fixed.mu <- "
    model {
        for (i in 1:n) {
            x[i] ~ dnorm(mus[z[i]], tau[z[i]])
            z[i] ~ dcat(w[])
        }
        for (i in 1:k) {
            tau[i] ~ dgamma(nu0/2, de0/2)
            va[i] <- 1/tau[i]
        }
        w ~ ddirich(a)
    }
"
data <- list(x = x, n = nn, k = k, nu0 = nu0, de0 = de0, a = a, mus = mus)
model <- jags.model(textConnection(fixed.mu), data = data, n.chains = 1, n.adapt = 100)
update(model, n.iter = burn_in)
samples <- jags.samples(model, c("va", "w", "z"), n.iter = N)

va <- matrix(samples$va, nrow = N, byrow = TRUE)
    w <- matrix(samples$w, nrow = N, byrow = TRUE)
z <- matrix(samples$z, nrow = N, byrow = TRUE)

pi.va_mu.z.x <- function(va, mu, z, x) {
    n <- sapply(1:k, function(j) sum(z==j))
    de <- sapply(1:k, function(j) sum((x[z==j] - mu[j])^2))
    exp(sum(((nu0+n)/2)*log((de0+de)/2) - lgamma((nu0+n)/2) - ((nu0+n)/2+1)*log(va) - (de0+de)/(2*va)))
}

chib <- chib - log(mean(sapply(1:N, function(t) pi.va_mu.z.x(vas, mus, z[t,], x))))

cat("log-likelihood + log-prior - log-pi.mu_ - log-pi.va_ =", chib, "\n")

fixed.mu.and.va <- "
    model {
        for (i in 1:n) {
            x[i] ~ dnorm(mus[z[i]], 1/vas[z[i]])
            z[i] ~ dcat(w[])
        }
        w ~ ddirich(a)
    }
"
data <- list(x = x, n = nn, a = a, mus = mus, vas = vas)
model <- jags.model(textConnection(fixed.mu.and.va), data = data, n.chains = 1, n.adapt = 100)
update(model, n.iter = burn_in)
samples <- jags.samples(model, c("w", "z"), n.iter = N)

w <- matrix(samples$w, nrow = N, byrow = TRUE)
    z <- matrix(samples$z, nrow = N, byrow = TRUE)

pi.w_z.x <- function(w, z, x) {
    n <- sapply(1:k, function(j) sum(z==j))
    exp(lgamma(sum(a)+nn) - sum(lgamma(a+n)) + sum((a+n-1)*log(w)))
}

chib <- chib - log(mean(sapply(1:N, function(t) pi.w_z.x(ws, z[t,], x))))

cat("log-likelihood + log-prior - log-pi.mu_ - log-pi.va_ - log-pi.w_ =", chib, "\n")

Câu hỏi của tôi là nếu trong phần mô tả ở trên có bất kỳ sự hiểu lầm nào về phương pháp của Chib hoặc bất kỳ sai lầm nào trong quá trình thực hiện.

bayesian mixture gibbs

— thiền học
nguồn

Chạy mô phỏng 100 lần, kết quả nằm trong phạm vi .

[- 218.7655; - 216.8824]

$[-218.7655; -216.8824]$

— Zen

Có một lỗi lập trình nhỏ ở trước

log_prior <- function(w, mu, va) {
    lgamma(sum(a)) - sum(lgamma(a)) + sum((a-1)*log(w))
    + sum(dnorm(mu, mean = mu0, sd = sqrt(va0), log = TRUE))
    + sum((nu0/2)*log(de0/2) - lgamma(nu0/2) - (nu0/2+1)*log(va) - de0/(2*va))
}

vì nó nên được thay thế

log_prior <- function(w, mu, va) {
    lgamma(sum(a)) - sum(lgamma(a)) + sum((a-1)*log(w)) +
      sum(dnorm(mu, mean = mu0, sd = sqrt(va0), log = TRUE)) +
      sum((nu0/2)*log(de0/2) - lgamma(nu0/2) - (nu0/2+1)*log(va) - de0/(2*va))
}

Chạy lại mã theo cách này dẫn đến

> chib
[1] -228.194

đó không phải là giá trị được tạo ra trong Chib (1995) cho trường hợp đó! Tuy nhiên, trong phân tích lại vấn đề của Neal (1999), ông đã đề cập rằng

Theo một trọng tài JASA ẩn danh, con số -224.138 cho nhật ký về khả năng cận biên của mô hình ba thành phần với phương sai không bằng nhau được đưa ra trong bài báo của Chib là một "lỗi đánh máy" với con số chính xác là -228.608.

Vì vậy, điều này giải quyết vấn đề khác biệt.

— Tây An
nguồn

Giáo sư Christian Robert và Kate Lee: bạn có biết bạn tuyệt vời như thế nào không?

— Zen

Nhân tiện, đây chắc chắn là một ví dụ về "cú pháp ác". Tôi sẽ không quên điều này.

— Zen