## Fig 20.7 for IPI case study

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 #
```