Gibbs for mutinomial model

simulate y

library(BGSIMD)
library(ggplot2)
a = c(0.2, 0.4, 0.1, 0.5)
b = c(0.05, 0.1, 0.1, 0.15)
miu0 = c(0.35, 0.35, 0.25, 0.25)
be <- c(a * miu0 + b, 1 - sum(a * miu0 + b))
y <- c(rmultinom(1, 30000, be))

the length of y is 30000,make sure that it's propoer to estimate

the main function of the programming


muti_gibbs <- function(n = 10000) {
    z <- data.frame(1:n, 1:n, 1:n, 1:n)
    miu <- rep(0, n)
    eta <- rep(0, n)
    z[1, ] <- c(1, 2, 3, 4)
    for (i in 2:n) {
        alpha = c(z[i - 1, 1] + z[i - 1, 2] + 0.5, z[i - 1, 3] + z[i - 1, 4] + 
            0.5, y[5] + 0.5)
        r1 <- rdirichlet(1, alpha)
        miu[i] <- r1[1]
        eta[i] <- r1[2]
        z[i, 1] <- rbinom(1, y[1], a[1] * miu[i]/(a[1] * miu[i] + b[1]))
        z[i, 2] <- rbinom(1, y[2], a[2] * miu[i]/(a[2] * miu[i] + b[2]))
        z[i, 3] <- rbinom(1, y[3], a[3] * eta[i]/(a[3] * eta[i] + b[3]))
        z[i, 4] <- rbinom(1, y[4], a[4] * eta[i]/(a[4] * eta[i] + b[4]))
    }
    data.frame(miu, eta, z)
}

Simulate the answer

data <- muti_gibbs(10000)
miu1 <- data$miu[2000:10000]
list(summary(miu1), var(miu1))
## [[1]]
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   0.332   0.347   0.350   0.350   0.353   0.366 
## 
## [[2]]
## [1] 2.084e-05
eta1 <- data$eta[2000:10000]
list(summary(eta1), var(eta1))
## [[1]]
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   0.232   0.247   0.250   0.250   0.253   0.267 
## 
## [[2]]
## [1] 2.078e-05