The IPI recalibration study started from a simple validation with 8 data points: 2 and 5 year survival for 4 groups. The R code is:
library(rms) mycolors = c('black' = 1, 'Red'= '#ED0000', 'CongressBlue' = '#00468B', 'Apple' = '#42B540', 'BondiBlue' = '#0099B4', 'TrendyPink' = '#925E9F', 'Carmine' = '#AD002A', 'CodGray' = '#1B1919', 'MonaLisa' = '#FDAF91', 'Edward' = '#ADB6B6') IPIdata <- as.data.frame( matrix(data=c(1, 2, 0.84, 2, 2, 0.66, 3, 2, 0.54, 4, 2, 0.34, 1, 5, 0.73, 2, 5, 0.51, 3, 5, 0.43, 4, 5, 0.26), nrow=8, ncol=3, byrow=T, dimnames=list(NULL,Cs(IPI,tfup,surv)))) # Make a factor as in Van Houwelingen paper, reference is IPI==4 IPIdata$IPIr <- as.factor(4 - IPIdata$IPI) fit <- ols(log(-log(surv))~IPIr+ log(tfup), data=IPIdata) # Exactly as published in Stat Med 2000; 19; page 3404 # Fig 20.7 # IPIpred <- predict(fit, cbind(c(rep(1,101),rep(2,101),rep(3,101),rep(4,101)), rep(seq(0,10,0.1),4))) plot(x=seq(0,10,0.1), y=exp(-exp(IPIpred))[1:101], axes='n', type='l', lty=4,lwd=3, ylim=c(0,1),col=mycolors[7]) axis(side=1, at=c(0,2,5,10)) mtext('Time (years)', cex=1.2, side=1, line=2.5) axis(side=2, las=1) mtext('Fraction surviving', cex=1.2, side=2, line=2.5) lines(seq(0,10,0.1), y=exp(-exp(IPIpred))[102:202], lty=3,lwd=3,col=mycolors[2]) lines(seq(0,10,0.1), y=exp(-exp(IPIpred))[203:303], lty=2,lwd=3,col=mycolors[3]) lines(seq(0,10,0.1), y=exp(-exp(IPIpred))[304:404], lty=1,lwd=3,col=mycolors[4]) text(x=rep(8,4),y=c(.75,.5,.3,.1), c("IPI=1","IPI=2","IPI=3","IPI=4"), col=mycolors[c(4,3,2,7)]) points(x=IPIdata[c(1,5),2], y=IPIdata[c(1,5),3], pch=0, cex=1.5, col=mycolors[4], lwd=2) points(x=IPIdata[c(1,5),2], y=IPIdata[c(1+1,5+1),3], pch=1, cex=1.5, col=mycolors[3], lwd=2) points(x=IPIdata[c(1,5),2], y=IPIdata[c(1+2,5+2),3], pch=3, cex=1.5, col=mycolors[2], lwd=2) points(x=IPIdata[c(1,5),2], y=IPIdata[c(1+3,5+3),3], pch=8, cex=1.5, col=mycolors[7], lwd=2) # End Fig 20.7 #