第100+42步 ChatGPT学习：R语言实现阈值调整

今天来说个机器学习分类的概念，阈值。

一、何为阈值

这个阈值（Threshold）在二分类问题中起到了关键作用，它决定了模型预测结果的分类边界。在二分类问题中，模型通常会输出一个概率值（介于 0 和 1 之间），表示样本属于某一类（通常为正类）的可能性。阈值的作用是将这个概率值转换为具体的分类结果（0 或 1）。如果预测概率 **大于阈值**，则分类为正类（1）。如果预测概率 **小于或等于阈值**，则分类为负类（0）。

通过调整阈值，可以控制模型对正类和负类的敏感度：

（1）降低阈值：模型会更倾向于将样本分类为正类，从而提高灵敏度（Sensitivity），但可能会增加假阳性（False Positives）。

（2）提高阈值：模型会更倾向于将样本分类为负类，从而提高精确率（Precision），但可能会增加假阴性（False Negatives）。

在大多数二分类模型中，默认的阈值是 **0.5**。这意味着：

（1）如果预测概率 > 0.5，分类为正类（1）。

（2）如果预测概率 ≤ 0.5，分类为负类（0）。

二、 为什么需要调整阈值？

（1）数据不平衡：当数据集中正负样本比例严重不平衡时，默认的阈值可能不适用。例如，在欺诈检测中，欺诈样本（正类）可能非常少，此时可能需要降低阈值以提高对正类的识别能力。

（2）业务需求：不同的业务场景对分类结果的敏感度要求不同。例如：在医疗诊断中，可能更关注灵敏度（尽量减少漏诊），因此可以降低阈值。在垃圾邮件过滤中，可能更关注精确率*尽量减少误判），因此可以提高阈值。

三、 阈值与模型评估

调整阈值会影响模型的性能指标，如：

（1）混淆矩阵：阈值的变化会直接影响分类结果，从而改变混淆矩阵中的真阳性（TP）、假阳性（FP）、真阴性（TN）、假阴性（FN）。

（2）ROC 曲线：ROC 曲线是通过不同阈值下的真阳性率（TPR）和假阳性率（FPR）绘制的，阈值的变化会决定 ROC 曲线上的具体点。

（3）精确率-召回率曲线：阈值的变化也会影响精确率和召回率的平衡。

四、R语言代码，以Xgboost为例：

# Load necessary libraries
library(caret)
library(pROC)
library(ggplot2)
library(xgboost)

# Assume 'data' is your dataframe containing the data
# Set seed to ensure reproducibility
set.seed(123)

# Define a custom threshold
custom_threshold <- 0.5  # You can change this value to any threshold you want

# Split data into training and validation sets (80% training, 20% validation)
trainIndex <- createDataPartition(data$X, p = 0.8, list = FALSE)
trainData <- data[trainIndex, ]
validData <- data[-trainIndex, ]

# Prepare matrices for XGBoost
dtrain <- xgb.DMatrix(data = as.matrix(trainData[, -which(names(trainData) == "X")]), label = trainData$X)
dvalid <- xgb.DMatrix(data = as.matrix(validData[, -which(names(validData) == "X")]), label = validData$X)

# Define parameters for XGBoost
params <- list(booster = "gbtree", 
               objective = "binary:logistic", 
               eta = 0.1, 
               gamma = 0, 
               max_depth = 6, 
               min_child_weight = 1, 
               subsample = 0.5, 
               colsample_bytree = 0.9,
               lambda = 10,
               alpha = 5)

# Train the XGBoost model
model <- xgb.train(params = params, data = dtrain, nrounds = 250, watchlist = list(eval = dtrain), verbose = 1)

# Predict on the training and validation sets
trainPredict <- predict(model, dtrain)
validPredict <- predict(model, dvalid)

# Convert predictions to binary using the custom threshold
trainPredictBinary <- ifelse(trainPredict > custom_threshold, 1, 0)
validPredictBinary <- ifelse(validPredict > custom_threshold, 1, 0)

# Calculate ROC curves and AUC values
trainRoc <- roc(response = as.numeric(trainData$X) - 1, predictor = trainPredict)
validRoc <- roc(response = as.numeric(validData$X) - 1, predictor = validPredict)

# Plot ROC curves with AUC values
ggplot(data = data.frame(fpr = trainRoc$specificities, tpr = trainRoc$sensitivities), aes(x = 1 - fpr, y = tpr)) +
  geom_line(color = "blue") +
  geom_area(alpha = 0.2, fill = "blue") +
  geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "black") +
  ggtitle("Training ROC Curve") +
  xlab("False Positive Rate") +
  ylab("True Positive Rate") +
  annotate("text", x = 0.5, y = 0.1, label = paste("Training AUC =", round(auc(trainRoc), 2)), hjust = 0.5, color = "blue")

