#Run replicates nrep<-1000 ests.mat.ipw<-matrix(0,nrow=nrep,ncol=8) for(irep in 1:nrep){ #Predictors X<-mvrnorm(n,mu=rep(0,p),Sigma=Sig) #Data simulation Xmat<-cbind(rep(1,n),X) eta.Z<-Xmat %*% (c(1,al.select)*al) p.Z<-expit(eta.Z) Z<-rbinom(n,1,p.Z) eta.Y<-Z*theta+Xmat %*% (c(1,be.select)*be) Y<-eta.Y+rnorm(n)*sig.Y #boxplot(Y~Z) ########################################################## #Single robust #IPW using: all predictors p1<-glm(Z~X,family=binomial) ps.vals<-fitted(p1) #hist(ps.vals,breaks=seq(0,1,by=0.05),xlab=expression(pi(x)),col='gray',main='PS values: Setup 1');box() #dev.print(device = pdf, file='PS-Plot1.pdf',width=11) ests.mat.ipw[irep,1]<-mean(Y*Z/ps.vals)-mean(Y*(1-Z)/(1-ps.vals)) ests.mat.ipw[irep,2]<-sum(Y*Z/ps.vals)/sum(Z/ps.vals)- sum(Y*(1-Z)/(1-ps.vals))/sum((1-Z)/(1-ps.vals)) #IPW using: predictors of treatment only p1<-glm(Z~X[,treatment.list],family=binomial) ps.vals<-fitted(p1) ests.mat.ipw[irep,3]<-mean(Y*Z/ps.vals)-mean(Y*(1-Z)/(1-ps.vals)) ests.mat.ipw[irep,4]<-sum(Y*Z/ps.vals)/sum(Z/ps.vals)- sum(Y*(1-Z)/(1-ps.vals))/sum((1-Z)/(1-ps.vals)) #IPW using: confounders only p1<-glm(Z~X[,confound.list],family=binomial) ps.vals<-fitted(p1) ests.mat.ipw[irep,5]<-mean(Y*Z/ps.vals)-mean(Y*(1-Z)/(1-ps.vals)) ests.mat.ipw[irep,6]<-sum(Y*Z/ps.vals)/sum(Z/ps.vals)- sum(Y*(1-Z)/(1-ps.vals))/sum((1-Z)/(1-ps.vals)) #IPW using: all predictors of outcome p1<-glm(Z~X[,outcome.list],family=binomial) ps.vals<-fitted(p1) ests.mat.ipw[irep,7]<-mean(Y*Z/ps.vals)-mean(Y*(1-Z)/(1-ps.vals)) ests.mat.ipw[irep,8]<-sum(Y*Z/ps.vals)/sum(Z/ps.vals)- sum(Y*(1-Z)/(1-ps.vals))/sum((1-Z)/(1-ps.vals)) } mse.vals<-n*apply((ests.mat.ipw-theta)^2,2,mean) name.list<-c('IPW-All0','IPW-All','IPW-Tmt0','IPW-Tmt','IPW-Conf0','IPW-Conf','IPW-Out0','IPW-Out') boxplot(ests.mat.ipw,names=name.list,ylim=range(-2,6),main='IPW-Estimates') abline(h=theta,col='red') text(1:ncol(ests.mat.ipw),rep(6,ncol(ests.mat.ipw)),format(mse.vals,digits=4)) fname<-paste(filecode,'-PS-IPW.pdf',sep='') dev.print(device = pdf, file=fname,width=11) boxplot(Y~Z,names=c('Untreated','Treated')) mean(Y[Z==1])-mean(Y[Z==0])