查找ROC曲线列表的外壳的代码（曲线集的上下限）

Question

我已经编写了用于计算问题中要求的两行的代码，如下图所示（所需行为红色）。

编辑：这是使用我的代码片段生成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我认为您的代码有误：

Answer 1

我有一个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个用户。

编辑

我修改了图以与所有原始ROC曲线的图进行比较，而没有任何合并或na.locf。可以看到我建议的红线确实遵循所有曲线的最大值和最小值。获得第二个图，如下所示：

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")

它仅绘制OS问题中提供的列表中包含的所有ROC曲线。两列图是通过multiplot函数获得的（请参见here）