본문 바로가기
Statistics/논문 리뷰

Bayesian Analysis of Zero-Inflated regression models

by Kanii 2021. 1. 8.
반응형

세미나 일시 : 2020-09-28

논문 제목 : Bayesian Analysis of Zero-Inflated regression models

논문 저자 : Sujit K.Grosh, Pabak Mukhopadhyay, Jye-Chyi Lu


이 논문은 간단하게 요약하자면, 이전 논문들에서 ZIP, ZIB, ZINB 이런식으로 전개했던 여러개의 모형을 ZIPS (Zero inflated Power Series model)로 다시 한번 전개하고 더 나아가 Bayesian approach를 적용한 논문이라고 할 수 있다.


1. ZIPS model

 우리가 알고 있는 다양한 standard distribution은 어떤 family로 묶일 수 있다.

(아마 이 문장을 읽고 여러분이 가장 먼저 떠올렸을 것은 바로 exponential famliy ㅋㅋ)

이것과 비슷한 맥락으로 우리는 몇몇 분포들을 Power Series distribution으로 정의할 수 있다.

 

* 사실 power series distribution이라는 게 정말 family와 같은 의미인지는 정확히 모르겠지만..나는 비슷한 맥락으로 이해하였다.

(https://www.randomservices.org/random/special/PowerSeries.html <- 이 링크로 들어가면, Power Series distribution에 대한 간단한 설명과 예제를 볼 수 있다.)

 

** ZIP(Zero-Inflated Poisson) 모형에 대한 전개는 이전 게시물을 보시면,,이해에 약간의 도움이 될 수 있을 것입니다

- https://harang3418.tistory.com/2?category=829452

 

Bayesian Approach for ZIP model _ 정리,예제

세미나 일시 : 2020년 07월 16일 논문 제목 : BAYESIAN INFERENCE FOR ZERO-INFLATED POISSON REGRESSION MODELS 저자 : HUI LIU and DANIEL A. POWERS 1. 등장 배경 - 보통 count data에 대한 분석을 시행할 때면..

harang3418.tistory.com

ZIPS model 정의 :

Let $Y=V(1-B)$ 

여기서 $V$는 $V \sim PS(\theta)=\frac{b(v)}{c(\theta)}\theta^{v}~,~c(\theta)=\sum_{v=0}^{\infty}b(v)\theta^{v}$,

$B$ 는 $B \sim Bernoulli(p)$


$\therefore E[Y]=(1-B)E(V)~,~V(Y)=\frac{p}{1-p}[E(Y)]^2+\delta E(Y)$
$+ E(V)=\theta(\frac{d}{d\theta}log(c(\theta)))$

 

(EX) $V\sim Poisson(\theta)$라면, $c(\theta)=e^{\theta}$, $b(v)=\frac{1}{v!}$

 

$V(Y)$는 약간의 유도과정이 필요하니까 쉽게 유도가 가능하다. $\delta=\frac{V(V)}{E(V)}$

이 $\delta$로 Y의 대략적인 분포를 알 수 있다.

$\rightarrow$ when $\delta \geq 0$ :Distribution of  Y is overdispersed.
$\rightarrow$ when $\delta \le 0$ :Distribution of Y is underdispersed if and only if $E(V)\le \frac{1-\delta}{p}$

 

이 Power series distribution을 이용하여 Likelihood function을 유도하자.

$P(Y=0)=p+(1-p)\frac{b(0)}{c(\theta)}$

$P(Y=k)=(1-p)\frac{b(k)\theta^k}{c(\theta)},~~k=1,2,\cdots$

->

$\begin{split}
L(p,\theta|\boldsymbol{Y})=&\prod_{i=1}^{n}[p+(1-p)\frac{b(0)}{c(\theta)}]^{I(y_i=0)}[(1-p)\frac{b(y_i)\theta^{y_i}}{c(\theta)}]^{I(y_i>0)}\\
\propto&[pc(\theta)+(1-p)b(0)]^{S_0}(1-p)^{n-S_0}\theta^{S}(c(\theta))^{-n}\\
\propto&\left[\sum_{j=0}^{S_0}\omega_{j}p^j(1-p)^{n-j}\right]\theta^S
\end{split}$

where $S_0=\sum I(y_i=0)~~,~S=\sum y_i~~,~\omega_j=\binom{S_0}{j}\left(\frac{b(0)}{c(\theta)}\right)^{n-j}$

 

- ZIPS model with covariates : Link function을 사용.

Let $\mu$ : mean vector of $V$

$Y_i ~ ind \sim ZIPS(p_i,\theta_i)$ 여기서 $p_i$와 $\theta_i$는 각각 $B_i$와 $V_i$의 distribution parameter

$\Rightarrow log(\boldsymbol{\mu})=\boldsymbol{Z\beta}~,~logit(\boldsymbol{p})=W\gamma$

여기서 $Z~,~W$ 는 각각 function에 대응되는 Covariate matrix이다.

 

기본적인 모형의 형태는 이와 같다.

 

만약, Covariate이 없는 ZIPS모형일 경우 Gibbs sampling을 쉽게 활용할 수 있지만, Covariate이 있는 모형의 경우엔 data augmentation을 사용하여 약간의 더 전개가 필요하다.

 


2. Bayesian Analysis 

- Bayesian Approach를 적용하기 전에 앞서 언급했던 data augmentation과정을 진행한다.

우리는 이미 우리의 observed data $Y$를 2개의 latent variables을 사용하여 분해하였다. $Y=(1-B)V$

따라서, 우리는 Gibbs sampling을 Model with covariates에도 적용하기위해 $V,B$의 Conditional density function을 구한다.

▷ Find $P(\boldsymbol{B},\boldsymbol{V}|\boldsymbol{Y},\theta,p)$

 

이 과정은 수식적으로 이해하려고 하는 것 보단, 의미를 이해하는 것이 더 쉽다.

생각해보자, $Y=(1-B)V$일때, $P(V,B=0|Y)$의 확률은 어떻게 될까?

⊙$V=Y=0$, -> $\frac{(1-p)p(V=0)}{p+(1-p)p(V=0)}$

⊙$V=Y>0$, -> $\frac{(1-p)p(V=v)}{(1-p)p(V=v)}=1$

⊙$V>0~,~Y=0~,~Y\neq V$ -> 0

⊙$V=0~,~Y>0$ -> 0

 

또 $P(V,B=1|Y)$는 어떻게 될까? $B=1$이면, 반드시 $Y=0$ 이어야 한다.

⊙ $Y=0$ -> $\frac{pP(V=v)}{p+(1-p)P(V=v)}$

 

이 과정을 다시 정리해 보자면,

For $i=1,\cdots,n$ ,

If $Y_i=0$ - > {$B_i=0\&V=0~,~B_i=1\&V_i\geq0$}

If $Y_i\geq0$ - >{$B_i=0\&V_i>0$} 

인 것을 알수 있다. 각각의 확률은 위에서 구해 놓았으니, 해당 확률을 사용하여 $L(p,\theta,\boldsymbol{B},\boldsymbol{V}|\boldsymbol{Y})$ 를 다시 유도하면,

 

$\begin{split}
L(p,\theta,\boldsymbol{B},\boldsymbol{V}|\boldsymbol{Y})=&\prod_{i=1}^{n}\left(p\frac{\theta^{V_i}b(k)}{c(\theta)}\right)^{B_i}\left((1-p)\frac{\theta^{V_i}b(k)}{c(\theta)}\right)^{1-B_i}\\
=&p^{\sum B_i}(1-p)^{\sum(1-B_i)}\theta^{\sum V_i}[b(k)]^nc(\theta)^{-n}
\end{split}$

 

이와 같이 정리된다.

 

여기까지가 data augmentation 과정이구, covariate이 없는 경우에 대해 간단한 예를 들어보면 

(ex) $V\sim PS(\theta)=Poisson(\theta)$,  $P(p)=beta(b_1,b_2)~,~P(\theta)=gamma(a_1,a_2)$


$\begin{split}
P(p,\theta|\boldsymbol{B},\boldsymbol{V})=&L(p,\theta|\boldsymbol{B},\boldsymbol{V})P(p)P(\theta)\\
=&p^{\sum B_i +b_1-1}(1-p)^{\sum(1-B_i)+b_2-1}\theta^{\sum V_i+a_1-1}e^{-(n+a_2)\theta}
\end{split}$

 

$\therefore P(p|-)=beta(\sum B_i +b_1,\sum(1-B_i)+b_2)$\\~~~$P(\theta|-)=Gamma(\sum V_i+a_1,n+a_2)$

이렇게 해서 Gibbs sampling을 진행할 수 있게된다.

 

(그런데 여기서 의문..은 분명히 이 논문에선 with covariate의 경우에도 Gibbs sampling을 할 수 있도록 data augmentation을 쓴다고 했는데, with covariate 부분에서 ARS(Adaptive rejection sampling)를 사용했다.

 

이 부분은 아직도 해결하지 못한 미스테리다.)

 

다시 with covariate 으로 돌아와서..

 

$log(\boldsymbol{\mu})=\boldsymbol{Z\beta}~,~logit(\boldsymbol{p})=W\gamma$

Set prior distribution of $\beta,\gamma$:
$P(\beta)=N_q(\beta_0,\sigma^{2}_{\beta}I_q)~,~P(\gamma)=N_r(\gamma_0,\sigma^{2}_{\gamma}I_r)$

 

이렇게 설정한 후에 아래와 같이 sampling을 진행한다.

ARS 과정

 

 

*** ARS는 간단하게 얘기하자면, target density을 여러 구간으로 나눠서 그 구간에 대한 기울기들을 이어서 proposal density를 만드는..그런 방법이다. 나중에 더 공부해서 포스팅 해보도록 하겠다.

 


3. Simulation Study

이 논문엔 simulation study와 실제 데이터를 사용한 예제가 실려있는데, 실제 데이터를 구해보진 못해서 그냥 simulation study 만 간단히 리뷰하고 글을 마무리 하려고한다.

 

Simulation study는 without covariates에 대해서 이루어 졌다.

 

PS($\theta$) 분포로, $Poisson(\theta)$와 $NB(r,\theta)$를 사용한다. $\#~ of~ success~ :~ r$ 도 R.V

Gibbs sampling을 시행 하였고, Chain의 수렴을 판단하기위해 parameters, P(Y=0),$\mu$,Deviance 를 모니터링하였다.

 

Number of chain : 3
Number of iteration : 10000
Burn-in period : 5000
After burn-in period, every $5^{th}$ sample was kept
$\Rightarrow$ total number of samples : 3000 

 

Simulation : 

(1)  Y$\sim poisson(\theta)$ 
     Prior : $p(\theta)=Gamma(a1,a2)$ 
     Post : $P(\theta|\boldsymbol{Y})\propto Gamma(\sum_{i=1}^{n}y_i+a1,n+a_2)$}

