R：插入符號 package：布賴爾分數

Question

我想使用caret package 中的train() function 執行邏輯回歸。 我的 model 看起來像這樣：

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

使用生成的 model，我想做出預測：

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

現在，我想評估 model 預測與實際測試數據相比有多好。 為此，我知道如何接收 ROC 和 AUC。 不過，我也有興趣獲得 BRIER SCORE。 Brier 分數的公式幾乎與 MSE 相同。 我面臨的問題是 predict 中的type參數只允許“概率”（或我不感興趣的“類”），它給出了一個預測為 ONE 的概率（例如 0.64），以及補充概率蜜蜂為零（例如 0.37）。 然而，對於 Brier 分數，我需要一個包含兩者信息的預測的概率估計（例如，高於 0.5 的值表示 1，低於 0.5 的值表示 0）。 我還沒有找到在caret package 中接收 Brier 分數的任何解決方案。 我知道使用 package cv.glmnet predict function 允許參數“響應”，這將解決我的問題。 但是，出於個人喜好，我想保留caret package。 謝謝您的幫助！

Answer 1

如果我們 go 按 wiki 定義的 brier 得分：

Brier 評分最常見的公式是

其中 f_t 是預測的概率，o_t 是（0 或 1）的實際結果，N 是預測實例的數量。

在 R 中，如果您的 label 是一個因素，那么邏輯回歸將始終針對第二級進行預測，這意味着您只需計算概率和 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，這是您 label 您的響應“0:1”時的默認值。 然后我創建了這個主摘要 function，基於caret自己的摘要函數套件，以返回我想查看的所有指標：

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 trainControl然后在train調用中傳遞metric = "Brier", maximize = FALSE 。