我想我是“其中之一”,所以我会插话。
简短版本:恐怕你的例子有点像稻草人,我认为我们不能从中学到很多东西。
在第一种情况下,是的,您可以将预测阈值设置为 0.50 以获得完美的分类。真的。但我们也看到你的模型实际上很差。取垃圾邮件组中的第 127 项,并将其与火腿组中的第 484 项进行比较。他们预测成为垃圾邮件的概率为 0.49 和 0.51。(那是因为我选择了垃圾邮件中最大的预测和火腿组中的最小预测。)
也就是说,对于该模型,它们在成为垃圾邮件的可能性方面几乎无法区分。但他们不是!我们知道第一个肯定是垃圾邮件,第二个肯定是火腿。“几乎可以肯定”,如“我们观察了 1000 个实例,并且截止总是有效”。说这两个实例实际上同样可能是垃圾邮件,这清楚地表明我们的模型并不真正知道它在做什么。
因此,在目前的情况下,对话不应该是我们应该使用模型 1 还是使用模型 2,或者我们是否应该根据准确性或 Brier 分数在两个模型之间做出决定。相反,我们应该将两个模型的预测都提供给任何标准的第三种模型,例如标准逻辑回归。这会将模型 1 的预测转换为非常自信的预测,本质上是 0 和 1,从而更好地反映数据中的结构。这个布赖尔分数元模型会低得多,大约为零。同样,来自模型 2 的预测将被转换为几乎一样好但稍差的预测 - Brier 分数略高一些。现在,两个元模型的 Brier 分数将正确地反映应该首选基于(元)模型 1 的模型。
当然,最终决定可能需要使用某种阈值。根据类型 I 和 II 错误的成本,成本最优阈值可能与 0.5 不同(当然,在本示例中除外)。毕竟,正如您所写,将火腿误分类为垃圾邮件可能比反之亦然的代价高得多。但正如我在别处写的,成本最优决策也可能包括多个阈值!很有可能,一个非常低的预测垃圾邮件概率可能会将邮件直接发送到您的收件箱,而一个非常高的预测概率可能会在您从未看到它的情况下在邮件服务器上过滤它 - 但介于两者之间的概率可能意味着 [SUSPECTED SPAM ] 可能会插入主题中,邮件仍会发送到您的收件箱。准确性作为评估措施在这里失败,除非我们开始查看多个存储桶的单独准确性,但最终,所有“中间”邮件将被归类为一个或另一个,它们不应该被发送到首先正确的桶?另一方面,适当的评分规则可以帮助您校准概率预测。
老实说,我不认为像你在这里给出的那样的确定性例子很有用。如果我们知道发生了什么,那么我们一开始就不会进行概率分类/预测,毕竟。所以我会争论概率的例子。这是一个这样的。我将生成 1,000 个真实的潜在概率,这些概率均匀分布在[0,1],然后根据这个概率生成实际值。现在我们没有完美的分离,我认为上面的例子模糊了。
set.seed(2020)
nn <- 1000
true_probabilities <- runif(nn)
actuals <- runif(nn)<true_probabilities
library(beanplot)
beanplot(true_probabilities~actuals,
horizontal=TRUE,what=c(0,1,0,0),border=NA,col="lightgray",las=1,
xlab="True probability")
points(true_probabilities,actuals+1+runif(nn,-0.3,0.3),pch=19,cex=0.6)
现在,如果我们有真实的概率,我们可以使用上述基于成本的阈值。但通常情况下,我们不会知道这些真实概率,但我们可能需要在每个输出此类概率的竞争模型之间做出决定。我认为寻找一个尽可能接近这些真实概率的模型是值得的,因为例如,如果我们对真实概率有偏见的理解,那么我们在改变过程中投入的任何资源(例如,在医学应用:筛查、接种、传播生活方式的改变……)或更好地理解它可能会被错误分配。换句话说:使用准确性和阈值意味着我们根本不在乎我们是否预测概率p^1或者p^2只要超过阈值,p^i>t(反之亦然t),所以我们在理解和调查我们不确定的实例方面的动机为零,只要我们让它们到达阈值的正确一侧。
让我们看几个校准错误的预测概率。具体来说,对于真实概率p,我们可以看一下幂变换p^x:=px对于某个指数。这是一个单调变换,所以我们想基于使用的任何阈值也可以被变换以用于。或者,从开始并且不知道,我们可以优化阈值以获得与和,因为单调性。的真实概率时,准确性毫无用处x>0pp^xp^xpt^x(p^x,t^x)(p^y,t^y)x=1!但是(鼓声),正确的评分规则(如 Brier 或日志评分)确实会在正确的的预期中得到优化。x=1
brier_score <- function(probs,actuals) mean(c((1-probs)[actuals]^2,probs[!actuals]^2))
log_score <- function(probs,actuals) mean(c(-log(probs[actuals]),-log((1-probs)[!actuals])))
exponents <- 10^seq(-1,1,by=0.1)
brier_scores <- log_scores <- rep(NA,length(exponents))
for ( ii in seq_along(exponents) ) {
brier_scores[ii] <- brier_score(true_probabilities^exponents[ii],actuals)
log_scores[ii] <- log_score(true_probabilities^exponents[ii],actuals)
}
plot(exponents,brier_scores,log="x",type="o",xlab="Exponent",main="Brier score",ylab="")
plot(exponents,log_scores,log="x",type="o",xlab="Exponent",main="Log score",ylab="")