基于Nomogram的公式提取

# 从Nomogram提取个体的得分公式，开发一个打分系统
# 参考资料1：https://mp.weixin.qq.com/s?src=11&timestamp=1602050809&ver=2629&signature=EAoh1zmeYnPQMazJcBumM7695mseQ3L45d44zN8P1*9bfPGpZFBX1SNarWynYwc8WlHdiaTiHKfTmQhoqgzcyr0wB1DIQ3vLb-8COSbhSO*BAIktlZP1GHnsOLt3AzZv&new=1
# 参考资料2：https://mp.weixin.qq.com/s?src=11&timestamp=1602050809&ver=2629&signature=2pteahb*mqUZo4jeAJhaLi1l98hNj*fv-OrO7eYPudwq7eelf0C-XBi0aWzCbBHw2vQBSyK5wxwHDJic5mjxWuoyHgHJuOYeSgllLMbk--9nXQkWuuzkGYg0DRbepi08&new=1
## 
library(rms)
n <-1000
age <- rnorm(n,50,10)
sex <- factor(sample(c('female','male'),n,TRUE))
sex <- as.numeric(sex)
ddist <- datadist(age,sex)
options(datadist='ddist')
cens <- 15*runif(n)
time <- -log(runif(n))/0.02*exp(.04*(age-50)+.8*(sex=='Female'))
death <- ifelse(time <= cens,1,0)
time <- pmin(time,cens)
units(time)="month"
f <- cph(formula(Surv(time,death)~sex+age),x=TRUE,y=TRUE,surv=TRUE,time.inc=3)
surv <- Survival(f)
nomo <- nomogram(f, fun=list(function(x) surv(3,x),function(x) surv(6,x)),
                 lp=TRUE,funlabel=c("3-Month Survival Prob","6-Month Survival Prob"))

plot(nomo)

## NomogramEx
#安装nomogramEx包
#install.packages("nomogramEx")
library(nomogramEx)
nomogramEx(nomo=nomo)

## nomogramFormula
#install.packages("nomogramFormula")
library(nomogramFormula)

## 单个患者列线图得分
#options(option)
results <- formula_lp(nomogram = nomo)
## 公式提取
results$formula
## 计算得分
points <- points_cal(formula = results$formula, lp = f$linear.predictors)
head(points)

## 计算得分
#options(option)
results <- formula_rd(nomogram = nomo)
mydata$points <- points_cal(formula = results$formula,rd=mydata)
head(mydata$points)