ggplot(data = data.frame(fpr = validRoc$specificities, tpr = validRoc$sensitivities), aes(x = 1 - fpr, y = tpr)) +
  geom_line(color = "red") +
  geom_area(alpha = 0.2, fill = "red") +
  geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "black") +
  ggtitle("Validation ROC Curve") +
  xlab("False Positive Rate") +
  ylab("True Positive Rate") +
  annotate("text", x = 0.5, y = 0.2, label = paste("Validation AUC =", round(auc(validRoc), 2)), hjust = 0.5, color = "red")

# Calculate confusion matrices based on the custom threshold
confMatTrain <- table(trainData$X, trainPredictBinary)
confMatValid <- table(validData$X, validPredictBinary)

# Function to plot confusion matrix using ggplot2
plot_confusion_matrix <- function(conf_mat, dataset_name) {
  conf_mat_df <- as.data.frame(as.table(conf_mat))
  colnames(conf_mat_df) <- c("Actual", "Predicted", "Freq")
  
  p <- ggplot(data = conf_mat_df, aes(x = Predicted, y = Actual, fill = Freq)) +
    geom_tile(color = "white") +
    geom_text(aes(label = Freq), vjust = 1.5, color = "black", size = 5) +
    scale_fill_gradient(low = "white", high = "steelblue") +
    labs(title = paste("Confusion Matrix -", dataset_name, "Set"), x = "Predicted Class", y = "Actual Class") +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 45, hjust = 1), plot.title = element_text(hjust = 0.5))
  
  print(p)
}

# Now call the function to plot and display the confusion matrices
plot_confusion_matrix(confMatTrain, "Training")
plot_confusion_matrix(confMatValid, "Validation")

# Extract values for calculations
a_train <- confMatTrain[1, 1]
b_train <- confMatTrain[1, 2]
c_train <- confMatTrain[2, 1]
d_train <- confMatTrain[2, 2]

a_valid <- confMatValid[1, 1]
b_valid <- confMatValid[1, 2]
c_valid <- confMatValid[2, 1]
d_valid <- confMatValid[2, 2]

# Training Set Metrics
acc_train <- (a_train + d_train) / sum(confMatTrain)
error_rate_train <- 1 - acc_train
sen_train <- d_train / (d_train + c_train)
sep_train <- a_train / (a_train + b_train)
precision_train <- d_train / (b_train + d_train)
F1_train <- (2 * precision_train * sen_train) / (precision_train + sen_train)
MCC_train <- (d_train * a_train - b_train * c_train) / sqrt((d_train + b_train) * (d_train + c_train) * (a_train + b_train) * (a_train + c_train))
auc_train <- roc(response = trainData$X, predictor = trainPredict)$auc

# Validation Set Metrics
acc_valid <- (a_valid + d_valid) / sum(confMatValid)
error_rate_valid <- 1 - acc_valid
sen_valid <- d_valid / (d_valid + c_valid)
sep_valid <- a_valid / (a_valid + b_valid)
precision_valid <- d_valid / (b_valid + d_valid)
F1_valid <- (2 * precision_valid * sen_valid) / (precision_valid + sen_valid)
MCC_valid <- (d_valid * a_valid - b_valid * c_valid) / sqrt((d_valid + b_valid) * (d_valid + c_valid) * (a_valid + b_valid) * (a_valid + c_valid))
auc_valid <- roc(response = validData$X, predictor = validPredict)$auc

# Print Metrics
cat("Training Metrics\n")
cat("Accuracy:", acc_train, "\n")
cat("Error Rate:", error_rate_train, "\n")
cat("Sensitivity:", sen_train, "\n")
cat("Specificity:", sep_train, "\n")
cat("Precision:", precision_train, "\n")
cat("F1 Score:", F1_train, "\n")
cat("MCC:", MCC_train, "\n")
cat("AUC:", auc_train, "\n\n")

cat("Validation Metrics\n")
cat("Accuracy:", acc_valid, "\n")
cat("Error Rate:", error_rate_valid, "\n")
cat("Sensitivity:", sen_valid, "\n")
cat("Specificity:", sep_valid, "\n")
cat("Precision:", precision_valid, "\n")
cat("F1 Score:", F1_valid, "\n")
cat("MCC:", MCC_valid, "\n")
cat("AUC:", auc_valid, "\n")

操作简单，自己调整代码中的数字即可，custom_threshold <- 0.5。

具体有何影响，代价自己实战即可。