lasso回歸漓骚,ROC曲線及其ROC曲線的比較

很多時候遇到的數(shù)據(jù)均為表達譜數(shù)據(jù),所以基因數(shù)量很多榛泛,需要用lasso回歸來篩選變量蝌蹂。一般都是使用R來實現(xiàn),下述代碼為篩選變量與篩選出來的變量做ROC曲線

rm(list = ls())
options(stringsAsFactors = F)
load("sur_model.Rdata")
load("UCECcox_lr.Rdata")
load('UCECcox.Rdata')
load('UCEClog_rank_p.Rdata')
cox1=c('RP4-616B8.5','RP11-389G6.3',"AP000696.2",'CTD-2377D24.6',"LINC01559" ,"LINC00629","AC005062.2","LINC01018")
##A='CTD-2377D24.6',B='RP4-616B8.5',C='RP11-389G6.3'
##'CTD-2377D24.6','RP4-616B8.5','RP11-389G6.3'
##cox1為定義的任何向量曹锨,比如里面含有你所感興趣的基因名稱
exprSet = exprSet[cox1,]#表達譜數(shù)據(jù)中提取你所感興趣的基因表達
exprSet=as.data.frame(exprSet)
dim(exprSet)
exprSet[1:2,1:2]#檢查你的數(shù)據(jù)是否正確
x=t(exprSet)
y=meta$event#提取病例的預后情況(0與1)列孤个,meta是臨床數(shù)據(jù)
#lasso
library(glmnet)
model_lasso <- glmnet(x, y,nlambda=10, alpha=1)
print(model_lasso)
set.seed(13098)
cv_fit <- cv.glmnet(x=x, y=y, nlambda = 1000,alpha = 1)
plot(cv_fit)

#ROC
#load('for_cox.Rdata')
lasso.prob <- predict(cv_fit, newx=x , s=c(cv_fit$lambda.min,cv_fit$lambda.1se) )
head(lasso.prob)
re=cbind(y ,lasso.prob)
head(re)
re1=as.data.frame(re)

write.csv(re,file='')
#箱線圖(可有無
re=as.data.frame(re)
colnames(re)=c('event','prob_min','prob_1se')
re$event=as.factor(re$event)
library(ggpubr) 
p1 = ggboxplot(re, x = "event", y = "prob_min",
               color = "event", palette = "jco",
               add = "jitter")+ stat_compare_means()
p2 = ggboxplot(re, x = "event", y = "prob_1se",
               color = "event", palette = "jco",
               add = "jitter")+ stat_compare_means()
library(patchwork)
p1+p2


#ROC

library(ROCR)
library(caret)
# 自己預測自己
#min
pred_min <- prediction(re[,2], re[,1])
auc_min = performance(pred_min,"auc")@y.values[[1]]
perf_min <- performance(pred_min,"tpr","fpr")

#1se
pred_1se <- prediction(re[,3], re[,1])
auc_1se = performance(pred_1se,"auc")@y.values[[1]]
perf_1se <- performance(pred_1se,"tpr","fpr")




#ggpot2
tpr_min = performance(pred_min,"tpr")@y.values[[1]]
tpr_1se = performance(pred_1se,"tpr")@y.values[[1]]
dat = data.frame(tpr_min = perf_min@y.values[[1]],
                 fpr_min = perf_min@x.values[[1]]
                )



library(ggplot2)
ggplot() + 
  geom_line(data = dat,aes(x = fpr_min, y = tpr_min),color = "blue",size=3) + 
  geom_line(aes(x=c(0,1),y=c(0,1)),color = "grey",size = 3,linetype=6 )+
  theme_bw()+
  annotate("text",x = .75, y = .25,
           label = paste("AUC of min = ",round(auc_min,2)),color = "blue",size=10)+
  scale_x_continuous(name  = "1-Specificity")+
  scale_y_continuous(name = "Sensitivity")+ 
  theme(plot.title = element_text(hjust = 0.5,size = 24),
        axis.text=element_text(size=24),
        axis.title.x = element_text(size = 24),
        axis.title.y = element_text(size = 24),
        legend.title = element_text(size=24),
        legend.text = element_text(size=18))

dev.off

有很多時候需要得到一個gene對結局貢獻性的ROC,及其各個ROC曲線之間比較沛简,下述代碼為SAS程序代碼

data roc;
      input alb tp totscore popind @@;##alb tp totscore 均為自變量齐鲤,比如一個gene的表達量,popind為結局(0 and 1)
      totscore = 10 - totscore;##對自變量按照需要處理
      datalines;
   3.0 5.8 10 0   3.2 6.3  5 1   3.9 6.8  3 1   2.8 4.8  6 0   
   3.2 5.8  3 1   0.9 4.0  5 0   2.5 5.7  8 0   1.6 5.6  5 1   
   3.8 5.7  5 1   3.7 6.7  6 1   3.2 5.4  4 1   3.8 6.6  6 1   
   4.1 6.6  5 1   3.6 5.7  5 1   4.3 7.0  4 1   3.6 6.7  4 0   
   2.3 4.4  6 1   4.2 7.6  4 0   4.0 6.6  6 0   3.5 5.8  6 1   
   3.8 6.8  7 1   3.0 4.7  8 0   4.5 7.4  5 1   3.7 7.4  5 1   
   3.1 6.6  6 1   4.1 8.2  6 1   4.3 7.0  5 1   4.3 6.5  4 1   
   3.2 5.1  5 1   2.6 4.7  6 1   3.3 6.8  6 0   1.7 4.0  7 0   
   3.7 6.1  5 1   3.3 6.3  7 1   4.2 7.7  6 1   3.5 6.2  5 1   
   2.9 5.7  9 0   2.1 4.8  7 1   2.8 6.2  8 0   4.0 7.0  7 1   
   3.3 5.7  6 1   3.7 6.9  5 1   3.6 6.6  5 1   
   ;
    ods graphics on;
   proc logistic data=roc plots=roc(id=prob);
      model popind(event='0') = alb tp totscore / nofit;
      roc 'Albumin' alb;
      roc 'K-G Score' totscore;
      roc 'Total Protein' tp;
      roccontrast reference('K-G Score') / estimate e;
   run;
   ods graphics off;
