ROCR 不绘制标准误差

ROCR does not plot standard errors

我正在尝试使用 ROCR 包绘制具有标准差的 ROC 曲线。

我正在使用 quality.csv 文件作为可重现示例,可在此处找到 -- https://courses.edx.org/courses/course-v1:MITx+15.071x_3+1T2016/courseware/5893e4c5afb74898b8e7d9773e918208/030bf0a7275744f4a3f6f74b95169c04/

我的代码如下:

data <- fread("quality.csv")
glimpse(data)
set.seed(88)
split <- sample.split(data$PoorCare, SplitRatio = 0.75)
data_train <- data[split, ]
data_test <- data[!split, ]

#--------------------------------------------------------------------------
# FITTING A MODEL
#--------------------------------------------------------------------------
model <- glm(PoorCare ~ OfficeVisits + Narcotics , data_train, family = "binomial")

#--------------------------------------------------------------------------
# MAKE PREDICTIONS ON THE TEST DATASET
#--------------------------------------------------------------------------
predict_Test <- predict(model, type = "response", newdata = data_test)

#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
# THE ROCR PACKAGE
#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

###########################################################################
# CREATE A PERFORMANCE OBJECT
###########################################################################
prediction_obj <- prediction(predict_Test, data_test$PoorCare)

#==========================================================================
# CALCULATE AUC
#==========================================================================
auc = as.numeric(performance(prediction_obj , "auc")@y.values)
# 0.7994792

#==========================================================================
# PLOT ROC CURVE WITH ERROR ESTIMATES
#==========================================================================
plot(perf, colorize=T, avg='threshold', spread.estimate='stddev', spread.scale = 2)

我得到的是 ROC 曲线,但没有标准误差:

你能指出我的代码有什么问题以及如何更正它吗?

我们将不胜感激您的建议。

如果执行了多次重复(交叉验证或bootstrap)预测,则可以绘制 ROC 曲线的标准偏差和 CI。
例如,考虑在训练和测试集中使用 glm 估计和预测对数据进行 100 次重复拆分:

library(dplyr)
library(data.table)
library(caTools)
library(ROCR)
data <- fread("quality.csv")
glimpse(data)

set.seed(1)
reps <- 100
predTests <- vector(mode="list", reps)
Labels <- vector(mode="list", reps)
for (k in 1:reps) {
        splitk <- sample.split(data$PoorCare, SplitRatio = 0.75)
        data_traink <- data[splitk, ]
        data_testk <- data[!splitk, ]
        model <- glm(PoorCare ~ OfficeVisits + Narcotics , 
                 data_traink, family = "binomial")
        predTests[[k]] <- predict(model, type = "response", newdata = data_testk)
        Labels[[k]] <-  data_testk$PoorCare
}

现在使用 predTestsLabels 列表计算 predictionperformance 对象:

predObjs <- prediction(predTests, Labels)
Perfs <- performance(predObjs , "tpr", "fpr")

并用平均值和置信区间绘制一组 ROC 曲线:

plot(Perfs, col="grey82", lty=3)
plot(Perfs, lwd=3, avg="threshold", spread.estimate="stddev", add=TRUE, colorize=TRUE)