## ================================================================================ ##
## generate a simulated dataset from the negative binomial mixed-effect independent model:
## Y_ij | G_i = g_i ~ NB(r_ij,p_i) where r_ij = exp(X^T beta)/a , p_i =1/(a*g_i+1)
## with G_i ~ Gamma(scale=th,shape=1/th)
set.seed(1)
sn <- 5 ## the number of repeated measures of each patient
n <- 80 ## the number of patients
loga <- - 0.5
a <- exp(loga) ## the parameter for the failure probability of the negative binomial distribution
logtheta <- 1.3
th <- exp(logtheta) ## the parameter for the gamma distribution of g_i
## No difference between the means of groups
## The model only has an intercept term beta0 = 0.5
b0 <- 0.5
u1 <- rep(exp(b0),sn) ## the mean vector for group 1 at time point 1,...,sn
u2 <- rep(exp(b0),sn) ## the mean vector for group 2 at time point 1,...,sn
DT0 <- rNBME.R(gdist="G", n=n, a=a, th=th, u1=u1, u2=u2, sn=sn)
ID <- DT0$id
Vcode <- rep(-1:(sn-2),n) # scan number -1, 0, 1, 2, 3
new <- Vcode > 0
dt1 <- data.frame(CEL=DT0$y)
logitd <- -0.5
## ================================================================================ ##
## [1]: Fit the negative binomial independent model
## where the random effects are from the gamma distribution. This is the true model.
re.gamma.ind <- fitParaIND(formula=CEL~1,data=dt1,ID=ID,RE="G",
p.ini=c(loga,logtheta,b0),IPRT=TRUE)
## compute the estimates of the conditional probabilities
## with sum of the new repeated measure as a summary statistics
Psum <- index.batch(olmeNB=re.gamma.ind, ID=ID,data=dt1,
labelnp=new,qfun="sum", IPRT=TRUE)
## compute the estimates of the conditional probabilities
## with max of the new repeated measure as a summary statistics
Pmax <- index.batch(olmeNB=re.gamma.ind, ID=ID,data=dt1,
labelnp=new,qfun="max", IPRT=TRUE)
## Which patient's estimated probabilities
## based on the sum and max statistics disagrees the most?
( IDBigDif <- which(rank(abs(Pmax$condProbSummary[,1]-Psum$condProbSummary[,1]))==80) )
## Show the patient's CEL counts
dt1$CEL[ID==IDBigDif]
## Show the estimated conditional probabilities based on the sum summary statistics
Psum$condProbSummary[IDBigDif,]
## Show the estimated conditional probabilities based on the max summary statistics
Pmax$condProbSummary[IDBigDif,]
## [2]: Fit the negative binomial independent model
## where the random effects are from the lognormal distribution.
re.logn.ind <- fitParaIND(formula=CEL~1,data=dt1,ID=ID,
RE="N",
p.ini=c(loga,logtheta,b0),
IPRT=TRUE)
Psum <- index.batch(olmeNB=re.logn.ind, ID=ID,data=dt1,C=TRUE,
labelnp=new,qfun="sum", IPRT=TRUE)
## [3]: Fit the semi-parametric negative binomial independent model
re.semi.ind <- fitSemiIND(formula=CEL~1,data=dt1,ID=ID)
Psum <- index.batch(olmeNB=re.semi.ind,ID=ID,data=dt1, i.se = FALSE,
labelnp=new, qfun="sum", IPRT=TRUE)
## [4]: Fit the negative binomial mixed-effect AR(1) model
## where random effects are from the gamma distribution
re.gamma.ar1 <- fitParaAR1(formula=CEL~1,data=dt1,ID=ID,
p.ini=c(loga,logtheta,logitd,b0),
RE="G", Vcode=Vcode,
IPRT=TRUE)
Psum <- index.batch(olmeNB=re.gamma.ar1, ID=ID,data=dt1, labelnp=new,Vcode=Vcode,
qfun="sum", IPRT=TRUE,i.se=FALSE) ## i.se=TRUE requires more time...
## ======================================================================== ##
## == Which model performed the best in terms of the estimation of beta0 == ##
## ======================================================================== ##
getpoints <- function(y,estb0,sdb0=NULL,crit=qnorm(0.975))
{
points(estb0,y,col="blue",pch=16)
if (!is.null(sdb0))
{
points(c(estb0-crit*sdb0,estb0+crit*sdb0),rep(y,2),col="red",type="l")
}
}
ordermethod <- c("gamma.ind","logn.ind","semi.ind","gamma.ar1")
estb0s <- c(
re.gamma.ind$est[3,1],
re.logn.ind$est[3,1],
re.semi.ind$est[3],
re.gamma.ar1$est[4,1]
)
## The true beta0 is:
b0
c <- 1.1
plot(0,0,type="n",xlim=c(min(estb0s)-0.5,max(estb0s)*c),
ylim=c(0,5),yaxt="n",
main="Simulated from the independent model \n with random effect ~ gamma")
legend("topright",
col="red",
legend=ordermethod)
abline(v=b0,lty=3)
## [1] gamma.ind
sdb0 <- re.gamma.ind$est[3,2]
getpoints(4,estb0s[1],sdb0)
## [2] logn.ind
sdb0 <- re.logn.ind$est[3,2]
getpoints(3,estb0s[2],sdb0)
## [3] semi.ind
getpoints(2,estb0s[3])
## [4] gamma.ar1
sdb0 <- re.gamma.ar1$est[4,2]
getpoints(1,estb0s[4],sdb0)
Run the code above in your browser using DataLab