(2)  Y$\sim NB(r,\theta)$
     Prior : $p(\theta|r)=Beta(a_1,a_2r+1)~,~p(r)=\frac{1}{15}$
     Post : $p(\theta,r|\boldsymbol{Y})\propto p(\boldsymbol{Y}|\theta,r)p(\theta|r)p(r)$
     Conditional : $p(\theta|-)\propto Beta(\sum_{i=1}^{n}y_i+a_1,(n+a_2)r+1)$
                      $p(r|-)=\left[\prod_{i=1}^{n}{y_i+r-1 \choose y_i}\right](1-\theta)^{(n+a_2)r}$

 

(3)  Y$\sim ZIP(p,\theta)$
      Prior : $p(\theta)=Gamma(a1,a2)$, $p(p)=Beta(b1,b2)$
      Conditional : $p(\theta|-)\propto Gamma(\sum_{i=1}^{n}V_i+a_2,n+a_2)$
                       $p(p|-)\propto Beta(\sum_{i=1}^{n}B_i+b_1,\sum_{i=1}^{n}(1-B_i)+b_2)$}

(4)  Y$\sim ZINB(r,p,\theta)$
     Prior : $p(\theta)=Beta(a_1,a_2r+1)~,~p(p)=Beta(b1,b2)~,~p(r)=\frac{1}{15}$
     Conditional : $p(\theta|-)\propto Beta(\sum_{i=1}^{n}V_i+a_1,(n+a_2)r+1)$
                      $p(p|-)\propto Beta(\sum_{i=1}^{n}B_i+b_1,\sum_{i=1}^{n}(1-B_i)+b_2)$
                      $p(r|-)\propto\left[\prod_{i=1}^{n}{y_i+r-1 \choose y_i}\right](1-\theta)^{(n+a_2)r}$

 

