38. ROC曲线图绘制
清除当前环境中的变量
rm(list=ls())
设置工作目录
setwd("C:/Users/Dell/Desktop/R_Plots/38roc/")
使用ROCR包绘制ROC曲线
# 安装并加载所需的R包
#install.packages("ROCR")
library(ROCR)
## Warning: package 'ROCR' was built under R version 3.6.1
## Loading required package: gplots
##
## Attaching package: 'gplots'
## The following object is masked from 'package:stats':
##
## lowess
# 查看内置示例数据
data(ROCR.simple)
head(ROCR.simple)
## $predictions
## [1] 0.612547843 0.364270971 0.432136142 0.140291078 0.384895941
## [6] 0.244415489 0.970641299 0.890172812 0.781781371 0.868751832
## [11] 0.716680598 0.360168796 0.547983407 0.385240464 0.423739359
## [16] 0.101699993 0.628095575 0.744769966 0.657732644 0.490119891
## [21] 0.072369921 0.172741714 0.105722115 0.890078186 0.945548941
## [26] 0.984667270 0.360180429 0.448687336 0.014823599 0.543533783
## [31] 0.292368449 0.701561487 0.715459280 0.714985914 0.120604738
## [36] 0.319672178 0.911723615 0.757325590 0.090988280 0.529402244
## [41] 0.257402979 0.589909284 0.708412104 0.326672910 0.086546283
## [46] 0.879459891 0.362693564 0.230157183 0.779771989 0.876086217
## [51] 0.353281048 0.212014560 0.703293499 0.689075677 0.627012496
## [56] 0.240911145 0.402801992 0.134794140 0.120473353 0.665444679
## [61] 0.536339509 0.623494622 0.885179651 0.353777439 0.408939895
## [66] 0.265686095 0.932159806 0.248500489 0.858876675 0.491735594
## [71] 0.151350957 0.694457482 0.496513160 0.123504905 0.499788081
## [76] 0.310718619 0.907651100 0.340078180 0.195097957 0.371936985
## [81] 0.517308606 0.419560072 0.865639036 0.018527600 0.539086009
## [86] 0.005422562 0.772728821 0.703885141 0.348213542 0.277656869
## [91] 0.458674210 0.059045866 0.133257805 0.083685883 0.531958184
## [96] 0.429650397 0.717845453 0.537091350 0.212404891 0.930846938
## [101] 0.083048377 0.468610247 0.393378108 0.663367560 0.349540913
## [106] 0.194398425 0.844415442 0.959417835 0.211378771 0.943432189
## [111] 0.598162949 0.834803976 0.576836208 0.380396459 0.161874325
## [116] 0.912325837 0.642933593 0.392173971 0.122284044 0.586857799
## [121] 0.180631658 0.085993218 0.700501359 0.060413627 0.531464015
## [126] 0.084254795 0.448484671 0.938583020 0.531006532 0.785213140
## [131] 0.905121019 0.748438143 0.605235403 0.842974300 0.835981859
## [136] 0.364288579 0.492596896 0.488179708 0.259278968 0.991096434
## [141] 0.757364019 0.288258273 0.773336236 0.040906997 0.110241034
## [146] 0.760726142 0.984599159 0.253271061 0.697235328 0.620501132
## [151] 0.814586047 0.300973098 0.378092079 0.016694412 0.698826511
## [156] 0.658692553 0.470206008 0.501489336 0.239143340 0.050999138
## [161] 0.088450984 0.107031842 0.746588080 0.480100183 0.336592126
## [166] 0.579511087 0.118555284 0.233160827 0.461150807 0.370549294
## [171] 0.770178504 0.537336015 0.463227453 0.790240205 0.883431431
## [176] 0.745110673 0.007746305 0.012653524 0.868331219 0.439399995
## [181] 0.540221346 0.567043171 0.035815400 0.806543942 0.248707470
## [186] 0.696702150 0.081439129 0.336315317 0.126480399 0.636728451
## [191] 0.030235062 0.268138293 0.983494405 0.728536415 0.739554341
## [196] 0.522384507 0.858970526 0.383807972 0.606960209 0.138387070
##
## $labels
## [1] 1 1 0 0 0 1 1 1 1 0 1 0 1 0 0 0 1 1 1 0 0 0 0 1 0 1 0 0 1 1 0 1 1 1 0
## [36] 0 1 1 0 1 0 1 0 1 0 1 0 1 0 1 1 0 1 0 1 0 0 0 0 1 1 1 1 0 0 0 1 0 1 0
## [71] 0 1 0 0 0 0 0 0 0 0 1 0 1 0 0 1 1 0 0 1 0 0 1 0 1 0 1 1 0 1 0 0 0 1 0
## [106] 0 1 0 0 1 1 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0 0 1 1 1 1 1 0 1 1 0 0 0 0 1
## [141] 1 0 1 0 1 0 1 1 1 1 1 0 0 0 1 1 0 1 0 0 0 0 1 0 0 1 0 0 0 0 1 1 0 1 1
## [176] 1 0 1 1 0 1 1 0 1 0 0 0 1 0 0 0 1 0 1 1 0 1 0 1 0
#使用prediction()函数构建prediction对象
pred <- prediction(predictions = ROCR.simple$predictions,
labels = ROCR.simple$labels);
pred
# 不同评估值的计算方法
#ROC curves:
# measure="tpr", x.measure="fpr".
#
#Precision/recall graphs:
# measure="prec", x.measure="rec".
#
#Sensitivity/specificity plots:
# measure="sens", x.measure="spec".
#
#Lift charts:
# measure="lift", x.measure="rpp".
# 计算ROC值并绘制ROC曲线
## computing a simple ROC curve (x-axis: fpr, y-axis: tpr)
perf <- performance(prediction.obj = pred,
measure = "tpr",
x.measure = "fpr")
perf
plot(perf,colorize=TRUE,
main="ROCR fingerpainting toolkit",
xlab="Mary's axis", ylab="",
box.lty=7, box.lwd=2, box.col="gray")
image.png
## 计算曲线下的面积即AUC值
auc<- performance(pred,"auc")
auc
## An object of class "performance"
## Slot "x.name":
## [1] "None"
##
## Slot "y.name":
## [1] "Area under the ROC curve"
##
## Slot "alpha.name":
## [1] "none"
##
## Slot "x.values":
## list()
##
## Slot "y.values":
## [[1]]
## [1] 0.8341875
##
##
## Slot "alpha.values":
## list()
auc_area<-slot(auc,"y.values")[[1]]
# 保留4位小数
auc_area<-round(auc_area,4)
#添加文本注释
text_auc<-paste("AUC=", auc_area,sep="")
text(0.25,0.9,text_auc)
image.png
## precision/recall curve (x-axis: recall, y-axis: precision)
perf1 <- performance(pred, "prec", "rec")
plot(perf1,colorize=T)
image.png
## sensitivity/specificity curve (x-axis: specificity, y-axis: sensitivity)
perf1 <- performance(pred, "sens", "spec")
plot(perf1,colorize=T)
image.png
使用pROC包绘制ROC曲线图
#安装并加载所需的R包
#install.packages("pROC")
library(pROC)
## Warning: package 'pROC' was built under R version 3.6.3
## Type 'citation("pROC")' for a citation.
##
## Attaching package: 'pROC'
## The following objects are masked from 'package:stats':
##
## cov, smooth, var
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 3.6.3
# 查看内置数据集
data("aSAH")
head(aSAH)
## gos6 outcome gender age wfns s100b ndka
## 29 5 Good Female 42 1 0.13 3.01
## 30 5 Good Female 37 1 0.14 8.54
## 31 5 Good Female 42 1 0.10 8.09
## 32 5 Good Female 27 1 0.04 10.42
## 33 1 Poor Female 42 3 0.13 17.40
## 34 1 Poor Male 48 2 0.10 12.75
# 使用roc()函数计算ROC值并绘制ROC曲线
#roc(aSAH$outcome ~ aSAH$s100b)
roc.s100b <- roc(outcome ~ s100b, aSAH, levels=c("Good", "Poor"))
## Setting direction: controls < cases
roc.s100b
##
## Call:
## roc.formula(formula = outcome ~ s100b, data = aSAH, levels = c("Good", "Poor"))
##
## Data: s100b in 72 controls (outcome Good) < 41 cases (outcome Poor).
## Area under the curve: 0.7314
# 绘制基础ROC曲线
plot(roc.s100b)
image.png
# 添加平滑ROC曲线
# Add a smoothed ROC:
plot(smooth(roc.s100b), add=TRUE, col="blue")
# 添加图例
legend("topright", legend=c("Empirical", "Smoothed"),
col=c(par("fg"), "blue"), lwd=2)
image.png
# 添加一些参数美化ROC曲线
plot(roc.s100b,
print.auc=TRUE, #设置是否添加AUC值标签
auc.polygon=TRUE, #设置是否添加AUC值面积多边形
max.auc.polygon=TRUE, #设置是否添加最大AUC值面积多边形
auc.polygon.col="skyblue", #设置AUC值面积多边形的填充色
grid=c(0.1, 0.2), #添加网格线
grid.col=c("green", "red"), #设置网格线颜色
print.thres=TRUE)
image.png
# To plot a different partial AUC, we need to ignore the existing value
# with reuse.auc=FALSE:
plot(roc.s100b, print.auc=TRUE, auc.polygon=TRUE,
partial.auc=c(1, 0.8), # 计算选定范围的AUC值
partial.auc.focus="sp", # 高亮关注选定范围的AUC值
grid=c(0.1, 0.2), grid.col=c("green", "red"),
max.auc.polygon=TRUE, auc.polygon.col="lightblue",
print.thres=TRUE, print.thres.adj = c(1, -1),
reuse.auc=FALSE)
image.png
roc.wfns <- roc(aSAH$outcome, aSAH$wfns)
## Setting levels: control = Good, case = Poor
## Setting direction: controls < cases
roc.ndka <- roc(aSAH$outcome, aSAH$ndka)
## Setting levels: control = Good, case = Poor
## Setting direction: controls < cases
# Add a second ROC curve to the previous plot:
plot(roc.s100b, col="red")
plot(roc.wfns, col="blue", add=TRUE)
plot(roc.ndka, col="green", add=TRUE)
image.png
# 使用ggcor()函数绘制基于ggplot2的ROC曲线
ggroc(roc.s100b,
alpha = 0.5, colour = "red",
linetype = 2, size = 2) +
theme_minimal() +
ggtitle("My ROC curve") +
geom_segment(aes(x = 1, xend = 0, y = 0, yend = 1),
color="grey", linetype="dashed")
image.png
# 绘制多条ROC曲线
# Multiple curves:
ggroc(list(s100b=roc.s100b, wfns=roc.wfns, ndka=roc.ndka))
image.png
# This is equivalent to using roc.formula:
roc.list <- roc(outcome ~ s100b + ndka + wfns, data = aSAH)
## Setting levels: control = Good, case = Poor
## Setting direction: controls < cases
## Setting levels: control = Good, case = Poor
## Setting direction: controls < cases
## Setting levels: control = Good, case = Poor
## Setting direction: controls < cases
g.list <- ggroc(roc.list, aes=c("linetype", "color"))
g.list
image.png
# 分面展示
# OR faceting
g.list + facet_grid(.~name) +
theme_bw()
image.png
使用survivalROC包绘制时间依赖的ROC曲线
# 安装并加载所需的R包
#install.packages("survivalROC")
library(survivalROC)
# 查看内置数据集
data(mayo)
head(mayo)
## time censor mayoscore5 mayoscore4
## 1 41 1 11.251850 10.629450
## 2 179 1 10.136070 10.185220
## 3 334 1 10.095740 9.422995
## 4 400 1 10.189150 9.567799
## 5 130 1 9.770148 9.039419
## 6 223 1 9.226429 9.033388
# 计算数据的行数
nobs <- NROW(mayo)
nobs
## [1] 312
# 自定义阈值
cutoff <- 365
# 使用MAYOSCORE 4作为marker, 并用NNE（Nearest Neighbor Estimation）法计算ROC值
Mayo4.1 = survivalROC(Stime=mayo$time,
status=mayo$censor,
marker = mayo$mayoscore4,
predict.time = cutoff,
span = 0.25*nobs^(-0.20) )
Mayo4.1
# 绘制ROC曲线
plot(Mayo4.1$FP, Mayo4.1$TP, type="l",
xlim=c(0,1), ylim=c(0,1), col="red",
xlab=paste( "FP", "\n", "AUC = ",round(Mayo4.1$AUC,3)),
ylab="TP",main="Mayoscore 4, Method = NNE \n Year = 1")
# 添加对角线
abline(0,1)
image.png
# 使用KM（Kaplan-Meier）法计算ROC值
## MAYOSCORE 4, METHOD = KM
Mayo4.2= survivalROC(Stime=mayo$time,
status=mayo$censor,
marker = mayo$mayoscore4,
predict.time = cutoff, method="KM")
Mayo4.2
plot(Mayo4.2$FP, Mayo4.2$TP, type="l",
xlim=c(0,1), ylim=c(0,1), col="blue",
xlab=paste( "FP", "\n", "AUC = ",round(Mayo4.2$AUC,3)),
ylab="TP",main="Mayoscore 4, Method = KM \n Year = 1")
abline(0,1,lty=2,col="gray")
image.png
# 将两种方法的结果绘制到同一个图里
## 绘制NNE法计算的ROC曲线
plot(Mayo4.1$FP, Mayo4.1$TP,
type="l",col="red",
xlim=c(0,1), ylim=c(0,1),
xlab="FP",
ylab="TP",
main="Time dependent ROC")
# 添加对角线
abline(0,1,col="gray",lty=2)
## 添加KM法计算的ROC曲线
lines(Mayo4.2$FP, Mayo4.2$TP,
type="l",col="blue",
xlim=c(0,1), ylim=c(0,1))
# 添加图例
legend("bottomright",legend = c(paste("AUC of NNE =",round(Mayo4.1$AUC,3)),
paste("AUC of KM =",round(Mayo4.2$AUC,3))),
col=c("red","blue"),
lty= 1 ,lwd= 2)
image.png
sessionInfo()
## R version 3.6.0 (2019-04-26)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 18363)
##
## Matrix products: default
##
## locale:
## [1] LC_COLLATE=Chinese (Simplified)_China.936
## [2] LC_CTYPE=Chinese (Simplified)_China.936
## [3] LC_MONETARY=Chinese (Simplified)_China.936
## [4] LC_NUMERIC=C
## [5] LC_TIME=Chinese (Simplified)_China.936
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] survivalROC_1.0.3 ggplot2_3.3.2 pROC_1.16.2 ROCR_1.0-7
## [5] gplots_3.0.1.1
##
## loaded via a namespace (and not attached):
## [1] Rcpp_1.0.5 compiler_3.6.0 pillar_1.4.2
## [4] plyr_1.8.4 bitops_1.0-6 tools_3.6.0
## [7] digest_0.6.20 evaluate_0.14 tibble_2.1.3
## [10] lifecycle_0.2.0 gtable_0.3.0 pkgconfig_2.0.2
## [13] rlang_0.4.7 yaml_2.2.0 xfun_0.8
## [16] withr_2.1.2 stringr_1.4.0 dplyr_1.0.2
## [19] knitr_1.23 generics_0.0.2 vctrs_0.3.2
## [22] gtools_3.8.1 caTools_1.17.1.2 grid_3.6.0
## [25] tidyselect_1.1.0 glue_1.4.2 R6_2.4.0
## [28] rmarkdown_1.13 gdata_2.18.0 purrr_0.3.2
## [31] magrittr_1.5 scales_1.0.0 htmltools_0.3.6
## [34] colorspace_1.4-1 labeling_0.3 KernSmooth_2.23-15
## [37] stringi_1.4.3 munsell_0.5.0 crayon_1.3.4
