गिब्स आउटपुट से सीमांत संभावना

मैं खंड 4.2.1 में परिणामों को खरोंचने से पुन: उत्पन्न कर रहा हूं

सिद्धार्थ चिब

अमेरिकी सांख्यिकी एसोसिएशन जर्नल, खंड। 90, नंबर 432. (दिसंबर, 1995), पीपी। 1313-1321।

यह घटकों के ज्ञात संख्या के साथ मॉडल का मिश्रण है । $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 (*)$

इस मॉडल के लिए गिब्स नमूना को टान्नर और वोंग की डेटा वृद्धि तकनीक का उपयोग करके लागू किया गया है। आवंटन चर एक मान मान शुरू किया गया है, और हम निर्दिष्ट करते हैं कि और । यह इस प्रकार है कि के मूल पर एकीकरण मूल संभावना । $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$ $(*)$

कॉरोना बोरेलिस तारामंडल से $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)

हम मानते हैं कि , का और का स्वतंत्र रूप से एक प्राथमिकता है $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)

बेयर्स प्रमेय का उपयोग करते हुए, पूर्ण सशर्त हैं जिसमें साथ

\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) & \propto w_{j} \times \frac{1}{σ_{j}} e^{- (x_{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\}$ ।

लक्ष्य मॉडल की सीमांत संभावना के लिए एक अनुमान की गणना करना है। चिब की विधि पूर्ण सशर्त का उपयोग करके गिब्स नमूना के पहले रन के साथ शुरू होती है।

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)

इस पहले भाग से हमें अधिकतम संभावना की लगभग एक अनुमानित बिंदु मिलती है । चूंकि संभावना वास्तव में अबाधित है, यह प्रक्रिया संभवतः जो देती है वह एक अनुमानित स्थानीय एमएपी है। $(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,]

सीमांत संभावना के चिब का लॉग-अनुमान

\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}$

हमारे पास पहले से ही पहले दो पद हैं।

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)

राव-ब्लैकवेलिज्ड अनुमान of is और आसानी से प्राप्त किया जाता है पहले गिब्स दौड़ते हैं। $\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,]))))

राव-ब्लैकवेलिज्ड एस्टिमेट ऑफ़ is और एक दूसरे कम गिब्स रन से गणना की जाती है जिसमें अपडेट नहीं होता है, लेकिन बनाया जाता है प्रत्येक पुनरावृत्ति कदम पर बराबर । $\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,]))))

उसी तरह, राव-ब्लैकवेल्ड अनुमान of is और एक तीसरे घटे गिब्स से गणना की जाती है जिसमें 's और the ' s अपडेट नहीं किए जाते, लेकिन और बराबर बनाए जाते हैं क्रमशः प्रत्येक पुनरावृति चरण पर। $\pi(w^*\mid \mu^*,\sigma^{2*},x)$

π (w^{*} ∣ μ^{*}, σ^{2 *}, x) = \int D i r (w^{*} ∣ a_{1} + n_{1}, \dots, a_{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,]))))

इस सब के बाद, हमें एक लॉग-अनुमान मिलता है, जो मोंटे कार्लो त्रुटि साथ चिब: द्वारा गए से बड़ा है । $-217.9199$ $-224.138$ $.086$

यह जांचने के लिए कि क्या मैंने किसी तरह गिब्स के नमूनों को गड़बड़ किया है, मैंने आरजेएजीएस का उपयोग करके पूरी बात को फिर से लागू किया। निम्न कोड समान परिणाम देता है।

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

मेरा प्रश्न यह है कि यदि उपरोक्त विवरण में चिब की विधि की गलतफहमी हो या इसके कार्यान्वयन में कोई गलती हो।

bayesian mixture gibbs

— जेन
स्रोत

100 बार सिमुलेशन चलाने पर, परिणाम रेंज में ।

[- 218.7655; - 216.8824]

$[-218.7655; -216.8824]$

— ज़ेन

पूर्व में थोड़ी प्रोग्रामिंग की गलती है

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

जैसा कि इसके बजाय होना चाहिए

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
[1] -228.194

जो उस मामले के लिए चिब (1995) में उत्पादित मूल्य नहीं है! हालाँकि, नील की समस्या के (1999) reanalysis में, वह उल्लेख करता है

एक अनाम जेएएसए रेफरी के अनुसार, चिब के कागज में दिए गए असमान परिवर्तन के साथ तीन घटक मॉडल के लिए सीमांत संभावना के लॉग के लिए -224.138 का आंकड़ा एक "टाइपो" है जो सही आंकड़ा -228.608 है।

तो यह विसंगति के मुद्दे को हल करता है।

— शीआन
स्रोत

प्रो। क्रिश्चियन रॉबर्ट और केट ली: क्या आप जानते हैं कि आप कितने महान हैं?

— जेन

वैसे, यह निश्चित रूप से "बुराई वाक्यविन्यास" का एक उदाहरण है। मैं इसे नहीं भूलूंगा।

— ज़ेन