전체 Sampling 과정 :

$\cdot$ Set initial value : $p^{(1)}~,~\theta^{(1)}~,~r^{(1)}$
$\cdot$ For( j in 1:(N-1)):
        for(i in 1:n): 
        Sampling $B_i~,~V_i$:
            IF $Y_i=0$ : Sampling $B_i$ from Bernoulii($p^{(j)}$)
                if $B_i=1$ : Sampling $V_i$ from $PS(\theta^{(j)})$
                if $B_i=1$ : $V_i=0$


        Independent sampling for $r^{(j+1)}$,$r^{*}\sim DiscreteUnif(1,15)$ 
        Gibbs Sampling for $\theta^{(j+1)}$ from $P(\theta|-)$
        Gibbs sampling for $p^{(j+1)}$ from $P(p|-)$

 

시뮬레이션 결과 :

Simulation (1),(2)에 대한 논문 결과+내가 돌린 R 결과
Simulation (3),(4) 에 대한 논문 결과와 내가 돌린 R 결과

결과를 보면 $Y\sim  Poisson$ 인 simulation (1),(3)에 대해서는 내가 돌린 결과가 논문 결과와 유사하게 나왔는데, (2)와 (4)에 대해서는 결과가 좀 다르게 나오는걸 알 수 있다.

