基于R 4.2.2版本演示

一、寫在前面

有不少大佬問做機器學習分類能不能用R語言，不想學Python咯。

答曰：可！用GPT或者Kimi轉一下就得了唄。

加上最近也沒啥內容寫了，就幫各位搬運一下吧。

二、R代碼實現Xgboost分類

（1）導入數據

我習慣用RStudio自帶的導入功能：

（2）建立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)# 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.8, colsample_bytree = 0.8)# Train the XGBoost model
model <- xgb.train(params = params, data = dtrain, nrounds = 100, 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 0.5 as threshold
#trainPredict <- ifelse(trainPredict > 0.5, 1, 0)
#validPredict <- ifelse(validPredict > 0.5, 1, 0)# Calculate ROC curves and AUC values
#trainRoc <- roc(response = trainData$X, predictor = as.numeric(trainPredict))
#validRoc <- roc(response = validData$X, predictor = as.numeric(validPredict))
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 0.5 cutoff for probability
confMatTrain <- table(trainData$X, trainPredict >= 0.5)
confMatValid <- table(validData$X, validPredict >= 0.5)# 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")

在R語言中，訓練Xgboost模型時，可調參數很多：

1）通用參數

這些參數用于控制XGBoost的整體功能：

①booster: 選擇每一步的模型類型，常用的有：

1. gbtree：基于樹的模型（默認）
2. gblinear：線性模型
3. dart：Dropouts meet Multiple Additive Regression Trees

②nthread: 并行線程數，默認為最大可用線程數。

③verbosity: 打印消息的詳細程度，0 (silent), 1 (warning), 2 (info), 3 (debug)。

2）Booster 參數：

控制每一步提升（booster）的行為：

①eta (或 learning_rate):?學習率，控制每步的收縮以防止過擬合。

②min_child_weight:?決定最小葉子節點樣本權重和，用于控制過擬合。

③max_depth:?樹的最大深度，限制樹的增長以避免過擬合。

④max_leaf_nodes:?最大葉子節點數。

⑤gamma (或 min_split_loss):?分裂節點所需的最小損失函數下降值。

⑥subsample:?訓練每棵樹時用于隨機采樣的部分數據比例。

⑦colsample_bytree/colsample_bylevel/colsample_bynode:?構建樹時每個級別的特征采樣比例。

⑧lambda (或 reg_lambda):?L2 正則化項權重。

⑨alpha (或 reg_alpha):?L1 正則化項權重。

⑩scale_pos_weight:?在類別不平衡的情況下加權正類的權重。

n_estimators / nrounds：Boosting 過程中的樹的數量，或者說是提升迭代的輪數。每輪迭代通常會產生一個新的模型（通常是一棵樹）。

3）學習任務參數

用于控制學習任務和相應的學習目標：

①objective: 定義學習任務和相應的學習目標，如：

②binary:logistic: 二分類的邏輯回歸，返回預測概率。

③multi:softmax: 多分類的softmax，需要設置 num_class（類別數）。

④reg:squarederror: 回歸任務的平方誤差。

⑤eval_metric: 驗證數據的評估指標，如 rmse、mae、logloss、error (分類錯誤率)、auc 等。

⑥seed: 隨機數種子，用于結果的可重復性。

5）DART Booster特有參數

當 booster 設置為 dart 時：

①sample_type: 采樣類型。

②normalize_type:?歸一化類型。

③rate_drop: 每次迭代中樹的丟棄率。

④skip_drop: 跳過丟棄的概率。

在隨便設置了一些參數值，結果如下：

從AUC來看，Xgboost隨便一跑直接就過擬合了，驗證集的性能相比訓練集差距挺大的。得好好調參調參才行。

三、Xgboost手動調參原則

調參的一般策略是，可以先使用網格搜索（Grid Search）、隨機搜索（Random Search）或更高級的方法如貝葉斯優化來粗略地確定合適的參數范圍，然后在這些范圍內細致地調整和驗證，以找到最優的模型配置。

主要調的參數：max_depth、min_child_weight、gamma、subsample、colsample_bytree / colsample_bylevel / colsample_bynode、eta、lambda、alpha和n_estimators (或 nrounds)。

max_depth（最大深度）：通常范圍是3到10。較大的深度可能會導致過擬合，尤其是在小數據集上。

min_child_weight（最小子節點權重）：有助于控制過擬合。面對高度不平衡的類別時，可以適當增加此值。

gamma（伽馬）：從0開始調整，根據控制過擬合的需要逐漸增加。

subsample、colsample_bytree/colsample_bylevel/colsample_bynode（子采樣率、按樹/層/節點的列采樣率）：通常范圍從0.5到1。這些參數控制了每一步的數據子采樣。

eta（學習率）：較小的值可以使訓練更加穩健，但需要更多的訓練迭代。

lambda 和 alpha（L2和L1正則化項）：在成本函數中添加正則化項。0到10的范圍通常效果不錯。

nrounds（樹的數量，或迭代次數）：更多的樹可以模擬更復雜的模式，但也可能導致過擬合。

# 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)# Convert the target variable to factor if not already
data$X <- factor(data$X)# 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 = as.numeric(trainData$X) - 1)
dvalid <- xgb.DMatrix(data = as.matrix(validData[, -which(names(validData) == "X")]), label = as.numeric(validData$X) - 1)# Define parameter grid
depths <- c(4, 6, 10)
weights <- c(1, 5, 10)
gammas <- c(0, 0.2, 0.5)
subsamples <- c(0.5, 0.8, 0.9)
colsamples <- c(0.5, 0.8, 0.9)
etas <- c(0.01, 0.1, 0.2)
lambdas <- c(0, 5, 10)
alphas <- c(0, 1, 5)
nrounds <- c(100, 250, 500)best_auc <- 0
best_params <- list()# Loop through parameter grid
for (max_depth in depths) {for (min_child_weight in weights) {for (gamma in gammas) {for (subsample in subsamples) {for (colsample_bytree in colsamples) {for (eta in etas) {for (lambda in lambdas) {for (alpha in alphas) {for (nround in nrounds) {# Set parameters for this iterationparams <- list(booster = "gbtree",objective = "binary:logistic",eta = eta,gamma = gamma,max_depth = max_depth,min_child_weight = min_child_weight,subsample = subsample,colsample_bytree = colsample_bytree,lambda = lambda,alpha = alpha)# Train the modelmodel <- xgb.train(params = params, data = dtrain, nrounds = nround, watchlist = list(eval = dtrain), verbose = 0)# Predict on the validation setvalidPredict <- predict(model, dvalid)validPredictBinary <- ifelse(validPredict > 0.5, 1, 0)# Calculate AUCvalidRoc <- roc(response = as.numeric(validData$X) - 1, predictor = validPredictBinary)auc_score <- auc(validRoc)# Update best model if current AUC is betterif (auc_score > best_auc) {best_auc <- auc_scorebest_params <- paramsbest_params$nrounds <- nround}}}}}}}}}
}# Print the best AUC and corresponding parameters
print(paste("Best AUC:", best_auc))
print("Best Parameters:")
print(best_params)# After parameter tuning, train the model with best parameters
model <- xgb.train(params = best_params, data = dtrain, nrounds = best_params$nrounds, watchlist = list(eval = dtrain), verbose = 0)# Predict on the training and validation sets using the final model
trainPredict <- predict(model, dtrain)
validPredict <- predict(model, dvalid)# Convert predictions to binary using 0.5 as threshold
#trainPredictBinary <- ifelse(trainPredict > 0.5, 1, 0)
#validPredictBinary <- ifelse(validPredict > 0.5, 1, 0)# Calculate ROC curves and AUC values
#trainRoc <- roc(response = trainData$X, predictor = as.numeric(trainPredict))
#validRoc <- roc(response = validData$X, predictor = as.numeric(validPredict))
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 0.5 cutoff for probability
confMatTrain <- table(trainData$X, trainPredict >= 0.5)
confMatValid <- table(validData$X, validPredict >= 0.5)# 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")

結果輸出：

以上是找到的相對最優參數組合，看看具體性能：

似乎有點提升，過擬合沒那么明顯了。驗證集的性能也有所提高。

有興趣可以繼續調參。

五、最后

數據嘛：

鏈接：https://pan.baidu.com/s/1rEf6JZyzA1ia5exoq5OF7g?pwd=x8xm

提取碼：x8xm