今天小果為大家?guī)?lái)的分享內(nèi)容為Nomogram模型的構(gòu)建和驗(yàn)證，該分析在腫瘤生信文章中出現(xiàn)的頻率非常高，小果本推文中主要繪制了列線圖和校正曲線繪制，干貨滿滿，非常值得小伙伴學(xué)習(xí)，接下來(lái)跟著小果馬上開始今天的學(xué)習(xí)！

1.?何為nomogram分析？ 在進(jìn)行分析之前，小果先為小伙伴介紹一下nomogram原理，nomogram實(shí)質(zhì)就是回歸方程的可視化，根據(jù)所有自變量回歸系數(shù)的大小來(lái)制定評(píng)分標(biāo)準(zhǔn)，給每個(gè)自變量的每種取值水平一個(gè)評(píng)分，對(duì)每個(gè)樣本就可計(jì)算得到一個(gè)總分，再通過(guò)得分與結(jié)局發(fā)生概率之間的轉(zhuǎn)換函數(shù)來(lái)計(jì)算每個(gè)樣本的結(jié)局時(shí)間發(fā)生的概率，我們通過(guò)Nomogram的方法得到的概率評(píng)價(jià)預(yù)測(cè)目標(biāo)獨(dú)立生存預(yù)后因素與預(yù)后間的相關(guān)性及對(duì)生存預(yù)后的預(yù)測(cè)關(guān)系。以上就是小果對(duì)nomogram的介紹，小伙伴們有沒有理解呀！馬上和小果開啟實(shí)操練習(xí)吧！ 2.準(zhǔn)備需要的R包 #安裝需要的R包 install.packages("rms") install.packages("survival") #加載需要的R包 library(rms) library(survival) 3.讀取輸入數(shù)據(jù) #行名為樣本名，列名為臨床因素 pbc<-read.table("Nomogram.txt")

#對(duì)bili列進(jìn)行數(shù)據(jù)分割 pbc$catbili <- cut(pbc$bili,breaks=c(-Inf, 2, 4, Inf), ???????????????????labels=c("low","medium","high")) #增加新的列 pbc$died <- pbc$status==2 4.Nomogram分析 dd<-datadist(pbc) options(datadist="dd") options(na.action="na.delete") #多因素cox回歸 coxpbc<-cph(formula = Surv(time,died) ~?age + catbili + sex + copper + stage + trt ,data=pbc,x=T,y=T,surv = T,na.action=na.delete) surv<-Survival(coxpbc) #5年生存率 surv3<-function(x) surv(1825,x) #8年生存率 surv4<-function(x) surv(2920,x) x<-nomogram(coxpbc,fun = list(surv3,surv4),lp=T, ????????????funlabel = c('5-year survival Probability','8-year survival Probability'), ????????????maxscale = 100,fun.at = c(0.95,0.9,0.8,0.7,0.6,0.5,0.4,0.3,0.2,0.1)) #繪制列線圖 pdf("nomogram_classical.pdf",width = 12,height = 10) plot(x, lplabel="Linear Predictor", ?????xfrac=.35,varname.label=TRUE, varname.label.sep="=", ia.space=.2, ?????tck=NA, tcl=-0.20, lmgp=0.3, ?????points.label='Points', total.points.label='Total Points', ?????total.sep.page=FALSE, ?????cap.labels=FALSE,cex.var = 1.6,cex.axis = 1.05,lwd=5, ?????label.every = 1,col.grid = gray(c(0.8, 0.95))) dev.off()