아마 무언가 잘못되었다면 $r$이 잘못 sampling이 된 것이 아닐까 싶은데,,,논문 결과가 잘못된게 아닌가 싶기도 하고...

(음모 ㅎㅅㅎ)

**** 글 후반부에 R-code를 첨부해 놓았으니 혹시라도 누군가 오류를 발견한다면 알려주세요!

 


4. Conclusions

 

이 논문은 선행 연구 되었던 ZIP,ZINB 모형을 Power Series 를 사용한 모형으로 확장하였고, Bayesian analysis를 사용하여 small sample에 대해서도 효율적으로 작동하는 것을 보였다.

Zero-Inflated model은 count data with many zero 에 대해서 굉장히 useful한 방법이므로 다양한 분야에서 더 많이 연구 될 수 있을 것이다.

 


R-CODE

library(mcmc)
library(MASS)
library(coda)
library(extraDistr)
library(MCMCpack)
rm(list=ls())
#4.1 no covariate study
#################################################
# use poisson(theta),NB for distribution of V
# prior of p : beta(0.5,0.5)
# prior of theta : gamma(0.001,0.001)
# prior of r : discrete uniform[1,15]

Y=c(rep(0,42),rep(1,8),rep(2,2),rep(3,2))
length(Y) #54
sum(Y==0)/length(Y) #= 0.78

num.iter=10000
burn.in=5000
a1=a2=0.001;b1=b2=0.5
n=length(Y)
index=seq(5,burn.in,5)+5000

set.seed(3418)
#################################################
# Y~poisson
sample.1=rgamma(num.iter,shape=sum(Y)+a1,rate=n+a2)
sample.1=sample.1[index]

sample.2=rgamma(num.iter,shape=sum(Y)+a1,rate=n+a2)
sample.2=sample.2[index]

sample.3=rgamma(num.iter,shape=sum(Y)+a1,rate=n+a2)
sample.3=sample.3[index]

sample.case1=c(sample.1,sample.2,sample.3)
df.pois=data.frame("X1"=character(),"X1"=numeric(),"X1"=numeric(),"X1"=numeric(),"X1"=numeric(),"X1"=numeric())
#summaries for theta
df.pois[1,]=cbind("theta",round(mean(sample.case1),3), 
  round(sd(sample.case1),3), 
  round(quantile(sample.case1,0.025),3), 
  round(quantile(sample.case1,0.5),3), 
  round(quantile(sample.case1,0.975),3)) 
#summaries for P(Y=0)
prob.z=ppois(0,sample.case1)
df.pois[2,]=cbind("P(Y=0)",round(mean(prob.z),3), 
                  round(sd(prob.z),3), 
                  round(quantile(prob.z,0.025),3), 
                  round(quantile(prob.z,0.5),3), 
                  round(quantile(prob.z,0.975),3)) 
