从ROC曲线获得阈值

Fay*_*dey 34 r roc

我有一些模型,ROCR在预测类百分比的向量上使用包,我有一个性能对象.使用规范"tpr"绘制性能对象,"fpr"给出了ROC曲线.

我正在比较假阳性率(x)的某些阈值的模型.我希望从性能对象中获得真正的正率(y)的值.更重要的是,我想获得用于生成该点的类别百分比阈值.

x-value不高于阈值的情况下最接近阈值的误报率()的索引号应该给出适当的真阳性率(y-value)的索引号.我不确定如何获得该索引值.

更重要的是,我如何获得用于表达这一点的类概率的阈值?

Zac*_*ach 62

这就是为什么str我最喜欢的R功能:

library(ROCR)
data(ROCR.simple)
pred <- prediction( ROCR.simple$predictions, ROCR.simple$labels)
perf <- performance(pred,"tpr","fpr")
plot(perf)
> str(perf)
Formal class 'performance' [package "ROCR"] with 6 slots
  ..@ x.name      : chr "False positive rate"
  ..@ y.name      : chr "True positive rate"
  ..@ alpha.name  : chr "Cutoff"
  ..@ x.values    :List of 1
  .. ..$ : num [1:201] 0 0 0 0 0.00935 ...
      ..@ y.values    :List of 1
      .. ..$ : num [1:201] 0 0.0108 0.0215 0.0323 0.0323 ...
  ..@ alpha.values:List of 1
  .. ..$ : num [1:201] Inf 0.991 0.985 0.985 0.983 ...
Run Code Online (Sandbox Code Playgroud)

啊啊!这是一个S4类,所以我们可以@用来访问插槽.以下是你如何制作data.frame:

cutoffs <- data.frame(cut=perf@alpha.values[[1]], fpr=perf@x.values[[1]], 
                      tpr=perf@y.values[[1]])
> head(cutoffs)
        cut         fpr        tpr
1       Inf 0.000000000 0.00000000
2 0.9910964 0.000000000 0.01075269
3 0.9846673 0.000000000 0.02150538
4 0.9845992 0.000000000 0.03225806
5 0.9834944 0.009345794 0.03225806
6 0.9706413 0.009345794 0.04301075
Run Code Online (Sandbox Code Playgroud)

如果您有一个想要命中的fpr阈值,可以将其子集化data.frame以找到低于此fpr阈值的最大tpr:

cutoffs <- cutoffs[order(cutoffs$tpr, decreasing=TRUE),]
> head(subset(cutoffs, fpr < 0.2))
          cut       fpr       tpr
96  0.5014893 0.1495327 0.8494624
97  0.4997881 0.1588785 0.8494624
98  0.4965132 0.1682243 0.8494624
99  0.4925969 0.1775701 0.8494624
100 0.4917356 0.1869159 0.8494624
101 0.4901199 0.1962617 0.8494624
Run Code Online (Sandbox Code Playgroud)

  • 我非常喜欢这个答案中的交互式和迭代式方法. (5认同)
  • 你太棒了.并感谢提及str.如果我将来如此难过,我会用它. (3认同)

Enr*_*ero 11

pROC包括coords计算最佳阈值的功能:

library(pROC)
my_roc <- roc(my_response, my_predictor)
coords(my_roc, "best", ret = "threshold")
Run Code Online (Sandbox Code Playgroud)


Art*_*sov 6

基于ROCRpROC包的2个解决方案:

threshold1 <- function(predict, response) {
    perf <- ROCR::performance(ROCR::prediction(predict, response), "sens", "spec")
    df <- data.frame(cut = perf@alpha.values[[1]], sens = perf@x.values[[1]], spec = perf@y.values[[1]])
    df[which.max(df$sens + df$spec), "cut"]
}
threshold2 <- function(predict, response) {
    r <- pROC::roc(response, predict)
    r$thresholds[which.max(r$sensitivities + r$specificities)]
}
data(ROCR.simple, package = "ROCR")
threshold1(ROCR.simple$predictions, ROCR.simple$labels)
#> [1] 0.5014893
threshold2(ROCR.simple$predictions, ROCR.simple$labels)
#> [1] 0.5006387
Run Code Online (Sandbox Code Playgroud)

另请参阅OptimalCutpointspackage,它提供了许多算法来查找最佳阈值.