我编写了代码来计算我在问题中要求的两行,如下图所示(所需行为红色)。
编辑:这是使用我的代码片段生成 ROC 曲线的预期图表(至少我很确定这是正确的):
问题是所说的代码非常非常难看(太长了,甚至不能在这里发布)而且我想出的过程对我来说似乎非常乏味。然而我似乎想不出更好的办法。
这是生成 ROC 曲线输入列表的快速片段
library(MASS)
library(dplyr)
simple_roc <- function(labels, scores){
labels <- labels[order(scores, decreasing=TRUE)]
return(rbind(c(0,0,0),data.frame(TPR=cumsum(labels)/sum(labels), FPR=cumsum(!labels)/sum(!labels), labels)))
}
diab_data=rbind(data.frame(Pima.tr),data.frame(Pima.te))
roc_curves_list_logisitic=list()
for (k in 1:100) {
#Set a fixed seed for reproducibility
set.seed(k)
# sampled_rows <- createDataPartition(diab_data$type, p = .7, list = FALSE)
sampled_rows <- sample(1:nrow(diab_data), size=floor(0.7*nrow(diab_data)))
diab_data_train=diab_data[sampled_rows,]
diab_data_test=diab_data[-sampled_rows,]
diab_data_train[,1:7]=scale(diab_data_train[,1:7])
diab_data_test[,1:7]=scale(diab_data_test[,1:7])
diab_data_train[,"type"]=as.numeric(as.character(recode_factor(diab_data_train[,"type"],`Yes` = "1", `No` = "0")))
diab_data_test[,"type"]=as.numeric(as.character(recode_factor(diab_data_test[,"type"],`Yes` = "1", `No` = "0")))
logistic_model_simple=glm(data=diab_data_train,as.formula(paste(colnames(diab_data_train)[8], "~",
paste(colnames(diab_data_train)[-8], collapse = "+"),
sep = "")),family=binomial(link = "logit"))
roc_curves_list_logisitic[[k]]=simple_roc(diab_data_test[,"type"],
ifelse(predict(logistic_model_simple,diab_data_test,type='response')>0.5,1,0))
}
我现在正在寻求帮助,以防有人使用我作为输入提供的 ROC 曲线列表生成此图中(在 ggplot2 中)中的两条红线的“漂亮”解决方案。
我最好以两个数据帧 lower_bound_roc_curves
和 upper_bound_roc_curves
结束,其中包含必要的值,以便在需要时分别绘制两条线。
提前致谢
编辑 2:@denis 以下是我认为您的代码有误的部分:
最佳答案
我有一个使用 data.table
和 zoo
的解决方案。第一步是在所有曲线之间有一个共同的 FPR。它是能够绘制所有曲线的最大值和最小值。为此:
library(data.table)
library(zoo)
FPRlist <- unique(rbindlist(lapply(roc_curves_list_logisitic,function(ROC){
rccurve <- as.data.table(ROC)
rccurve[,.(FPR = FPR)]
})))
我创建了一个表 FPRlist
,其中包含所有曲线中存在的所有 FPR。在将每条曲线与包含所有 FPR 的表格合并后,我将使用 na.locf 来完成缺失值。
我使用 rbindlist 制作一张表,每条 ROC 曲线都有一个 ID
results <- rbindlist(lapply(seq(roc_curves_list_logisitic),function(idx){
rccurve <- as.data.table(roc_curves_list_logisitic[[idx]])
rccurve <- merge(FPRlist,rccurve,all = T)
rccurve[,TPR := na.locf(TPR,na.rm = F)] # I complete the values
rccurve[,ID := idx] # I create an ID
rccurve
}))
然后我计算每个 FPR 步骤的所有 ID(所有 ROC 曲线)的最大值和最小值
resultmax <- results[,.(TPR = max(TPR)),by = FPR]
resultmin <- results[,.(TPR = min(TPR)),by = FPR]
按照你绘制的方式绘制它
ggplot()+
geom_line(data = results,aes(FPR,TPR,color = as.factor(ID)))+
theme_light() %+replace% theme(legend.position = "none")+
geom_line(data = resultmax,aes(FPR,TPR),color = "red",size = 1)+
geom_line(data = resultmin,aes(FPR,TPR),color = "red",size = 1)
我让dplyr
翻译给dplyr
用户,因为我不习惯。
编辑
我修改了我的绘图,以便与没有任何合并或 na.locf
的所有原始 ROC 曲线的绘图进行比较。可以看到我建议的红线确实遵循所有曲线的最大值和最小值。得到第二个图如下:
results2 <- rbindlist(lapply(seq(roc_curves_list_logisitic),function(idx){
rccurve <- as.data.table(roc_curves_list_logisitic[[idx]])
rccurve[,ID := idx] # I create an ID
rccurve
}))
p2 <- ggplot()+
geom_line(data = results2,aes(FPR,TPR,color = as.factor(ID)))+
theme_light() %+replace% theme(legend.position = "none")
它只是绘制操作系统问题中提供的列表中包含的所有 ROC 曲线。两列图是使用 multiplot
函数获得的(参见 here )
关于r - 查找 ROC 曲线列表的外壳的代码(曲线集的上限和下限),我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/54476752/