予測されたクラスの割合のベクトルでROCR
パッケージを使用するいくつかのモデルがあり、パフォーマンスオブジェクトがあります。仕様「tpr」、「fpr」でパフォーマンスオブジェクトをプロットすると、ROC曲線が得られます。
偽陽性率(x)の特定のしきい値でモデルを比較しています。パフォーマンスオブジェクトから真の正のレート(y)の値を取得することを望んでいます。さらに、そのポイントを生成するために使用されたクラスのパーセンテージのしきい値を取得したいと思います。
偽陽性率のインデックス番号(x-value
)しきい値を超えずにしきい値に最も近い場合、適切な真陽性率のインデックス番号(y-value
)。そのインデックス値を取得する方法が正確にはわかりません。
さらに重要なことに、そのポイントを作成するために使用されたクラス確率のしきい値を取得するにはどうすればよいですか?
これが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 ...
ああああ!これは S4クラス なので、@
を使用してスロットにアクセスできます。 data.frame
の作成方法は次のとおりです。
cutoffs <- data.frame([email protected][[1]], [email protected][[1]],
[email protected][[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
ヒットする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
パッケージpROC
には、最適なしきい値を計算するための関数coords
が含まれています。
library(pROC)
my_roc <- roc(my_response, my_predictor)
coords(my_roc, "best", ret = "threshold")
ROCR
およびpROC
パッケージに基づく2つのソリューション:
threshold1 <- function(predict, response) {
perf <- ROCR::performance(ROCR::prediction(predict, response), "sens", "spec")
df <- data.frame(cut = [email protected][[1]], sens = [email protected][[1]], spec = [email protected][[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
最適なしきい値を見つけるための多くのアルゴリズムを提供するOptimalCutpoints
パッケージも参照してください。