作者：白介素2
相關(guān)閱讀：
R語(yǔ)言-multiROC package
R語(yǔ)言生存分析04-Cox比例風(fēng)險(xiǎn)模型診斷
R語(yǔ)言生存分析03-Cox比例風(fēng)險(xiǎn)模型
R語(yǔ)言生存分析-02-ggforest
R語(yǔ)言生存分析-01
生存曲線
如果沒(méi)有時(shí)間精力學(xué)習(xí)代碼，推薦了解：零代碼數(shù)據(jù)挖掘課程
pROC package
以下是本包中常用的一些縮寫(xiě)
ROC: receiver operating characteristic,ROC曲線
AUC: area under the ROC curve,曲線下面積
pAUC: partial area under the ROC curve 部分曲線下面積
CI: confidence interval 可信區(qū)間
SP: specificity 特異度
SE: sensitivity 靈敏度
require(pROC)
data(aSAH)
if(!require(DT)) install.packages(DT)
DT::datatable(aSAH)
aSAH[1:5,1:5]
image.png
roc函數(shù)建立roc曲線
- 支持在管道中運(yùn)行
- 參數(shù)分別為data, event, predict marker
library(dplyr)
aSAH %>%
filter(gender == "Female") %>%
roc(outcome, s100b)
Call:
roc.data.frame(data = ., response = outcome, predictor = s100b)
Data: s100b in 50 controls (outcome Good) < 21 cases (outcome Poor).
Area under the curve: 0.72
coords函數(shù)中篩選有效的的坐標(biāo)
- transpose參數(shù)指返回值的格式,FALSE 為row
- 這樣篩選出了敏感度和特異度>0.6的坐標(biāo)
library(dplyr)
aSAH %>%
filter(gender == "Female") %>%
roc(outcome, s100b) %>%
coords(transpose=FALSE) %>%
filter(sensitivity > 0.6,
specificity > 0.6)
threshold specificity sensitivity
1 0.155 0.68 0.6666667
2 0.165 0.74 0.6666667
3 0.175 0.76 0.6666667
4 0.185 0.78 0.6666667
5 0.215 0.80 0.6666667
6 0.245 0.82 0.6666667
7 0.255 0.82 0.6190476
建立roc 對(duì)象的方法
# Build a ROC object and compute the AUC
roc(aSAH$outcome, aSAH$s100b)
roc(outcome ~ s100b, aSAH)
建立光滑曲線
# Smooth ROC curve
roc(outcome ~ s100b, aSAH, smooth=TRUE)
Call:
roc.formula(formula = outcome ~ s100b, data = aSAH, smooth = TRUE)
Data: s100b in 72 controls (outcome Good) < 41 cases (outcome Poor).
Smoothing: binormal
Area under the curve: 0.74
可信區(qū)間與繪圖
# more options, CI and plotting
roc1 <- roc(aSAH$outcome,
aSAH$s100b, percent=TRUE,
# arguments for auc
partial.auc=c(100, 90), partial.auc.correct=TRUE,
partial.auc.focus="sens",
# arguments for ci
ci=TRUE, boot.n=100, ci.alpha=0.9, stratified=FALSE,
# arguments for plot
plot=TRUE, auc.polygon=TRUE, max.auc.polygon=TRUE, grid=TRUE,
print.auc=TRUE, show.thres=TRUE)
## 在原有圖形上繼續(xù)繪制
roc2 <- roc(aSAH$outcome, aSAH$wfns,
plot=TRUE, add=TRUE, percent=roc1$percent)
image.png
找出感興趣的坐標(biāo)
## Coordinates of the curve ##
coords(roc1, "best", ret=c("threshold", "specificity", "1-npv"),transpose = FALSE
)
coords(roc2, "local maximas", ret=c("threshold", "sens", "spec", "ppv", "npv"),transpose = FALSE)
threshold sensitivity specificity ppv npv
local.maximas -Inf 100.00000 0.00000 36.28319 NaN
local.maximas.1 1.5 95.12195 51.38889 52.70270 94.87179
local.maximas.2 2.5 65.85366 79.16667 64.28571 80.28169
local.maximas.3 3.5 63.41463 83.33333 68.42105 80.00000
local.maximas.4 4.5 43.90244 94.44444 81.81818 74.72527
local.maximas.5 Inf 0.00000 100.00000 NaN 63.71681
計(jì)算AUC可信區(qū)間
# CI of the AUC
ci(roc2)
95% CI: 74.85%-89.88% (DeLong)
plot在原有圖形上增加
- add=TRUE參數(shù)
roc1 <- roc(aSAH$outcome,
aSAH$s100b, percent=TRUE,
# arguments for auc
partial.auc=c(100, 90), partial.auc.correct=TRUE,
partial.auc.focus="sens",
# arguments for ci
ci=TRUE, boot.n=100, ci.alpha=0.9, stratified=FALSE,
# arguments for plot
plot=TRUE, auc.polygon=TRUE, max.auc.polygon=TRUE, grid=TRUE,
print.auc=TRUE, show.thres=TRUE)
plot(roc2, add=TRUE)
image.png
比較AUC
- 看是否有統(tǒng)計(jì)學(xué)意義
# Test on the whole AUC
roc.test(roc1, roc2, reuse.auc=FALSE)
DeLong's test for two correlated ROC curves
data: roc1 and roc2
Z = -2.209, p-value = 0.02718
alternative hypothesis: true difference in AUC is not equal to 0
sample estimates:
AUC of roc1 AUC of roc2
73.13686 82.36789
繪制ROC曲線-基于ggplot2
- 創(chuàng)建roc對(duì)象
- ggroc繪圖
# Create a basic roc object
data(aSAH)
rocobj <- roc(aSAH$outcome, aSAH$s100b)
rocobj2 <- roc(aSAH$outcome, aSAH$wfns)
繪圖
- 基礎(chǔ)繪圖
library(ggplot2)
g <- ggroc(rocobj)
g
image.png
- 美化參數(shù)設(shè)置
ggroc(rocobj, alpha = 0.5, colour = "red", linetype = 2, size = 2)
image.png
支持gglot2語(yǔ)法的美化
# You can then your own theme, etc.
g + theme_minimal() + ggtitle("My ROC curve") +
geom_segment(aes(x = 1, xend = 0, y = 0, yend = 1), color="grey", linetype="dashed")
image.png
修改橫縱坐標(biāo)
# And change axis labels to FPR/FPR
gl <- ggroc(rocobj, legacy.axes = TRUE)
gl
gl + xlab("FPR") + ylab("TPR") +
geom_segment(aes(x = 0, xend = 1, y = 0, yend = 1), color="darkgrey", linetype="dashed")
image.png
image.png
繪制多條曲線
- ggroc以list格式包裹roc對(duì)象
# Multiple curves:
g2 <- ggroc(list(s100b=rocobj, wfns=rocobj2, ndka=roc(aSAH$outcome, aSAH$ndka)))
g2
image.png
- 也可先構(gòu)建好公式，再繪制
# This is equivalent to using roc.formula:
roc.list <- roc(outcome ~ s100b + ndka + wfns, data = aSAH)
g.list <- ggroc(roc.list)
g.list
image.png
美化修改
- size設(shè)置線條粗細(xì)
- alpha設(shè)置透明度
# with additional aesthetics:
g3 <- ggroc(roc.list, size = 1.2,alpha=.6)
g3+ggsci::scale_color_lancet()
image.png
改變參數(shù)
- aes即按什么屬性進(jìn)行區(qū)分
g4 <- ggroc(roc.list, aes="linetype", color="red")
g4
image.png
按多種屬性區(qū)分ROC曲線
# changing multiple aesthetics:
g5 <- ggroc(roc.list, aes=c("linetype", "color"))
g5
image.png
分面繪制ROC曲線
# OR faceting
g.list + facet_grid(.~name) + theme(legend.position="none")
image.png
所有曲線有相同顏色
- group參數(shù)
# To have all the curves of the same color, use aes="group":
g.group <- ggroc(roc.list, aes="group",color="red")
g.group
g.group + facet_grid(.~name)
image.png
我是白介素2通贞，本期內(nèi)容就到這里划址，下期再見(jiàn)音同。