#summaries for deviance
dev.pois=-2*log(exp(-n*sample.case1)*sample.case1^{sum(Y)}/prod(factorial(Y)))
df.pois[3,]=cbind("Deviance",round(mean(dev.pois),3), 
                  round(sd(dev.pois),3), 
                  round(quantile(dev.pois,0.025),3), 
                  round(quantile(dev.pois,0.5),3), 
                  round(quantile(dev.pois,0.975),3)) 
colnames(df.pois)=c("","Mean","SD","2.5%","Median","97.5%")
df.pois

#################################################

#################################################
#2.Y~NB(r,theta)
#starting point r = 1,2,3
d.r=function(candi,t){
  den=prod(choose(Y+candi-1,Y))*(1-t)^{(n+a2)*candi}
  return(den)
}

set.seed(0828)
#sample.1 with starting point r=1
r.1=rep(1,num.iter)
theta.1=rep(0,num.iter)

for ( i in 1:num.iter){
  if(i==1){
    theta.1[1]=rbeta(1,sum(Y)+a1,(n+a2)*r.1[i]+1)
  }
  else{
    # Do independet sampling for r
    candi.r=rdunif(1,1,15)
    u=runif(1)
    a=min((d.r(candi.r,theta.1[i-1])/ddunif(candi.r,1,15))/(d.r(r.1[i-1],theta.1[i-1])/ddunif(r.1[i-1],1,15)),1)
    if(u<=a){r.1[i]=candi.r}
    else{r.1[i]=r.1[i-1]}
    
    # Gibbs sampling for theta
    theta.1[i]=rbeta(1,sum(Y)+a1,(n+a2)*r.1[i]+1)
  }
}


#sample.2 with starting point r=2
r.2=rep(2,num.iter)
theta.2=rep(0,num.iter)

for ( i in 1:num.iter){
  if(i==1){
    theta.2[1]=rbeta(1,sum(Y)+a1,(n+a2)*r.2[i]+1)
  }
  else{
    # Do independet sampling for r
    candi.r=rdunif(1,1,15)
    u=runif(1)
    a=min((d.r(candi.r,theta.2[i-1])/ddunif(candi.r,1,15))/(d.r(r.2[i-1],theta.2[i-1])/ddunif(r.2[i-1],1,15)),1)
    if(u<=a){r.2[i]=candi.r}
    else{r.2[i]=r.2[i-1]}
    
    # Gibbs sampling for theta
    theta.2[i]=rbeta(1,sum(Y)+a1,(n+a2)*r.2[i]+1)
  }
}


#sample.3 with starting point r=3
r.3=rep(3,num.iter)
theta.3=rep(0,num.iter)

for ( i in 1:num.iter){
  if(i==1){
    theta.3[1]=rbeta(1,sum(Y)+a1,(n+a2)*r.3[i]+1)
  }
  else{
    # Do independet sampling for r
    candi.r=rdunif(1,1,15)
    u=runif(1)
    a=min((d.r(candi.r,theta.3[i-1])/ddunif(candi.r,1,15))/(d.r(r.3[i-1],theta.3[i-1])/ddunif(r.3[i-1],1,15)),1)
    if(u<=a){r.3[i]=candi.r}
    else{r.3[i]=r.3[i-1]}
    
    # Gibbs sampling for theta
    theta.3[i]=rbeta(1,sum(Y)+a1,(n+a2)*r.3[i]+1)
  }
}


r=c(r.1[index],r.2[index],r.3[index])
theta=c(theta.1[index],theta.2[index],theta.3[index])

df.NB=data.frame("X1"=character(),"X1"=numeric(),"X1"=numeric(),"X1"=numeric(),"X1"=numeric(),"X1"=numeric())
#summaries for 1-theta
df.NB[1,]=cbind("1-theta",round(mean(1-theta),3), 
                round(sd(1-theta),3), 
                round(quantile(1-theta,0.025),3), 
                round(quantile(1-theta,0.5),3), 
                round(quantile(1-theta,0.975),3)) 

