我已经作出,计算两行我在问题询问,如下面的图像(希望的线是红色)中的代码。
编辑:这是用我的片段生成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))
}
我现在寻求帮助,如果任何人有一个“美丽”的解决方案,以产生该图(在GGPLOT2)利用我作为输入提供的ROC曲线列表中的两条红线。
优选地,我想有两个dataframes lower_bound_roc_curves
和upper_bound_roc_curves
含有必要的值以seperately绘制两条直线,如果我需要他们结束。
提前致谢,
编辑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)]
})))
我创建一个包含所有FPR在所有现有的曲线表FPRlist
。我将合并后用含所有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
}))
然后我计算跨所有ID(所有ROC曲线)的最大值和最小值用于每个FPR步骤
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
情节比较。可以看到,红色的线,我建议做跟随max和所有曲线的分钟。第二幅图中获得如下:
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)中得到