看教程不够直观,那就看视频吧! >>点击加载视频
已封装成函数,如下:
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:计算的最大时间,比如五年
体验效果如:
如果觉得我的文章对您有用,请随意打赏。你的支持将鼓励我继续创作!