代码+视频,R语言绘制生存分析模型的时间依赖(相关)性roc曲线和时间依赖(相关)性cindex曲线

ROC曲线分析是用于评估一个因素预测能力的手段,是可以用于连续型变量分组的方法。在生存分析中,疾病状态和因素取值均会随时间发生变化。而标准的ROC曲线分析将个体的疾病状态和因素取值视作固定值,未将时间因素考虑在分析之中。在这种情况下,使用时间依赖性ROC无疑是更好的选择

在这里插入图片描述
今天咱们视频来演示一下时间依赖ROC曲线绘制

R语言绘制生存分析模型的时间依赖(相关)性roc曲线和时间依赖(相关)性cindex曲线

代码

library(survival)
library("survminer")
library(foreign)
#公众号:零基础说科研
#公众号回复:乳腺癌,可以获得这个数据
bc <- read.spss("E:/r/test/Breast cancer survival agec.sav",
                use.value.labels=F, to.data.frame=T)
bc <- na.omit(bc)
names(bc)
##分类变量转成因子
bc$histgrad<-as.factor(bc$histgrad)
bc$er<-as.factor(bc$er)
bc$pr<-as.factor(bc$pr)
bc$ln_yesno<-as.factor(bc$ln_yesno)

f1<-coxph(Surv(time,status)~er+histgrad+pr+age+ln_yesno,bc,x=TRUE,y=TRUE)
f2<-coxph(Surv(time,status)~er+histgrad+ln_yesno,bc,x=TRUE,y=TRUE)
f3<-coxph(Surv(time,status)~ln_yesno,bc,x=TRUE,y=TRUE)

library(riskRegression)
A3<- riskRegression::Score(list("f1"=f1),
                           formula=Surv(time,status)~1,
                           data=bc,
                           metrics="auc",
                           null.model=F,
                           times=seq(3,132,1))
plotAUC(A3)
##########
auc<-plotAUC(A3)
ggplot()+geom_line(data=auc, aes(times,AUC),linetype=1,size=1,alpha = 0.6,colour="red")+
  geom_ribbon(data=auc, aes(times,ymin = lower, ymax = upper),alpha = 0.1,fill="red")+
  geom_hline(yintercept=1, linetype=2,size=1)+theme_classic()+ 
  labs(title = "时间相关性ROC", x="times", y="AUC")

A3<- riskRegression::Score(list("f1"=f1,"f2"=f2),
                           formula=Surv(time,status)~1,
                           data=bc,
                           metrics="AUC",
                           null.model=F,
                           times=seq(3,132,1))
plotAUC(A3)
auc<-plotAUC(A3)
ggplot()+geom_line(data=auc, aes(times,AUC,group=model,col=model))+
  geom_ribbon(data=auc, aes(times,ymin = lower, ymax = upper,fill=model),alpha = 0.1)+
  geom_hline(yintercept=1, linetype=2,size=1)+theme_classic()+ 
  labs(title = "时间相关性ROC", x="times", y="AUC")
###########
library(pec)
A1<-pec::cindex(list("f1"=f1),
                formula=Surv(time,status)~er+histgrad+pr+age+ln_yesno,
                data=bc,
                eval.times=seq(3,132,1))
plot(A1)

A1<-pec::cindex(list("f1"=f1,"f2"=f2,"f3"=f3),
                formula=Surv(time,status)~er+histgrad+pr+age+ln_yesno,
                data=bc,
                eval.times=seq(3,132,1))
plot(A1)
  • 2
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 打赏
    打赏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

天桥下的卖艺者

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值