#***************************************************************# # R code for the leukemia analysis in Ch 13. # #***************************************************************# library(survival) library(xlsReadWrite) library(R2WinBUGS) ## R2WinBUGS to fit the 2 group exponential model # Group 1 is AG+ # Group 2 is AG- library(R2WinBUGS) n <- c(17,16) a1 <- 0.0001 b1 <- 0.0001 a2 <- 0.0001 b2 <- 0.0001 t1 <- c(65,156,100,134,16,108,121,4,39,143,56,26,22,1,1,5,65) t2 <- c(56,65,17,7,16,22,3,4,2,3,8,4,3,30,4,43) leukemiadata <- list("n","t1","t2","a1","b1","a2","b2") parameters <- c("theta1","theta2","median1","median2","relmedian","S","Sdiff") inits <- list( list(theta1=0.05, theta2=0.02)) leuk.fit <- bugs(leukemiadata, inits, parameters,"leukemia.txt", working.directory = "H:\\MyDocuments\\BAYES\\SurvivalRegression\\Leukemia", n.chains=1, n.iter=50000, n.thin=1, n.burnin=0) round(print(leuk.fit),3) attach.bugs(leuk.fit) ## Plot mean survival curves from the Exp model time <- seq(0,170,1) survcurves1 <- exp(-theta1%*%t(time)) survmean1 <- apply(survcurves1,2,mean) survcurves2 <- exp(-theta2%*%t(time)) survmean2 <- apply(survcurves2,2,mean) plot(time,survmean1, type="l", xlab="", ylab="", lwd=3) lines(time, survmean2, lty=2, lwd=3) legend("topright", c("AG Positive","AG Negative"), lty=1:2, lwd=2, cex=1,bty="n") mtext("t",line=3,side=1,cex=1.5) mtext("S(t)",line=2.5,side=2,cex=1.5) ## Frequentist Cox analysis of leukemia data n <- 33 y <- c(65,156,100,134,16,108,121,4,39,143,56,26,22,1,1,5,65,56,65,17,7,16,22,3,4,2,3,8,4,3,30,4,43) g <- c(rep(1,17),rep(0,16)) status <- rep(1,33) cox <- coxph(Surv(y, status) ~ g) cox.zph(cox) summary(cox) agpos <- survfit(cox,list(g=1)) agneg <- survfit(cox,list(g=0)) plot(agpos$time, agpos$surv, type="l") lines(agneg$time, agneg$surv,lty=1) ## Plot estimated (mean) survival curves from (i) Bayes Exp model, (ii) Bayes PH model, and (iii) Freq PH model ## FIGURE 13.5 timecox <- c(0,1,2,3,4,5,7,8,16,17,22,26,30,39,43,56,65,100,108,121,134,143,156) # Estimates from WinBUGS code bayesagneg <- c(0.995,0.905,0.8615,0.7319,0.5623,0.5219,0.4829,0.4422,0.3694,0.3311,0.2617,0.2294,0.1979,0.1692,0.1409,0.09246,0.03141,0.02115, 0.01319,0.007724,0.004056,0.001636,3.62E-04) bayesagpos <- c(0.9985,0.9713,0.9575,0.9133,0.8465,0.8285,0.8102,0.79,0.7501,0.7268,0.6788,0.6533,0.6255,0.5972,0.5652,0.4966,0.3377,0.288, 0.2346,0.1828,0.1321,0.07805,0.02725) # Figure 13.4 plot(time,survmean1, type="l", xlab="", ylab="", lwd=2) lines(time, survmean2, lty=1, lwd=2) lines(timecox,bayesagpos,lty=2,lwd=2) lines(timecox,bayesagneg,lty=2,lwd=2) lines(agneg$time, agneg$surv,lty=1) lines(agpos$time, agpos$surv,lty=1) mtext("t",line=3,side=1,cex=1.2) mtext("S(t)",line=2.5,side=2,cex=1.2) legend("topright",lty=c(1,1,2), c("Bayes Exponential","PH Frequentist","PH Bayes"),lwd=c(2,1,2)) text(125,0.3,"AG+") text(17,0.2,"AG-") #### Figure 13.5. Leukemia data. Using output from SAS betapostmean <- -1.32 hoAGneg <- c(0,0.088,0.2818,0.0537,0.0315,0.0504,0.029,0.037,0.0749,0.0571,0.2481,0.2481) hoAGpos <- exp(betapostmean)*hoAGneg timeho <- c(0,0,3.5,4.5,7.5,16.5,24,41,60.6,82.5,127.5,160) plot(timeho,hoAGneg,type="s",xlab="t",ylab="Estimated Hazard",cex=2) lines(timeho,hoAGpos,type="s", lty=2) legend("top",lty=1:2,c("AG-","AG+"),bty="n")