### R code from vignette source 'ad13.Rnw' ### Encoding: UTF-8 ################################################### ### code chunk number 1: bootst ################################################### set.seed(111) bsize<-1000 if(bsize<500) print("*** WARNING: SMALL BOOTSTRAP SAMPLE SIZE ***") btest <- function (bs,expression,pos=NULL,debug2=FALSE) { x <- with(as.data.frame(t(bs@fixef)),eval(parse(text=expression))) if (debug2) print(mean(x)) if(is.null(pos)) return(sprintf("%.5f",2*pnorm(abs(mean(x)/sd(x)),lower.tail=FALSE))) if(pos) return(sprintf("%.5f",pnorm(mean(x)/sd(x)),lower.tail=FALSE)) return(sprintf("%.5f",pnorm(-mean(x)/sd(x)),lower.tail=FALSE)) } ################################################### ### code chunk number 2: ad13.Rnw:501-534 ################################################### library(xtable) load(file="ad13.Rdata") subjects2 <- within (subjects2,{ ccmax<-round(cmax*10,1) cmin <- round(cmin/cmax,1) bcost <- bcost/cmax optSec<- optSec*cmax msecond <- msecond*cmax matchr <- ifelse(matchr>1,6,1) totalprofit2<-totalprofit+ifelse(startaccount==300,2200,0) }) woaEq <- function (bcost,cmin=.5,P=1) P/cmin * log((1-cmin)*bcost/(bcost-cmin)) fpaEq <- function (bcost,cmin=.5,P=1) P/(1-cmin) * log(1/bcost) dynTime <- round(with(subset(subjects2,static!=1 & msecond/cmax>5),mean(msecond/cmax,na.rm=TRUE)),2) statTime <- round(with(subset(subjects2,static==1),mean(tmm)),2) ################################################### ### code chunk number 3: treatments ################################################### # list of Treatments: # last <- with(subjects2,aggregate(period,list(sid=sid),max)) colnames(last)[2]<-"period" lastpay <- merge(last,subjects2)$totalprofit2 * .005 # list of sessions: subs <- with(subjects2,aggregate(subjects2[,c("cmin","matchr","static","firstprice")],list(sessionid=sessionid,subject=subject),median)) # # list of treatments / no. subjects: subsa <- with(subs,aggregate(subject,list(cmin=cmin,matchr=matchr,static=static,firstprice=firstprice),length)) # # list of treatments / no of sessions: subss <- with(subs,aggregate(sessionid,list(cmin=cmin,matchr=matchr,static=static,firstprice=firstprice),function(x) length(unique(x)))) colnames(subsa)[5]="participants" colnames(subss)[5]="sessions" tab <- merge(subsa,subss) over <- with(subjects2,aggregate((optSec0) { ctab <- ctab[-delVec2,] if(relimp) ctab["other",type]<-1-sum(ctab[,type],na.rm=TRUE) } } colnames(ctab)[1:2]=c("$\\beta$","$\\sigma$") colnames(ctab)[4:6]=c("$p$ value","95\\% conf","interval") colnames(ctab)[colnames(ctab)=="t value"]<-"$t$" colnames(ctab)[colnames(ctab)=="z value"]<-"$z$" if (length(dim(trans))==2) { rn <- rownames(ctab) rn <- sub("TRUE$","",rn) apply(trans,1,function(x) {rn<<-sub(paste("^",x[1],"$",sep=""),x[2],rn);}) rownames(ctab)<-rn } if (relimp) print(xtable(ctab,digits=c(1,3,3,3,4,3,3,3),display=c("fg","fg","fg","fg","f","fg","fg","f"),align="l||c|c|c|c|cc|c"),floating=FALSE,sanitize.colnames.function = function(x) x,sanitize.rownames.function = function(x) x) else print(xtable(ctab,digits=c(1,3,3,3,4,3,3),display=c("fg","fg","fg","fg","f","fg","fg"),align="l||c|c|c|c|cc|"),floating=FALSE,sanitize.colnames.function = function(x) x,sanitize.rownames.function = function(x) x) cc } #-------------------------------------------------------------------------------- creaInt <- function(var) { tg4[[paste(var,"1",sep="")]]<<-tg4[[var]] * tg4[["period1"]] tg4[[paste(var,"6",sep="")]]<<-tg4[[var]] * tg4[["period6"]] tg4[[paste(var,"25",sep="")]]<<-tg4[[var]] * tg4[["period25"]] tg4[[paste(var,"T",sep="")]]<<-tg4[[var]] * tg4[["treatnum"]] tg4[[paste(var,"N",sep="")]]<<-tg4[[var]] * tg4[["north"]] tg4[[paste(var,"P",sep="")]]<<-tg4[[var]] * tg4[["period"]] } #-------------------------------------------------------------------------------- trans <- rbind(c("\\(Intercept\\)","$1$"), c("tclock","$\\\\betawoa$"), c("tstatic","$\\\\betastatic$"), c("trand","$\\\\betarnd$"), c("tfirst","$\\\\betafirst$")) est <- lmer(over ~ tclock + tstatic + trand + tfirst - 1 + (1|sid) + (1|sessionid) ,subset=!hadi,data=regRevenue) re.boot <- mcmcsamp(est,n=bsize) qq <- mer2la(est,relimp=FALSE,trans=trans) ################################################### ### code chunk number 11: 8a ################################################### oneT <- function(msid) { par(mgp=c(-2,-1,0),mar=c(0,0,0,0)) qq <- subset(bifu,sid==msid) plot(msecond ~ theta,pch=winner*15+1,data=qq,ylab="",xlab="",xaxt="n") with(qq[1,],lines(c(0,thetabest,thetabest,2),c(one1best,one1best+thetabest*theta1best,one2best+thetabest*theta2best,one2best+2*theta2best))) } par(mfrow=c(3,3),mar=c(0,0,0,0)) qq <- sapply(sort(c(47, 33, 69, 74, 111, 119, 147, 151, 153)),oneT) ################################################### ### code chunk number 12: 8b ################################################### par(mfrow=c(3,3),mar=c(0,0,0,0)) qq <- sapply(sort(c(5, 26, 77, 85, 92, 127, 133, 110, 150)),oneT) ################################################### ### code chunk number 13: 9 ################################################### par(mfrow=c(1,1),mar=c(4,4,0,0),mgp=c(3,1,0)) # intreg results for woa: # ols results for static stuff: # with(subset(bifuS,firstprice!=1 & static!=1),plot(ecdf(xdiff),do.points=FALSE,verticals=TRUE,xlim=c(-50,50),xlab=expression(Delta[i]),main="")) with(subset(bifuO,firstprice!=1 & static==1),plot(ecdf(xdiff),do.points=FALSE,verticals=TRUE,add=TRUE,lty=2)) with(subset(bifuO,firstprice==1),plot(ecdf(xdiff),do.points=FALSE,verticals=TRUE,add=TRUE,lty=3)) legend("bottomright",c("dynamic war","static war","all-pay"),lty=1:3)