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

Question

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

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

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

有人能帮忙吗？

编辑好的，让我尝试解释得更好一点。在 5.5.5（备用性能指标）下的 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

我不确定我是否正确理解了你的问题：

要从模型 mdl 接收预测概率，您可以使用 predict(mdl, type = "prob")。即，

library(caret)
#> Loading required package: lattice
#> Loading required package: ggplot2

df <- iris
df$isSetosa <- factor(df$Species == "setosa", levels = c(FALSE, TRUE), labels = c("not-setosa", "is-setosa"))
df$Species <- NULL

mdl <- train(isSetosa ~ ., data = df, method = "glm",
                family = "binomial",
                trControl = trainControl(method = "cv"))

preds <- predict(mdl, newdata = df, type = "prob")
head(preds)
#>     not-setosa is-setosa
#> 1 2.220446e-16         1
#> 2 2.220446e-16         1
#> 3 2.220446e-16         1
#> 4 1.875722e-12         1
#> 5 2.220446e-16         1
#> 6 2.220446e-16         1

^{由 reprex package (v0.3.0)}

于 2020-07-02 创建

也就是说，我们看到案例 4 被预测为 setosa，具有 ~100%（老实说，这个玩具模型好得令人难以置信）...

现在我们可以创建一个自定义函数，将值折叠为单个指标。

true <- df$isSetosa

# very basic model metrics that just sums the absolute differences in true - probability
custom_model_metric <- function(preds, true) {
  d <- data.frame(true = true)
  tt <- predict(dummyVars(~true, d), d)
  colnames(tt) <- c("not-setosa", "is-setosa")
  
  sum(abs(tt - preds))
}

custom_model_metric(preds, true)
#> [1] 3.294029e-09

^{由 reprex package (v0.3.0)}

于 2020-07-02 创建

Answer 2

遗憾的是，我刚刚找到了问题的答案。 caret 文档中有这么一小句话...

"...如果这些参数中的 none 令人满意，用户还可以 计算自定义性能指标 。trainControl 函数有一个名为 summaryFunction 的参数，它指定计算性能的函数。该函数应具有以下参数：

data 是数据框或矩阵的参考，其列称为 obs 和 pred，用于观察和预测结果值（用于回归的数字数据或用于 classification 的字符值）。 目前，class 概率未传递给该函数。 数据中的值是针对单个调整组合的保留预测（及其关联的参考值）。 ."

为了文档：这是写于 2020-07-03 的 caret 包文档来自 2019-03-27。

Answer 3

当您在 trainControl 中指定 classProbs = TRUE 时，Caret 确实支持将 class 概率传递给自定义汇总函数。在这种情况下，创建自定义汇总函数时的 data 参数将有另外两列命名为 classes，其中包含每个 class 的概率。这些 classes 的名称将在 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.

或者使用包含 class 级别的 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

了解更多信息。如果您打算使用插入符号，即使您不是一本好书，也可以阅读这本书。

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

Custom Performance Function in caret Package using predicted Probability

r

r-caret