####################################################################
# SUPPLEMENTARY WEB APPENDIX material:
#   "Multivariate meta-analysis for non-linear and other 
#     multi-parameter associations"
#   Gasparrini, Armstrong and Kenward
#   Statistics in Medicine 2012
####################################################################

####################################################################
# RUN THE TWO-STAGE ANALYSIS FOR RELATIVE SCALE
#   TOTAL COMPUTING TIME IS ~15SEC (IN A 2.66GHz-4GBRAM PC UNDER WINDOWS)
####################################################################

# BUILT OBJECTS WHERE RESULTS WILL BE STORED:
#   ymat IS THE MATRIX FOR THE OUTCOME PARAMETERS
#   Slist IS THE LIST WITH (CO)VARIANCE MATRICES
ymatrel <- matrix(NA,m,df,dimnames=list(subcities,paste("spl",seq(df),sep="")))
Slistrel <- vector("list",m)
names(Slistrel) <- subcities

####################################################################
# RUN THE FIRST-STAGE ANALYSIS 
####################################################################

system.time(
for(i in seq(m)) {

  # LOAD
  data <- subdata[[i]]
  
  # DEFINE THE KNOTS AT STUDY-SPECIFIC PERCENTILES
  tempknots <- quantile(data$tmean05,perc/100,na.rm=TRUE)
  cenrel <- quantile(data$tmean05,0.75,na.rm=TRUE)

  # CREATE THE CENTERED QUADRATIC SPLINE: KNOTS AND CENTERING STUDY-SPECIFIC
  bperc <- onebasis(data$tmean05,type=type,degree=degree,
    knots=tempknots,cen=cenrel)

  # RUN THE MODEL
  model <- glm(death ~ bperc + dow + ns(time,7*14),family=quasipoisson(),data)
	
  # EXTRACT AND SAVE THE RELATED COEF AND VCOV
  # WARNING FOR PREDICTION BEYOND BOUNDARIES SUPPRESSED
  suppressWarnings(
    predperc <- crosspred(bperc,model)
  )
  ymatrel[i,] <- predperc$coef
  Slistrel[[i]] <- predperc$vcov
})

####################################################################
# MULTIVARIATE META-ANALYSIS AND PREDICTION
####################################################################

# MULTIVARIATE META-ANALYSIS
(mvrel <- mvmeta(ymatrel,Slistrel,method="ml"))
# MULTIVARIATE META-REGRESSION MODELS
(mvrellat <- mvmeta(ymatrel~lat,Slistrel,submod,method="ml"))

# BASIS USED TO PREDICT TEMPERATURE, EQUAL TO THAT USED FOR ESTIMATION
#   NOTE: INTERNAL AND BOUNDARY KNOTS PLACED AT SAME VALUES AS IN ESTIMATION
#   NOTE: SPLINE CENTERED ON THE SAME VALUE AS IN ESTIMATION 
tperc <- seq(bound[1],bound[2],length=30)
perctmean <- rowMeans(sapply(subdata,function(x) {
  quantile(x$tmean05,c(0:10/10,1:99,990:1000/10)/100,na.rm=T)
}))
bperc <- onebasis(tperc,type=type,degree=degree,knots=knots,
  bound=bound,cen=perctmean["75.0%"])

# PREDICTION FROM SIMPLE META-ANALYSES WITH NO PREDICTORS
cprel <- crosspred(bperc,coef=coef(mvrel),vcov=vcov(mvrel),
  at=c(perctmean,knots),model.link="log")

# COMPUTE PREDICTION FOR MULTIVARIATE META-REGRESSION MODELS
#   1ST STEP: PREDICT THE OUTCOME PARAMETERS FOR SPECIFIC VALUES OF PREDICTOR
#   2ND STEP: PREDICT THE RELATIONSHIP AT CHOSEN VALUES GIVEN THE PARAMETERS
predrellat <- predict(mvrellat,data.frame(lat=percmod[,"lat"]),vcov=T)
cprellat75 <- crosspred(bperc,coef=predrellat[[1]]$fit,
  vcov=predrellat[[1]]$vcov,model.link="log",by=0.5)
cprellat25 <- crosspred(bperc,coef=predrellat[[2]]$fit,
  vcov=predrellat[[2]]$vcov,model.link="log",by=0.5)

####################################################################
# GENERATE SECOND PART OF TABLE 2 IN THE MANUSCRIPT
####################################################################

tab2[6,] <- ftab(mvrel)
tab2[7,] <- ftab(mvrellat,mvrel)

tab2
xtable(tab2,digits=c(0,1,0,3,1,1,1,1,0,3,1,0,3),align="lccccccrccrcc")

####################################################################
# PLOT
####################################################################

# VALUES LABEL FOR TEMPERATURE
labperc <- paste(c(0,1,5,25,50,75,100),sep="")

pdf("relscale.pdf",width=11.2,height=3.8)
# SET par OPTIONS AND MULTIPANEL
par(mar=c(5,4,1,1)+0.1,cex.axis=0.9)
layout(matrix(1:2,1,2))

plot(cprel,"overall",type="n",ylab="RR",ylim=c(.9,1.3),
  xlab="Temperature percentiles",xaxt="n")
axis(1,at=perctmean[paste(labperc,".0%",sep="")],
  labels=paste(labperc,"%",sep=""))

for(i in seq(m)) {
  # WARNING FOR PREDICTION BEYOND BOUNDARIES SUPPRESSED
  suppressWarnings(
  lines(crosspred(bperc,coef=ymatrel[i,],vcov=Slistrel[[i]],model.link="log"),
    col=grey(0.8),lty=5)
  )
}
lines(cprel,"overall",col=1,lwd=2)
points(round(knots,1),cprel$allRRfit[as.character(knots)],pch=19,cex=0.6)
abline(h=1)

plot(cprellat75,"overall",type="n",ylab="RR",ylim=c(.9,1.3),
  xlab="Temperature percentiles",ci.arg=list(density=20,col=grey(0.7)),xaxt="n")
lines(cprellat25,"overall",col=1,lty=5,lwd=2,ci="area",
  ci.arg=list(density=20,angle=-45,col=grey(0.7)))
lines(cprellat75,"overall",col=1,lty=4,lwd=2)
abline(h=1)
axis(1,at=perctmean[paste(labperc,".0%",sep="")],
  labels=paste(labperc,"%",sep=""))
legend("top",paste(percmod[,"lat"]),lty=c(4,5),lwd=2,cex=1,inset=0.1,bty="n",
  title="Latitude (degree North)")

dev.off()

#