#summaries for r
df.NB[2,]=cbind("r",round(mean(r),3), 
                round(sd(r),3), 
                round(quantile(r,0.025),3), 
                round(quantile(r,0.5),3), 
                round(quantile(r,0.975),3)) 
#summaries for mu
mu=r*theta/(1-theta)
df.NB[3,]=cbind("mu",round(mean(mu),3), 
                round(sd(mu),3), 
                round(quantile(mu,0.025),3), 
                round(quantile(mu,0.5),3), 
                round(quantile(mu,0.975),3)) 

#summaries for P(Y=0)
prob.z=pnbinom(0,r,1-theta)
df.NB[4,]=cbind("P(Y=0)",round(mean(prob.z),3), 
                round(sd(prob.z),3), 
                round(quantile(prob.z,0.025),3), 
                round(quantile(prob.z,0.5),3), 
                round(quantile(prob.z,0.975),3)) 
#summaries for deviance

dev.nb=-2*(sum(Y)*log(theta)+n*r*log(1-theta)+sum(as.numeric(Y==0))*log(choose(r-1,0))+
             sum(as.numeric(Y==1))*log(choose(r,1))+sum(as.numeric(Y==2))*log(choose(r+1,2))+
             sum(as.numeric(Y==3))*log(choose(r+2,3)))
df.NB[5,]=cbind("Deviance",round(mean(dev.nb),3), 
                round(sd(dev.nb),3), 
                round(quantile(dev.nb,0.025),3), 
                round(quantile(dev.nb,0.5),3), 
                round(quantile(dev.nb,0.975),3)) 
colnames(df.NB)=c("","Mean","SD","2.5%","Median","97.5%")
df.NB

#################################################
#3.Y~ZIP(p,theta)
###################
set.seed(0828)

# starting p=0.3/ theta = 1
p.1=rep(0.3,num.iter)
theta.1=rep(1,num.iter)

for( i in 1:(num.iter-1)){
  B=c();V=c()
  # Sampling B,V
  for(j in 1:n){
    if(Y[j]==0){
      B[j]=rbern(1,p.1[i])
      if(B[j]==1){V[j]=rpois(1,theta.1[i])}
      else{V[j]=0}
    }
    else{
      B[j]<-0
      V[j]<-Y[j]
    }
  }
  #Gibbs sampling p,theta
  p.1[i+1]=rbeta(1,sum(B)+b1,sum(1-B)+b2)
  theta.1[i+1]=rgamma(1,shape = sum(V)+a1,rate = n+a2)
}


# starting p=0.5 / theta = 2
p.2=rep(0.5,num.iter)
theta.2=rep(2,num.iter)

for( i in 1:(num.iter-1)){
  B=c();V=c()
  # Sampling B,V
  for(j in 1:n){
    if(Y[j]==0){
      B[j]=rbern(1,p.2[i])
      if(B[j]==1){V[j]=rpois(1,theta.2[i])}
      else{V[j]=0}
    }
    else{
      B[j]<-0
      V[j]<-Y[j]
    }
  }
  #Gibbs sampling p,theta
  p.2[i+1]=rbeta(1,sum(B)+b1,sum(1-B)+b2)
  theta.2[i+1]=rgamma(1,shape = sum(V)+a1,rate = n+a2)
}


# starting p=0.7 / theta = 3
p.3=rep(0.7,num.iter)
theta.3=rep(3,num.iter)

for( i in 1:(num.iter-1)){
  B=c();V=c()
  # Sampling B,V
  for(j in 1:n){
    if(Y[j]==0){
      B[j]<-rbern(1,p.3[i])
      if(B[j]==1){V[j]<-rpois(1,theta.3[i])}
      else{V[j]<-0}
    }
    else{
      B[j]<-0
      V[j]<-Y[j]
    }
  }
  #Gibbs sampling p,theta
  p.3[i+1]=rbeta(1,sum(B)+b1,sum(1-B)+b2)
  theta.3[i+1]=rgamma(1,shape = sum(V)+a1,rate = n+a2)
}

p=c(p.1[index],p.2[index],p.3[index])
theta=c(theta.1[index],theta.2[index],theta.3[index])

