多个时间点的ROC曲线如何画?ggplot方案在这里

这是暑期上海培训课程的补丁,用ggplot2来定制ROC曲线
使用的数据储存在rt这个数据框中

1
2
3
4
5
6
7
8
> head(rt)
futime fustat riskScore risk order num
1 7.1561644 0 -0.7054783 low TCGA-BH-A0BS 1
2 5.2575342 0 -0.6712008 low TCGA-BH-A0AZ 2
3 5.1561644 0 -0.6020396 low TCGA-AO-A1KQ 3
4 0.5890411 0 -0.5878228 low TCGA-B6-A400 4
5 1.2246575 0 -0.5246598 low TCGA-A7-A425 5
6 7.2465753 0 -0.5006755 low TCGA-PE-A5DE 6

实际上我们要用的是前三列,第三列是lasso回归构建的生存模型预测的风险值
计算方法在暑期课程的甲基化部分,也可以看一下这个帖子:
TCGA数据库构建生存预测模型之lasso回归

本次使用“survivalROC”这个包来计算AUC
首先定义一个函数,这个函数可以计算任意时间的ROC

1
2
3
4
survivalROC_helper <- function(t) {
survivalROC(Stime=rt$futime, status=rt$fustat, marker = rt$riskScore,
predict.time =t, method="KM")
}

接着计算不同时间的ROC,这里选择的是1,3,5年

1
2
3
4
5
6
7
8
9
10
11
12
13
library(tidyverse)
library(survivalROC)
survivalROC_data <- data_frame(t = c(1,3,5)) %>%
mutate(survivalROC = map(t, survivalROC_helper),
## Extract scalar AUC
auc = map_dbl(survivalROC, magrittr::extract2, "AUC"),
## Put cut off dependent values in a data_frame
df_survivalROC = map(survivalROC, function(obj) {
as_data_frame(obj[c("cut.values","TP","FP")])
})) %>%
dplyr::select(-survivalROC) %>%
unnest() %>%
arrange(t, FP, TP)

如果需要把三个时间点绘制在一张图上,可以这样做

1
2
3
4
5
6
7
8
9
10
11
survivalROC_data1 <- survivalROC_data %>%
mutate(auc =sprintf("%.3f",auc))%>%
unite(year, t,auc,sep = " year AUC: ")
AUC =factor(survivalROC_data1$year)
survivalROC_data1 %>%
ggplot(mapping = aes(x = FP, y = TP)) +
geom_path(aes(color= AUC))+
geom_abline(intercept = 0, slope = 1, linetype = "dashed")+
theme_bw() +
theme(legend.position = c(0.8,0.2))

最终的图形是这个样子的,出图很快,
mark
用到了一个小技巧,就是先改变lengend的样子,再把lengend放在图片中。

另外一种方法可以通过ggplot2的分面,把画出三张图

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
survivalROC_data1 <- survivalROC_data %>%
mutate(auc =sprintf("%.3f",auc))%>%
unite(year, t,auc,sep = " year AUC: ")
year =factor(survivalROC_data1$year)
survivalROC_data1 %>%
ggplot(mapping = aes(x = FP, y = TP)) +
geom_path(aes(color= year))+
geom_abline(intercept = 0, slope = 1, linetype = "dashed")+
facet_wrap( ~ year) +
theme_bw() +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5),
legend.key = element_blank(),
plot.title = element_text(hjust = 0.5),
strip.background = element_blank(),
legend.position = "none")

mark
每次画图的时候都会作一点数据预处理,让ggplot2能够接受,他舒服,我们也舒服。

那个label也可以改变一下位置, 喜欢哪一种,自己选择。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
year =factor(survivalROC_data$t)
survivalROC_data %>%
ggplot(mapping = aes(x = FP, y = TP)) +
geom_path(aes(color= year))+
geom_label(data = survivalROC_data %>% dplyr::select(t,auc) %>% unique,
mapping = aes(label = paste0("AUC:",sprintf("%.3f",auc))), x = 0.75, y = 0.25) +
geom_abline(intercept = 0, slope = 1, linetype = "dashed")+
facet_wrap( ~ t) +
theme_bw() +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5),
legend.key = element_blank(),
plot.title = element_text(hjust = 0.5),
strip.background = element_blank(),
legend.position = "none")

mark

------ 本文结束------