看教程不够直观,那就看视频吧! >>点击加载视频
已封装成函数,如下:
compareRiskModal=function(os,ev,risks,max_time){
  library('survRM2')
  library('Hmisc')
  require(survival)
  library(survcomp)
  library(prodlim)
  
  # Parameters for RMS
  tau <-max_time # Restriction point
  n.grid <-100 # For plotting purposes
  # Set up data using age as the marker
  OS <-Surv(os,ev)
  marker.pp<-seq(from=0,to=1,length=n.grid)
  mdat=cbind()
  c.all=list()
  c.indexs=c()
  for(i in 1:ncol(risks)){
    marker <-as.numeric(risks[,i])
    marker.qq<-quantile(marker,marker.pp)
    fitdat.df<-data.frame(marker=marker)
    newdat.df<-data.frame(marker=marker.qq)
    # Calculations
    cox.model1<-coxph(OS~marker,data=fitdat.df)
    rms.calc <-summary(survfit(cox.model1,newdata=newdat.df),rmean=tau)
    rms.mean <-rms.calc$table[,"*rmean"]
    mdat=cbind(mdat,rms.mean)
    c1=concordance.index(x=as.numeric(risks[,i]), surv.time=os, surv.event=ev,
                      method="noether")
    c.all=c(c.all,list(c1))
    c.indexs=c(c.indexs,paste0(colnames(risks)[i],':',round(c1$c.index,2),',95%CI(',round(c1$lower,2),'-',round(c1$upper,2),'),p=',signif(c1$p.value,2)))
  }
  
  mt=ceiling(max(mdat))
  # RMS Curve
  cls=rainbow(ncol(risks))
  if(ncol(risks)>1){
    plot(marker.pp,as.numeric(mdat[,1]),pch=20,col = cls[1], cex=0.5,ylim=c(0,mt),xlab="",ylab="")
    if(ncol(risks)>2){
      for(i in 2:(ncol(risks)-1)){
        par(new=TRUE)
        plot(marker.pp,as.numeric(mdat[,i]),pch=20,col = cls[i], cex=0.5,ylim=c(0,mt),xlab="",ylab="")  
      }
    }
    par(new=TRUE)
    plot(marker.pp,as.numeric(mdat[,ncol(risks)]),pch=20,col = cls[ncol(risks)]
         , cex=0.5,ylim=c(0,mt),xlab="Percentile of Score",ylab="RMS")
  }else{
    plot(marker.pp,as.numeric(mdat[,1]),pch=20,col = "red", cex=0.5,ylim=c(0,mt),xlab="Percentile of Score",ylab="RMS")
  }
  legend("topright",   c.indexs, pch=20,col=cls, title= "C-index", inset = .05,cex = 0.7)
  #print(c.all)
  if(ncol(risks)>1){
    all.cp=c()
  for(i in 1:(ncol(risks)-1)){
    c1=concordance.index(x=risks[,i], surv.time=os, surv.event=ev,
                         method="noether")
    for(j in (i+1):ncol(risks)){
      c2=concordance.index(x=risks[,j], surv.time=os, surv.event=ev,
                           method="noether")
      p=min(cindex.comp(c1, c2)$p.value,cindex.comp(c2, c1)$p.value)
      all.cp=c(all.cp,paste0(colnames(risks)[i],'-vs-',colnames(risks)[j],':p=',signif(p,2)))
    }
    legend("bottomleft",   all.cp, title= "Compare C-index", inset = .05,cex = 0.7)
  }
  }
}
compareRiskModal(data$SURVIVAL_TIM,data$STATUS,data.frame(IPV=data$IPVHCC,MOD=data$Risk),5*365)
调用规则:
os:生存时间
ev: 生存事件
risks:一个数据框,列为各个模型的风险得分,行为样本和os,ev需一一对应。
max_time:计算的最大时间,比如五年 
体验效果如:

如果觉得我的文章对您有用,请随意打赏。你的支持将鼓励我继续创作!