df.zip=data.frame("X1"=character(),"X1"=numeric(),"X1"=numeric(),"X1"=numeric(),"X1"=numeric(),"X1"=numeric())
#summaries for theta
df.zip[1,]=cbind("theta",round(mean(theta),3), 
                round(sd(theta),3), 
                round(quantile(theta,0.025),3), 
                round(quantile(theta,0.5),3), 
                round(quantile(theta,0.975),3)) 

#summaries for p
df.zip[2,]=cbind("p",round(mean(p),3), 
                round(sd(p),3), 
                round(quantile(p,0.025),3), 
                round(quantile(p,0.5),3), 
                round(quantile(p,0.975),3)) 
#summaries for mu
mu=(1-p)*theta
df.zip[3,]=cbind("mu",round(mean(mu),3), 
                round(sd(mu),3), 
                round(quantile(mu,0.025),3), 
                round(quantile(mu,0.5),3), 
                round(quantile(mu,0.975),3)) 

#summaries for P(Y=0)
prob.z=p+(1-p)/exp(theta)
df.zip[4,]=cbind("P(Y=0)",round(mean(prob.z),3), 
                round(sd(prob.z),3), 
                round(quantile(prob.z,0.025),3), 
                round(quantile(prob.z,0.5),3), 
                round(quantile(prob.z,0.975),3)) 

#summaries for deviance
dev.zip=-2*log((p*exp(theta)+(1-p))^{sum(as.numeric(Y==0))}*(1-p)^{sum(as.numeric(Y>0))}*theta^{sum(Y)}*exp(-n*theta))
df.zip[5,]=cbind("Deviance",round(mean(dev.zip),3), 
                round(sd(dev.zip),3), 
                round(quantile(dev.zip,0.025),3), 
                round(quantile(dev.zip,0.5),3), 
                round(quantile(dev.zip,0.975),3)) 
colnames(df.zip)=c("","Mean","SD","2.5%","Median","97.5%")
df.zip 

#################################################
#4.Y~ZINB(p,theta)

#starting point r = 1,2,3
d.r=function(candi,t){
  den=prod(choose(Y+candi-1,Y))*(1-t)^{(n+a2)*candi}
  return(den)
}

set.seed(0828)
#sample.1 with starting point r=1 , theta=p=0.3
r.1=rep(1,num.iter)
theta.1=rep(0.2,num.iter)
p.1=rep(0.2,num.iter)

for ( i in 1:(num.iter-1)){
  B=c();V=c()
  # Sampling B,V
  for(j in 1:n){
    if(Y[j]==0){
      B[j]=rbinom(1,1,p.1[i])
      if(B[j]==1){V[j]=rnbinom(1,r.1[i],theta.1[i])}
      else if(B[j]==0){V[j]=0}
    }
    else{
      B[j]=0;V[j]=Y[j]
    }
  }
    # Do independet sampling for r
    candi.r=rdunif(1,1,15)
    u=runif(1)
    a=min((d.r(candi.r,theta.1[i])/ddunif(candi.r,1,15))/(d.r(r.1[i],theta.1[i])/ddunif(r.1[i],1,15)),1)
    if(u<=a){r.1[i+1]=candi.r}
    else{r.1[i+1]=r.1[i]}
    
    # Gibbs sampling for theta
    theta.1[i+1]=rbeta(1,sum(V)+a1,(n+a2)*r.1[i+1]+1)
    p.1[i+1]=rbeta(1,sum(B)+b1,sum(1-B)+b2)
  
}

#sample.1 with starting point r=2 , theta=p=0.5
r.2=rep(2,num.iter)
theta.2=rep(0.5,num.iter)
p.2=rep(0.5,num.iter)

for ( i in 1:(num.iter-1)){
  B=c();V=c()
  # Sampling B,V
  for(j in 1:n){
    if(Y[j]==0){
      B[j]=rbern(1,p.2[i])
      if(B[j]==1){V[j]=rnbinom(1,r.2[i],theta.2[i])}
      else if(B[j]==0){V[j]=0}
    }
    else{
      B[j]=0;V[j]=Y[j]
    }
  }
  # Do independet sampling for r
  candi.r=rdunif(1,1,15)
  u=runif(1)
  a=min((d.r(candi.r,theta.2[i])/ddunif(candi.r,1,15))/(d.r(r.2[i],theta.2[i])/ddunif(r.2[i],1,15)),1)
  if(u<=a){r.2[i+1]=candi.r}
  else{r.2[i+1]=r.2[i]}
  
  # Gibbs sampling for theta
  theta.2[i+1]=rbeta(1,sum(V)+a1,(n+a2)*r.2[i+1]+1)
  p.2[i+1]=rbeta(1,sum(B)+b1,sum(1-B)+b2)
  
}