?著作權歸作者所有,轉載或內(nèi)容合作請聯(lián)系作者
  • 序言:七十年代末,一起剝皮案震驚了整個濱河市,隨后出現(xiàn)的幾起案子落恼,更是在濱河造成了極大的恐慌关霸,老刑警劉巖,帶你破解...
    沈念sama閱讀 221,820評論 6 515
  • 序言:濱河連續(xù)發(fā)生了三起死亡事件荚板,死亡現(xiàn)場離奇詭異凤壁,居然都是意外死亡,警方通過查閱死者的電腦和手機跪另,發(fā)現(xiàn)死者居然都...
    沈念sama閱讀 94,648評論 3 399
  • 文/潘曉璐 我一進店門拧抖,熙熙樓的掌柜王于貴愁眉苦臉地迎上來,“玉大人免绿,你說我怎么就攤上這事唧席。” “怎么了?”我有些...
    開封第一講書人閱讀 168,324評論 0 360
  • 文/不壞的土叔 我叫張陵淌哟,是天一觀的道長迹卢。 經(jīng)常有香客問我,道長徒仓,這世上最難降的妖魔是什么腐碱? 我笑而不...
    開封第一講書人閱讀 59,714評論 1 297
  • 正文 為了忘掉前任,我火速辦了婚禮掉弛,結果婚禮上症见,老公的妹妹穿的比我還像新娘。我一直安慰自己殃饿,他們只是感情好谋作,可當我...
    茶點故事閱讀 68,724評論 6 397
  • 文/花漫 我一把揭開白布。 她就那樣靜靜地躺著乎芳,像睡著了一般遵蚜。 火紅的嫁衣襯著肌膚如雪。 梳的紋絲不亂的頭發(fā)上秒咐,一...
    開封第一講書人閱讀 52,328評論 1 310
  • 那天谬晕,我揣著相機與錄音,去河邊找鬼携取。 笑死攒钳,一個胖子當著我的面吹牛,可吹牛的內(nèi)容都是我干的雷滋。 我是一名探鬼主播不撑,決...
    沈念sama閱讀 40,897評論 3 421
  • 文/蒼蘭香墨 我猛地睜開眼,長吁一口氣:“原來是場噩夢啊……” “哼晤斩!你這毒婦竟也來了焕檬?” 一聲冷哼從身側響起,我...
    開封第一講書人閱讀 39,804評論 0 276
  • 序言:老撾萬榮一對情侶失蹤澳泵,失蹤者是張志新(化名)和其女友劉穎实愚,沒想到半個月后,有當?shù)厝嗽跇淞掷锇l(fā)現(xiàn)了一具尸體兔辅,經(jīng)...
    沈念sama閱讀 46,345評論 1 318
  • 正文 獨居荒郊野嶺守林人離奇死亡腊敲,尸身上長有42處帶血的膿包…… 初始之章·張勛 以下內(nèi)容為張勛視角 年9月15日...
    茶點故事閱讀 38,431評論 3 340
  • 正文 我和宋清朗相戀三年,在試婚紗的時候發(fā)現(xiàn)自己被綠了维苔。 大學時的朋友給我發(fā)了我未婚夫和他白月光在一起吃飯的照片碰辅。...
    茶點故事閱讀 40,561評論 1 352
  • 序言:一個原本活蹦亂跳的男人離奇死亡,死狀恐怖介时,靈堂內(nèi)的尸體忽然破棺而出没宾,到底是詐尸還是另有隱情凌彬,我是刑警寧澤,帶...
    沈念sama閱讀 36,238評論 5 350
  • 正文 年R本政府宣布循衰,位于F島的核電站铲敛,受9級特大地震影響,放射性物質發(fā)生泄漏羹蚣。R本人自食惡果不足惜原探,卻給世界環(huán)境...
    茶點故事閱讀 41,928評論 3 334
  • 文/蒙蒙 一、第九天 我趴在偏房一處隱蔽的房頂上張望顽素。 院中可真熱鬧咽弦,春花似錦、人聲如沸胁出。這莊子的主人今日做“春日...
    開封第一講書人閱讀 32,417評論 0 24
  • 文/蒼蘭香墨 我抬頭看了看天上的太陽全蝶。三九已至闹蒜,卻和暖如春,著一層夾襖步出監(jiān)牢的瞬間抑淫,已是汗流浹背绷落。 一陣腳步聲響...
    開封第一講書人閱讀 33,528評論 1 272
  • 我被黑心中介騙來泰國打工, 沒想到剛下飛機就差點兒被人妖公主榨干…… 1. 我叫王不留始苇,地道東北人砌烁。 一個月前我還...
    沈念sama閱讀 48,983評論 3 376
  • 正文 我出身青樓,卻偏偏與公主長得像催式,于是被迫代替她去往敵國和親函喉。 傳聞我的和親對象是個殘疾皇子,可洞房花燭夜當晚...
    茶點故事閱讀 45,573評論 2 359

推薦閱讀更多精彩內(nèi)容