5.繪制校正曲線進(jìn)行驗(yàn)證 #5年生存率校正曲線 f5<-cph(formula = Surv(time,died) ~?age + catbili + sex + copper +stage + trt,data=pbc,x=T,y=T,surv = T,na.action=na.delete,time.inc = 1825) #參數(shù)m=50表示每組50個(gè)樣本進(jìn)行重復(fù)計(jì)算 cal5<-calibrate(f5, cmethod="KM", method="boot",u=1825,m=50,B=1000) pdf("calibration_5y.pdf",width = 8,height = 8) plot(cal5, ?????lwd = 2,#error bar的粗細(xì) ?????lty = 2,#error bar的類型，可以是0-6 ?????errbar.col = c("#2166AC"),#error bar的顏色 ?????xlim = c(0,1),ylim= c(0,1), ?????xlab = "Nomogram-prediced OS (%)",ylab = "Observed OS (%)", ?????cex.lab=1.2, cex.axis=1, cex.main=1.2, cex.sub=0.6) #字的大小 lines(cal5[,c('mean.predicted',"KM")], ??????type = 'b', #連線的類型，可以是"p","b","o" ??????lwd = 2, #連線的粗細(xì) ??????pch = 16, #點(diǎn)的形狀，可以是0-20 ??????col = c("#2166AC")) #連線的顏色 mtext("") box(lwd = 1) #邊框粗細(xì) abline(0,1,lty = 3, #對(duì)角線為虛線 ???????lwd = 2, #對(duì)角線的粗細(xì) ???????col = c("#224444")#對(duì)角線的顏色 ???????) dev.off()

#8年生存率校正曲線,time.inc = 2920 f8<-cph(formula = Surv(time,died) ~?age + catbili + sex + copper +stage + trt,data=pbc,x=T,y=T,surv = T,na.action=na.delete,time.inc = 2920) cal8<-calibrate(f8, cmethod="KM", method="boot",u=2920,m=50,B=1000) pdf("calibration_8y.pdf",width = 8,height = 8) plot(cal8, ?????lwd = 2, ?????lty = 4, ?????errbar.col = c("#B2182B"), ?????xlim = c(0,1),ylim= c(0,1), ?????xlab = "Nomogram-prediced OS (%)",ylab = "Observed OS (%)", ?????col = c("#B2182B"), ?????cex.lab=1.2,cex.axis=1, cex.main=1.2, cex.sub=0.6) lines(cal8[,c('mean.predicted',"KM")], ??????type= 'b', ??????lwd = 2, ??????col = c("#B2182B"), ??????pch = 16) mtext("") box(lwd = 1) abline(0,1,lty= 3, ???????lwd = 2, ???????col =c("#224444")) dev.off()

#繪制5年和8年生存率校正曲線 pdf("calibration_compare.pdf",width = 8,height = 8) plot(cal5,lwd = 2,lty = 0,errbar.col = c("#2166AC"), ?????bty = "l", #只畫左邊和下邊框 ?????xlim = c(0,1),ylim= c(0,1), ?????xlab = "Nomogram-prediced OS (%)",ylab = "Observed OS (%)", ?????col = c("#2166AC"), ?????cex.lab=1.2,cex.axis=1, cex.main=1.2, cex.sub=0.6) lines(cal5[,c('mean.predicted',"KM")], ??????type = 'b', lwd = 1, col = c("#2166AC"), pch = 16) mtext("") ? plot(cal8,lwd = 2,lty = 0,errbar.col = c("#B2182B"), ?????xlim = c(0,1),ylim= c(0,1),col = c("#B2182B"),add = T) lines(cal8[,c('mean.predicted',"KM")], ??????type = 'b', lwd = 1, col = c("#B2182B"), pch = 16) ? abline(0,1, lwd = 2, lty = 3, col = c("#224444")) ? legend("topleft", #圖例的位置 ???????legend = c("5-year","8-year"), #圖例文字 ???????col =c("#2166AC","#B2182B"), #圖例線的顏色，與文字對(duì)應(yīng) ???????lwd = 2,#圖例中線的粗細(xì) ???????cex = 1.2,#圖例字體大小 ???????bty = "n")#不顯示圖例邊框 dev.off()

今天小果完成了Nomogram模型的構(gòu)建和驗(yàn)證，快自己試試吧！