r - 插入符号包中使用预测概率的自定义性能函数

Question

This SO post是关于在 caret 包中使用自定义性能测量功能。您想找到最佳预测模型，因此您构建了多个模型并通过计算从比较观察值和预测值中得出的单个指标来比较它们。有默认函数来计算这个指标，但您也可以定义自己的指标函数。此自定义函数必须以 obs 和预测值作为输入。

在分类问题(假设只有两个类)中，预测值为 0 或 1。但是，我需要评估的也是模型中计算的概率。有什么方法可以实现吗？

原因是在某些应用程序中，您需要知道 1 预测实际上是 99% 的概率还是 51% 的概率 - 而不仅仅是预测是 1 还是 0。

谁能帮忙？

---

编辑好的，所以让我试着解释得更好一点。在 5.5.5 (Alternate Performance Metrics) 下的 caret 包的文档中，有描述如何使用您自己的自定义性能函数，如下所示

fitControl <- trainControl(method = "repeatedcv",
                           number = 10,
                           repeats = 10,
                           ## Estimate class probabilities
                           classProbs = TRUE,
                           ## Evaluate performance using 
                           ## the following function
                           summaryFunction = twoClassSummary)

twoClassSummary 是本示例中的自定义性能函数。此处提供的函数需要将带有 obs 和 pred 的数据帧或矩阵作为输入。这就是重点 - 我想使用一个函数，它不需要观察和预测，而是观察和预测probability。

---

还有一件事:

也欢迎来自其他软件包的解决方案。我唯一不想要的是“这就是你编写自己的交叉验证函数的方式。”

Answer 1

当您在 trainControl 中指定 classProbs = TRUE 时，Caret 确实支持将类概率传递给自定义汇总函数。在这种情况下，创建自定义汇总函数时的 data 参数将有另外两列命名为包含每个类概率的类。这些类的名称将在 lev 参数中，该参数是长度为 2 的向量。

查看示例:

library(caret)
library(mlbench)
data(Sonar)

自定义汇总LogLoss:

LogLoss <- function (data, lev = NULL, model = NULL){ 
  obs <- data[, "obs"] #truth
  cls <- levels(obs) #find class names
  probs <- data[, cls[2]] #use second class name to extract probs for 2nd clas
  probs <- pmax(pmin(as.numeric(probs), 1 - 1e-15), 1e-15) #bound probability, this line and bellow is just logloss calculation, irrelevant for your question 
  logPreds <- log(probs)        
  log1Preds <- log(1 - probs)
  real <- (as.numeric(data$obs) - 1)
  out <- c(mean(real * logPreds + (1 - real) * log1Preds)) * -1
  names(out) <- c("LogLoss") #important since this is specified in call to train. Output can be a named vector of multiple values. 
  out
}

fitControl <- trainControl(method = "cv",
                           number = 5,
                           classProbs = TRUE,
                           summaryFunction = LogLoss)


fit <-  train(Class ~.,
             data = Sonar,
             method = "rpart", 
             metric = "LogLoss" ,
             tuneLength = 5,
             trControl = fitControl,
             maximize = FALSE) #important, depending on calculated performance measure

fit
#output
CART 

208 samples
 60 predictor
  2 classes: 'M', 'R' 

No pre-processing
Resampling: Cross-Validated (5 fold) 
Summary of sample sizes: 166, 166, 166, 167, 167 
Resampling results across tuning parameters:

  cp          LogLoss  
  0.00000000  1.1220902
  0.01030928  1.1220902
  0.05154639  1.1017268
  0.06701031  1.0694052
  0.48453608  0.6405134

LogLoss was used to select the optimal model using the smallest value.
The final value used for the model was cp = 0.4845361.

或者使用包含类级别的 lev 参数并定义一些错误检查

LogLoss <- function (data, lev = NULL, model = NULL){ 
 if (length(lev) > 2) {
        stop(paste("Your outcome has", length(lev), "levels. The LogLoss() function isn't appropriate."))
    }
  obs <- data[, "obs"] #truth
  probs <- data[, lev[2]] #use second class name
  probs <- pmax(pmin(as.numeric(probs), 1 - 1e-15), 1e-15) #bound probability
  logPreds <- log(probs)        
  log1Preds <- log(1 - probs)
  real <- (as.numeric(data$obs) - 1)
  out <- c(mean(real * logPreds + (1 - real) * log1Preds)) * -1
  names(out) <- c("LogLoss")
  out
}

查看插入符号书的这一部分:https://topepo.github.io/caret/model-training-and-tuning.html#metrics

了解更多信息。如果您打算使用插入符号，即使您不擅长阅读，也值得一读。