#sample.1 with starting point r=3 , theta=p=0.7
r.3=rep(3,num.iter)
theta.3=rep(0.7,num.iter)
p.3=rep(0.7,num.iter)

for ( i in 1:(num.iter-1)){
  B=c();V=c()
  # Sampling B,V
  for(j in 1:n){
    if(Y[j]==0){
      B[j]=rbern(1,p.3[i])
      if(B[j]==1){V[j]=rnbinom(1,r.3[i],theta.3[i])}
      else if(B[j]==0){V[j]=0}
    }
    else{
      B[j]=0;V[j]=Y[j]
    }
  }
  # Do independet sampling for r
  candi.r=rdunif(1,1,15)
  u=runif(1)
  a=min((d.r(candi.r,theta.3[i])/ddunif(candi.r,1,15))/(d.r(r.3[i],theta.3[i])/ddunif(r.3[i],1,15)),1)
  if(u<=a){r.3[i+1]=candi.r}
  else{r.3[i+1]=r.3[i]}
  
  # Gibbs sampling for theta
  theta.3[i+1]=rbeta(1,sum(V)+a1,(n+a2)*r.3[i+1]+1)
  p.3[i+1]=rbeta(1,sum(B)+b1,sum(1-B)+b2)
  
}

r=c(r.1[index],r.2[index],r.3[index])
theta=c(theta.1[index],theta.2[index],theta.3[index])
p=c(p.1[index],p.2[index],p.3[index])

df.zinb=data.frame("X1"=character(),"X1"=numeric(),"X1"=numeric(),"X1"=numeric(),"X1"=numeric(),"X1"=numeric())
#summaries for 1-theta
df.zinb[1,]=cbind("1-theta",round(mean(1-theta),3), 
                round(sd(1-theta),3), 
                round(quantile(1-theta,0.025),3), 
                round(quantile(1-theta,0.5),3), 
                round(quantile(1-theta,0.975),3)) 

#summaries for r
df.zinb[2,]=cbind("r",round(mean(r),3), 
                round(sd(r),3), 
                round(quantile(r,0.025),3), 
                round(quantile(r,0.5),3), 
                round(quantile(r,0.975),3)) 
#summaries for p
df.zinb[3,]=cbind("p",round(mean(p),3), 
                  round(sd(p),3), 
                  round(quantile(p,0.025),3), 
                  round(quantile(p,0.5),3), 
                  round(quantile(p,0.975),3)) 

#summaries for mu
mu=r*theta*(1-p)/(1-theta)
df.zinb[4,]=cbind("mu",round(mean(mu),3), 
                round(sd(mu),3), 
                round(quantile(mu,0.025),3), 
                round(quantile(mu,0.5),3), 
                round(quantile(mu,0.975),3)) 

#summaries for P(Y=0)
prob.z=(p+(1-p)*(1-theta)^{r})
df.zinb[5,]=cbind("P(Y=0)",round(mean(prob.z),3), 
                round(sd(prob.z),3), 
                round(quantile(prob.z,0.025),3), 
                round(quantile(prob.z,0.5),3), 
                round(quantile(prob.z,0.975),3)) 
#summaries for deviance

dev.zinb=-2*log((p*(1-theta)^{-r}+(1-p))^{sum(as.numeric(Y==0))}*(1-p)^{sum(as.numeric(Y==1))}*theta^{sum(Y)}*(1-theta)^{n*r})
df.zinb[6,]=cbind("Deviance",round(mean(dev.zinb),3), 
                round(sd(dev.zinb),3), 
                round(quantile(dev.zinb,0.025),3), 
                round(quantile(dev.zinb,0.5),3), 
                round(quantile(dev.zinb,0.975),3)) 
colnames(df.zinb)=c("","Mean","SD","2.5%","Median","97.5%")
df.zinb
반응형

댓글