R language draws the time-dependent (correlation) roc curve and time-dependence (correlation) cindex curve of the survival analysis model

ROC curve and cindex curve belong to the indicators of consistency. Some fans in the background asked how to draw the time-correlated roc curve and time-correlated cindex curve in cox regression. Let me demonstrate it today.


We first import the data and the R package

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)

This is our commonly used breast cancer data, (reply from the official account: breast cancer, you can get this data), age means age, pathsize means pathological tumor size (cm), lnpos means positive axillary lymph nodes, histgrad means histopathological grade, er Indicates the status of estrogen receptor, pr indicates the status of progesterone receptor, whether the status outcome event is death, pathscat indicates the pathological tumor size category (grouping variable), ln_yesno indicates whether there is lymph node enlargement, time is the survival time, and agec is our Set it yourself, don't worry about it.
Some variables are categorical variables, we first convert them into factors

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)

We first establish 3 cox regression equations, which are built casually

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)

Many R packages can do time-dependent ROC. This time we introduce the riskRegression package. If you are interested, you can introduce other packages next time.

library(riskRegression)

Suppose we want to understand the time correlation roc of f1, here we should pay attention to the fact that formula=Surv(time,status)~1 is equal to no weight, if changing 1 to a covariate is equal to weighting

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)

In this way, the graph is generated, which is very simple. We can also extract the data and put it on ggplot for drawing

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")

Suppose we want to know the temporal correlation roc of f1 and f2

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))
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")

Let's introduce the time-dependent cindex, which needs to use the pec package, first draw f1

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)

Suppose you want to know the cindex of f1, f, f3

A1<-pec::cindex(("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)

You can also change the color, label, etc., I won't do it here.