R์ car ํจํค์ง์ Leinhardt ๋ฐ์ดํฐ๋ฅผ ์ด์ฉํ์ฌ ์์์ ํธ ๋ชจ๋ธ(Random intercept model)์ ๋ชจ๋ธ์ ๋ง๋ค์ด๋ณด์. ์ํ๊ณผ์ ์ ๋ค์๊ณผ ๊ฐ๋ค.
1. ๋ฐ์ดํฐ ํ์ธ
2. ๋ชจ๋ธ๋ง
3. ๋ชจ๋ธํ์ธ
1. ๋ฐ์ดํฐ ํ์ธ
In:
library(car)
data('Leinhardt')
pairs(Leinhardt)
head(Leinhardt)
Out:
income infant region oil
Australia 3426 26.7 Asia no
Austria 3350 23.7 Europe no
Belgium 3346 17.0 Europe no
Canada 4751 16.8 Americas no
Denmark 5029 13.5 Europe no
Finland 3312 10.1 Europe no
โท ์ฐ์ํ ๋ณ์๋ income๊ณผ infant, ๋ฒ์ฃผํ ๋ณ์๋ก๋ region๊ณผ oil๋ก ๊ตฌ์ฑ๋์ด ์๋ค.
โท ๊ทธ๋ฆผ์์ ๋ณด๋ค์ํผ infant์ income์ ๋น์ ํ์ ์ธ ์์ ๊ด๊ณ, region๋ณ๋ก infant๊ฐ ๋ฌ๋ผ์ง๋ ๊ฒฝํฅ์ ํ์ธํ ์ ์๋ค. ๋ํ oil์ด yes์ธ ๊ฒฝ์ฐ, infant๊ฐ ๋ฎ์์ง๋ ๊ฒฝํฅ์ ํ์ธํ ์ ์๋ค.
2. ๋ชจ๋ธ๋ง
์์์ ํธ ๋ชจ๋ธ์ ์ ํ๋ ๋ณ์์ ์์ค์ ๋ฐ๋ผ ์ ํธ์ด ๋ฌ๋ผ์ง๋ ๋ชจํ์ด๋ค. ๋น๋์ฃผ์ ๊ด์ ์์์ ์์์ ํธ ๋ชจ๋ธ์ ๋ค์๊ณผ ๊ฐ๋ค.
โท beta 0๋ ์ ํธ์ ์ถ์ ๋, beta 1์ ์ค๋ช ๋ณ์์ ์ถ์ ๋์ด๋ค. ๊ธฐ์กด์ ์ ํํ๊ท ๋ถ์๊ณผ๋ ๋ค๋ฅด๊ฒ ์์ค์ ๋ฐ๋ผ ๋ฌ๋ผ์ง๋ ์ ํธ์ ์ค์ฐจ๊ฐ ์ถ๊ฐ๋๋ค.
โถ ๋ฒ ์ด์ง์ ๊ด์ ์์์ ์์์ ํธ ๋ชจ๋ธ์ ๋ฒ ์ด์ง์ ์ ํํ๊ท ๋ถ์์์ ์ ํธ์ ์ค์ฐจ์ธ u์ ๋ ๋ชจ์์ ์ฌ์ ๋ถํฌ์ ๋ํ ๊ฐ์ ์ ์ถ๊ฐํ์ฌ ๋ชจ๋ธ๋งํ๊ฒ ๋๋ค.
์์ ๋ฐ์ดํฐ๋ฅผ ์ด์ฉํ ๋ชจ๋ธ์์๋ region์ ์์ค์ ๋ฐ๋ผ ์ ํธ์ด ๋ฌ๋ผ์ง๋๋ก ๋ชจ๋ธ๋งํ ๊ฒ์ด๋ค.
In:
library(rjags)
data = na.omit(Leinhardt)
data$log_income = log(data$income)
data$log_infant = log(data$infant)
mod_string = " model {
for (i in 1:length(y)) {
y[i] ~ dnorm(mu[i], prec)
mu[i] = a[region[i]] + b[1]*log_income[i] + b[2]*is_oil[i]
}
for (j in 1:max(region)) {
a[j] ~ dnorm(a0, prec_a)
}
a0 ~ dnorm(0.0, 1.0/1.0e6)
prec_a ~ dgamma(1/2.0, 1*10.0/2.0)
tau = sqrt(1.0/prec_a)
for (j in 1:2) {
b[j] ~ dnorm(0.0, 1.0/1.0e6)
}
prec ~ dgamma(5/2.0, 5*10.0/2.0)
sig = sqrt(1.0/prec)
} "
data_jags = list(y = data$log_infant,
log_income = data$log_income,
is_oil = as.numeric(data$oil == 'yes'),
region = as.numeric(data$region))
params = c('a0', 'a', 'b', 'sig', 'tau')
mod = jags.model(textConnection(mod_string),
data = data_jags,
n.chains = 3)
update(mod, 1e3)
mod_sim = coda.samples(model = mod,
variable.names = params,
n.iter = 5e3)
mod_comb_sim = as.mcmc(do.call(rbind, mod_sim))
Out:
Compiling model graph
Resolving undeclared variables
Allocating nodes
Graph information:
Observed stochastic nodes: 101
Unobserved stochastic nodes: 9
Total graph size: 622
Initializing model
|**************************************************| 100%
|**************************************************| 100%
โท ๋ฐ์ดํฐ ํ์ธ์ผ๋ก๋ถํฐ ์ป์ ์ธ์ฌ์ดํธ๋ฅผ ๋ฐํ์ผ๋ก income๊ณผ infant์ ๋ก๊ทธ๋ฅผ ์ทจํ์ฌ ๋์ ๊ด๊ณ๊ฐ ์ ํ์ด ๋๋๋ก ํ์๋ค.
โท ์ด์ธ์ ์ฝ๋์ ๋ํ ๋ด์ฉ์ ์๋ตํ๋๋ก ํ๊ฒ ๋ค. JAGS์ ์ฌ์ฉ๋ฒ์ ๋ํด ์์๋ณด๊ณ ์ ํ๋ค๋ฉด, ๋ค์์ ํฌ์คํ ์ ์ฐธ๊ณ ํ๊ธธ ๋ฐ๋๋ค.
3. ๋ชจ๋ธ ํ์ธ
Gelman-Rubin diagostic์ ํตํด ๋ง๋ฅด์ฝํ ์ฒด์ธ์ด ์๋ ดํ์๋์ง ํ์ธํ์ฌ ๋ณด์.
In:
gelman.diag(mod_sim)
# plot(mod_sim)
Out:
Potential scale reduction factors:
Point est. Upper C.I.
a[1] 1.04 1.12
a[2] 1.05 1.13
a[3] 1.05 1.13
a[4] 1.05 1.13
a0 1.01 1.03
b[1] 1.05 1.15
b[2] 1.00 1.01
sig 1.00 1.00
tau 1.01 1.02
Multivariate psrf
1.03
โท ๋ชจ๋ ๊ฒฐ๊ณผ๊ฐ 1 ๊ทผ์ฒ๋ก ์๋ ดํ๊ณ ์๋ ๊ฒ์ ํ์ธํ ์ ์๋ค.
๋ชจ๋ธ์ DIC๋ฅผ ๊ตฌํ์ฌ ๋ณด์.
In:
dic.samples(mod, n.iter = 1e3)
Out:
|**************************************************| 100%
Mean deviance: 213.7
penalty 7.035
Penalized deviance: 220.7
โท ๋ชจ๋ธ์ DIC๋ 221.7๋ก ์์ ๋ฐ์ดํฐ๋ฅผ ์ด์ฉํ์ฌ ๋ฒ ์ด์ง์ ์ ํํ๊ท ๋ชจ๋ธ์ ๊ฒฐ๊ณผ(230.1)๋ณด๋ค ๋ ๋ฎ์ ๊ฒ์ผ๋ก ๋ํ๋ฌ๋ค. ๋ฐ๋ผ์ DIC๋ฅผ ๊ณ ๋ คํ์ ์๋, ์์์ ํธ ๋ชจ๋ธ์ด ๋ ๋์ ๊ฒ์ ์ ์ ์๋ค.
โท ์์ ๋ชจ๋ธ์ ์ค์ ๋ชจ์๋ 9๊ฐ์ง๋ง, Effective number of parameters๋ 7.452๊ฐ์ธ ๊ฒ์ผ๋ก ๋ํ๋ฌ๋ค. ์ด๋ ๋ชจ์๋ค๊ฐ ์ ๋ณด๋ฅผ ๊ณต์ ํ๊ณ ์๊ธฐ ๋๋ฌธ์ ์ค์ ๋ชจ์์ ๊ฐฏ์๋ณด๋ค ๋ ์ ๊ฒ ๋ํ๋ ๊ฒ์ผ๋ก ๋ณผ ์ ์๋ค.
์ถ์ ๋ ๋ชจ์์ ๊ฒฐ๊ณผ๋ฅผ ํ์ธํ์ฌ ๋ณด์.
In:
summary(mod_sim)
Out:
Iterations = 1001:6000
Thinning interval = 1
Number of chains = 3
Sample size per chain = 5000
1. Empirical mean and standard deviation for each variable,
plus standard error of the mean:
Mean SD Naive SE Time-series SE
a[1] 6.5393 0.55904 0.0045646 0.0430400
a[2] 5.9943 0.70695 0.0057722 0.0559740
a[3] 5.8331 0.62960 0.0051407 0.0490414
a[4] 5.5144 0.86077 0.0070282 0.0682821
a0 5.9842 1.30529 0.0106576 0.0556278
b[1] -0.3383 0.10649 0.0008694 0.0086461
b[2] 0.6352 0.35149 0.0028699 0.0046075
sig 0.9197 0.06615 0.0005401 0.0006532
tau 2.0316 1.00292 0.0081888 0.0107208
2. Quantiles for each variable:
2.5% 25% 50% 75% 97.5%
a[1] 5.4841 6.1575 6.5237 6.9064 7.6567
a[2] 4.6616 5.5152 5.9707 6.4650 7.4010
a[3] 4.6407 5.3993 5.8127 6.2531 7.1027
a[4] 3.8707 4.9235 5.4843 6.0860 7.2300
a0 3.4451 5.2072 5.9754 6.7482 8.5718
b[1] -0.5529 -0.4096 -0.3348 -0.2664 -0.1363
b[2] -0.0626 0.4034 0.6363 0.8676 1.3372
sig 0.8013 0.8733 0.9152 0.9623 1.0603
tau 0.9855 1.4085 1.7742 2.3407 4.6289
โท ์์ ๋ชจ๋ธ์ ๊ฒฐ๊ณผ๋ก๋ถํฐ ์์ค๋ณ ์ ํธ์ ๋ฐ๋ฅธ ์ค์ ์ ํด์์ ๋ถ๊ฐ๋ฅํ๋ค. ์๋ํ๋ฉด ์ ํธ์ ๋ชจ๋ ์ค๋ช ๋ณ์๊ฐ 0์ธ ์ํ์์์ ๊ฒฐ๊ณผ๋ฅผ ์๋ฏธํ๋๋ฐ, ์์ ๋ฐ์ดํฐ์ ๋ฒ์์์๋ ๊ทธ๋ฐ ๊ฒฝ์ฐ๋ ์กด์ฌํ ์ ์๊ธฐ ๋๋ฌธ์ด๋ค.
โท a0์ tau๋ ์ ํธ์ ๋ํ ํ๊ท ๊ณผ ํ์คํธ์ฐจ๋ก ํด์ํ ์ ์๋ค.
โท ์ด์ธ์ ๊ฒฐ๊ณผ์ ๋ํ ํด์์ ๋ฒ ์ด์ง์ ์ ํํ๊ท ๋ถ์๊ณผ ๊ฐ๋ค.
Reference:
"Bayesian Statistics: From Concept to Data AnalysisTechniques and Models," Coursera, https://www.coursera.org/learn/bayesian-statistics/.
'Statistics > Bayesian Statistics' ์นดํ ๊ณ ๋ฆฌ์ ๋ค๋ฅธ ๊ธ
ํผํฉ ๋ชจ๋ธ(Mixture model) (0) | 2020.09.09 |
---|---|
Bayesian linear model for New York air quality measurements (0) | 2020.09.01 |
๊ณ์ธต์ ๋ชจ๋ธ(Hierarchical model) (0) | 2020.08.22 |
๋ฒ ์ด์ง์ ํฌ์์ก ํ๊ท(Bayesian poisson regression) (0) | 2020.08.21 |
๋ฒ ์ด์ง์ ๋ก์ง์คํฑ ํ๊ท(Bayesian logistic regression) (0) | 2020.08.19 |