ノモグラム

library(rms)
fURS = TUL0108$flexiblebasket.yes
age = TUL0108$age
bmi = TUL0108$bmi.imputed
diabetes = TUL0108$diabetes
sex = TUL0108$sex.1f
ps = TUL0108$ps.declined
size = TUL0108$renoureter.size.revised
burden = TUL0108$renoureter.multi.revised
time = TUL0108$op.time
infected = TUL0108$stone.infected
set.seed(17)
ddist <- datadist(fURS,diabetes,time)
options(datadist = "ddist")

#glmではだめっぽい 　lrmで

f <- lrm(Y ~ fURS+diabetes+time)
summary(f)
nom <- nomogram(f, fun=function(x)1/(1+exp(-x)), # or fun=plogis
fun.at=c(.001,.01,.05,seq(.1,.9,by=.1),.95,.99,.999),
funlabel="Risk of UTI")
#Instead of fun.at, could have specified fun.lp.at=logit of
#sequence above - faster and slightly more accurate
plot(nom, xfrac=.45)
print(nom)

#例 ）手術時間の上限、下限。点数もかわる

nom2 <- nomogram(f, fun = plogis, funlabel="Risk of UTI",lp = FALSE, time=seq(0,180,by=10))
plot(nom2, xfrac=.35)

#キャリブレーションプロット

model <- lrm(Y~fURS+diabetes+burden+time,x=TRUE, y=TRUE)
summary(model)
cali <- calibrate(model, method="boot", B=300, predy=seq(.01,.99,length=100))
plot(cali)