R：插入符号包：Brier Score

Question

我想使用 caret 包中的 train() 函数执行逻辑回归。我的模型看起来像这样：

model <- train(Y ~.,
  data = train_data,
  family = "binomial",
  method = "glmnet")

使用生成的模型，我想做出预测：

pred <- predict(model, newdata = test_data, s = "lambda.min", type = "prob")

现在，我想评估模型预测与实际测试数据相比有多好。为此，我知道如何接收 ROC 和 AUC。不过，我也有兴趣获得 BRIER SCORE。 Brier Score 的公式几乎与 MSE 相同。我面临的问题是 predict 中的 type 参数只允许 "prob" （或我不感兴趣的 "class" ），这给出了一个预测成为 ONE 的概率（例如0.64) ，以及成为零的补码概率（例如 0.37）。然而，对于 Brier 分数，我需要为每个包含两者信息的预测提供一个概率估计（例如，高于 0.5 的值表示 1，低于 0.5 的值表示 0）。我还没有找到在 caret 包中接收 Brier Score 的任何解决方案。我知道 cv.glmnet 包中 predict 函数允许参数 "response" 来解决我的问题。但是，出于个人喜好，我想继续使用 caret 软件包。感谢您的帮助！

Answer 1

如果我们按照 brier 分数的 wiki 定义：

Brier 分数最常见的公式是

其中 f_t 是被预测的概率，o_t 是（0 或 1）的实际结果，N 是预测实例的数量。

在 R 中，如果您的标签是一个因素，那么逻辑回归将始终根据第 2 级进行预测，这意味着您只需计算概率和 0/1。例如：

library(caret)
idx = sample(nrow(iris),100)
data = iris
data$Species = factor(ifelse(data$Species=="versicolor","v","o"))
levels(data$Species)
[1] "o" "v"

在这种情况下，o 为 0，v 为 1。

train_data = data[idx,]
test_data = data[-idx,]

model <- train(Species ~.,data = train_data,family = "binomial",method = "glmnet")

pred <- predict(model, newdata = test_data)

所以我们可以看到class的概率：

head(pred)
          o          v
1 0.8367885 0.16321154
2 0.7970508 0.20294924
3 0.6383656 0.36163437
4 0.9510763 0.04892370
5 0.9370721 0.06292789

计算分数：

f_t = pred[,2]
o_t = as.numeric(test_data$Species)-1
mean((f_t - o_t)^2)
[1] 0.32

Answer 2

我使用 Brier 分数在 caret 中调整我的模型以进行二进制 class 化。我确保“肯定”class 是第二个 class，这是您将响应标记为“0:1”时的默认值。然后我根据 caret 自己的汇总函数套件创建了这个主汇总函数，以 return 我想看到的所有指标：

BigSummary <- function (data, lev = NULL, model = NULL) {
  pr_auc <- try(MLmetrics::PRAUC(data[, lev[2]],
                                 ifelse(data$obs == lev[2], 1, 0)),
                silent = TRUE)
  brscore <- try(mean((data[, lev[2]] - ifelse(data$obs == lev[2], 1, 0)) ^ 2),
               silent = TRUE)
  rocObject <- try(pROC::roc(ifelse(data$obs == lev[2], 1, 0), data[, lev[2]],
                             direction = "<", quiet = TRUE), silent = TRUE)
  if (inherits(pr_auc, "try-error")) pr_auc <- NA
  if (inherits(brscore, "try-error")) brscore <- NA
  rocAUC <- if (inherits(rocObject, "try-error")) {
    NA
  } else {
    rocObject$auc
  }
  tmp <- unlist(e1071::classAgreement(table(data$obs,
                                            data$pred)))[c("diag", "kappa")]
  out <- c(Acc = tmp[[1]],
           Kappa = tmp[[2]],
           AUCROC = rocAUC,
           AUCPR = pr_auc,
           Brier = brscore,
           Precision = caret:::precision.default(data = data$pred,
                                                 reference = data$obs,
                                                 relevant = lev[2]),
           Recall = caret:::recall.default(data = data$pred,
                                           reference = data$obs,
                                           relevant = lev[2]),
           F = caret:::F_meas.default(data = data$pred, reference = data$obs,
                                      relevant = lev[2]))
  out
}

现在我可以简单地在 trainControl 中传递 summaryFunction = BigSummary，然后在 train 调用中传递 metric = "Brier", maximize = FALSE。

R：插入符号包：Brier Score

R: Caret package: Brier Score

r

prediction

r-caret