第100+17步 ChatGPT学习：R实现Catboost分类

基于R 4.2.2版本演示

一、写在前面

有不少大佬问做机器学习分类能不能用R语言，不想学Python咯。

答曰：可！用GPT大概Kimi转一下就得了呗。

加上最近也没啥内容写了，就帮各位搬运一下吧。

二、R代码实现Catboost分类

（1）导入数据

我习惯用RStudio自带的导入功能：

（2）创建Catboost模型（默认参数）

1. # Load necessary libraries
2. library(caret)
3. library(pROC)
4. library(ggplot2)
5. library(catboost)
7. # Assume 'data' is your dataframe containing the data
8. # Set seed to ensure reproducibility
9. set.seed(123)
11. # Split data into training and validation sets (80% training, 20% validation)
12. trainIndex <- createDataPartition(data$X, p = 0.8, list = FALSE)
13. trainData <- data[trainIndex, ]
14. validData <- data[-trainIndex, ]
16. # Prepare pools for CatBoost
17. trainPool <- catboost.load_pool(data = trainData[, -which(names(trainData) == "X")], label = trainData$X)
18. validPool <- catboost.load_pool(data = validData[, -which(names(validData) == "X")], label = validData$X)
20. # Define parameters for CatBoost
21. params <- list(
22.   iterations = 250,
23.   depth = 6,
24.   learning_rate = 0.1,
25.   l2_leaf_reg = 10,
26.   loss_function = "Logloss",
27.   eval_metric = "AUC"
28. )
30. # Train the CatBoost model
31. model <- catboost.train(learn_pool = trainPool, params = params)
33. # Predict on the training and validation sets using the correct parameter
34. trainPredict <- catboost.predict(model, trainPool, prediction_type = "Probability")
35. validPredict <- catboost.predict(model, validPool, prediction_type = "Probability")
37. # Convert predictions to binary using 0.5 as threshold
38. trainPredictBinary <- ifelse(trainPredict > 0.5, 1, 0)
39. validPredictBinary <- ifelse(validPredict > 0.5, 1, 0)
41. # 计算ROC对象
42. trainRoc <- roc(response = as.numeric(trainData$X) - 1, predictor = trainPredict)
43. validRoc <- roc(response = as.numeric(validData$X) - 1, predictor = validPredict)
45. # 使用ggplot绘制ROC曲线
46. trainRocPlot <- ggplot(data = data.frame(fpr = 1 - trainRoc$specificities, tpr = trainRoc$sensitivities), aes(x = fpr, y = tpr)) +
47.   geom_line(color = "blue") +
48.   geom_area(aes(ifelse(fpr <= 1, fpr, NA)), fill = "blue", alpha = 0.2) + # 使用条件表达式确保不超出坐标范围
49.   geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "black") +
50.   ggtitle("Training ROC Curve") +
51.   xlab("False Positive Rate") +
52.   ylab("True Positive Rate") +
53.   annotate("text", x = 0.5, y = 0.1, label = paste("Training AUC =", round(auc(trainRoc), 2)), hjust = 0.5, color = "blue")
55. validRocPlot <- ggplot(data = data.frame(fpr = 1 - validRoc$specificities, tpr = validRoc$sensitivities), aes(x = fpr, y = tpr)) +
56.   geom_line(color = "red") +
57.   geom_area(aes(ifelse(fpr <= 1, fpr, NA)), fill = "red", alpha = 0.2) + # 使用条件表达式确保不超出坐标范围
58.   geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "black") +
59.   ggtitle("Validation ROC Curve") +
60.   xlab("False Positive Rate") +
61.   ylab("True Positive Rate") +
62.   annotate("text", x = 0.5, y = 0.2, label = paste("Validation AUC =", round(auc(validRoc), 2)), hjust = 0.5, color = "red")
64. # 显示绘图
65. print(trainRocPlot)
66. print(validRocPlot)
69. # Calculate confusion matrices based on 0.5 cutoff for probability
70. confMatTrain <- table(trainData$X, trainPredict >= 0.5)
71. confMatValid <- table(validData$X, validPredict >= 0.5)
73. # Plot and display confusion matrices
74. plot_confusion_matrix <- function(pred, actual, dataset_name) {
75.   conf_mat <- table(Predicted = pred >= 0.5, Actual = actual)
76.   conf_mat_df <- as.data.frame(as.table(conf_mat))
77.   colnames(conf_mat_df) <- c("Actual", "Predicted", "Freq")
78.   
79.   p <- ggplot(data = conf_mat_df, aes(x = Predicted, y = Actual, fill = Freq)) +
80.     geom_tile(color = "white") +
81.     geom_text(aes(label = Freq), vjust = 1.5, color = "black", size = 5) +
82.     scale_fill_gradient(low = "white", high = "steelblue") +
83.     labs(title = paste("Confusion Matrix -", dataset_name, "Set"), x = "Predicted Class", y = "Actual Class") +
84.     theme_minimal() +
85.     theme(axis.text.x = element_text(angle = 45, hjust = 1), plot.title = element_text(hjust = 0.5))
86.   
87.   print(p)
88. }
90. # Call the function to plot confusion matrices for both training and validation sets
91. plot_confusion_matrix(trainPredict, trainData$X, "Training")
92. plot_confusion_matrix(validPredict, validData$X, "Validation")
94. # Extract values for calculations
95. a_train <- confMatTrain[1, 1]
96. b_train <- confMatTrain[1, 2]
97. c_train <- confMatTrain[2, 1]
98. d_train <- confMatTrain[2, 2]
100. a_valid <- confMatValid[1, 1]
101. b_valid <- confMatValid[1, 2]
102. c_valid <- confMatValid[2, 1]
103. d_valid <- confMatValid[2, 2]
105. # Training Set Metrics
106. acc_train <- (a_train + d_train) / sum(confMatTrain)
107. error_rate_train <- 1 - acc_train
108. sen_train <- d_train / (d_train + c_train)
109. sep_train <- a_train / (a_train + b_train)
110. precision_train <- d_train / (b_train + d_train)
111. F1_train <- (2 * precision_train * sen_train) / (precision_train + sen_train)
112. 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))
113. auc_train <- roc(response = trainData$X, predictor = trainPredict)$auc
115. # Validation Set Metrics
116. acc_valid <- (a_valid + d_valid) / sum(confMatValid)
117. error_rate_valid <- 1 - acc_valid
118. sen_valid <- d_valid / (d_valid + c_valid)
119. sep_valid <- a_valid / (a_valid + b_valid)
120. precision_valid <- d_valid / (b_valid + d_valid)
121. F1_valid <- (2 * precision_valid * sen_valid) / (precision_valid + sen_valid)
122. 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))
123. auc_valid <- roc(response = validData$X, predictor = validPredict)$auc
125. # Print Metrics
126. cat("Training Metrics\n")
127. cat("Accuracy:", acc_train, "\n")
128. cat("Error Rate:", error_rate_train, "\n")
129. cat("Sensitivity:", sen_train, "\n")
130. cat("Specificity:", sep_train, "\n")
131. cat("Precision:", precision_train, "\n")
132. cat("F1 Score:", F1_train, "\n")
133. cat("MCC:", MCC_train, "\n")
134. cat("AUC:", auc_train, "\n\n")
136. cat("Validation Metrics\n")
137. cat("Accuracy:", acc_valid, "\n")
138. cat("Error Rate:", error_rate_valid, "\n")
139. cat("Sensitivity:", sen_valid, "\n")
140. cat("Specificity:", sep_valid, "\n")
141. cat("Precision:", precision_valid, "\n")
142. cat("F1 Score:", F1_valid, "\n")
143. cat("MCC:", MCC_valid, "\n")
144. cat("AUC:", auc_valid, "\n")

复制代码

在R语言中，Catboost模型得单独安装，下面是一些可以调整的关键参数：

①学习率 (learning_rate)：控制每步模型更新的幅度。较小的学习率可以进步模型的训练稳定性和准确性，但可能必要更多的时间和更多的树来收敛。

②树的深度 (depth)：决定了每棵树的最大深度。较深的树可以更好地捕捉数据中的复杂关系，但也可能导致过拟合。

③树的数量 (iterations)：模型中树的总数。更多的树可以增长模型的复杂度和能力，但同样可能导致过拟合。

④L2 正则化系数 (l2_leaf_reg)：在模型的丧失函数中增长一个正则项，以减少模型复杂度和过拟合风险。

⑤边界计数 (border_count)：用于数值特征分箱的边界数量，影响模型在连续特征上的决策边界。

⑥种别特征组合深度 (cat_features)：CatBoost 优化了对种别特征的处置处罚，可以指定在模型中使用的种别特征。

⑦子采样 (subsample)：指定每棵树训练时从训练数据集中随机抽取的比例，有助于防止模型过拟合。

⑧列采样 (colsample_bylevel，colsample_bytree)：控制每棵树或每个级别使用的特征的比例，可以增长模型的多样性，低落过拟合风险。

⑨最小数据在叶节点 (min_data_in_leaf)：叶节点必需的最小样本数量，增长这个参数的值可以防止模型学习过于具体的模式，从而低落过拟合风险。

⑩评估指标 (eval_metric)：用于训练过程中模型评估的性能指标。

结果输出（随便挑的）：

从AUC来看，Catboost随便一跑，就跑出过拟合了，跟Xgboost差不多。

三、Catboost调参

随便设置了一下，效果不明显，给各位自行嗨皮：

1. # Load necessary libraries
2. library(caret)
3. library(pROC)
4. library(ggplot2)
5. library(catboost)
7. # Assume 'data' is your dataframe containing the data
8. # Set seed to ensure reproducibility
9. set.seed(123)
11. # Convert the target variable to factor if not already
12. data$X <- as.factor(data$X)
13. data$X <- as.numeric(data$X) - 1
15. # Split data into training and validation sets (80% training, 20% validation)
16. trainIndex <- createDataPartition(data$X, p = 0.8, list = FALSE)
17. trainData <- data[trainIndex, ]
18. validData <- data[-trainIndex, ]
20. # Prepare CatBoost pools
21. trainPool <- catboost.load_pool(data = trainData[, -which(names(trainData) == "X")], label = trainData$X)
22. validPool <- catboost.load_pool(data = validData[, -which(names(validData) == "X")], label = validData$X)
24. # Define parameter grid
25. depths <- c(2, 4, 6)  # Reduced maximum depth
26. l2_leaf_regs <- c(1, 3, 5, 10, 20, 25)  # Increased maximum regularization
27. iterations <- c(500, 1000)  # Added higher iteration count for lower learning rates
28. learning_rates <- c(0.05, 0.1)  # Lower maximum learning rate
29. subsample <- 1.0  # Use 80% of data for each tree to prevent overfitting
31. best_auc <- 0
32. best_params <- list()
34. # Loop through parameter grid
35. for (depth in depths) {
36.   for (l2_leaf_reg in l2_leaf_regs) {
37.     for (iter in iterations) {
38.       for (learning_rate in learning_rates) {
39.         # Set parameters for this iteration
40.         params <- list(
41.           iterations = iter,
42.           depth = depth,
43.           learning_rate = learning_rate,
44.           l2_leaf_reg = l2_leaf_reg,
45.           loss_function = 'Logloss',
46.           eval_metric = 'AUC'
47.         )
48.         
49.         # Train the model
50.         model <- catboost.train(learn_pool = trainPool, test_pool = validPool, params = params)
51.         
52.         # Predict on the validation set
53.         validPredict <- catboost.predict(model, validPool)
54.         if (is.vector(validPredict)) {
55.           validPredictBinary <- ifelse(validPredict > 0.5, 1, 0)
56.         } else {
57.           # Assuming the second column is the probability of the positive class
58.           validPredictBinary <- ifelse(validPredict[, 2] > 0.5, 1, 0)
59.         }
60.         
61.         # Calculate AUC
62.         validRoc <- roc(response = as.numeric(validData$X) - 1, predictor = validPredictBinary)
63.         auc_score <- auc(validRoc)
64.         
65.         # Update best model if current AUC is better
66.         if (auc_score > best_auc) {
67.           best_auc <- auc_score
68.           best_params <- params
69.         }
70.       }
71.     }
72.   }
73. }
75. # Print the best AUC and corresponding parameters
76. print(paste("Best AUC:", best_auc))
77. print("Best Parameters:")
78. print(best_params)
80. # After parameter tuning, train the model with best parameters
81. model <- catboost.train(learn_pool = trainPool, params = best_params)
83. # Predict on the training and validation sets using the correct parameter
84. trainPredict <- catboost.predict(model, trainPool, prediction_type = "Probability")
85. validPredict <- catboost.predict(model, validPool, prediction_type = "Probability")
87. # Convert predictions to binary using 0.5 as threshold
88. trainPredictBinary <- ifelse(trainPredict > 0.5, 1, 0)
89. validPredictBinary <- ifelse(validPredict > 0.5, 1, 0)
91. # 计算ROC对象
92. trainRoc <- roc(response = as.numeric(trainData$X) - 1, predictor = trainPredict)
93. validRoc <- roc(response = as.numeric(validData$X) - 1, predictor = validPredict)
95. # 使用ggplot绘制ROC曲线
96. trainRocPlot <- ggplot(data = data.frame(fpr = 1 - trainRoc$specificities, tpr = trainRoc$sensitivities), aes(x = fpr, y = tpr)) +
97.   geom_line(color = "blue") +
98.   geom_area(aes(ifelse(fpr <= 1, fpr, NA)), fill = "blue", alpha = 0.2) + # 使用条件表达式确保不超出坐标范围
99.   geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "black") +
100.   ggtitle("Training ROC Curve") +
101.   xlab("False Positive Rate") +
102.   ylab("True Positive Rate") +
103.   annotate("text", x = 0.5, y = 0.1, label = paste("Training AUC =", round(auc(trainRoc), 2)), hjust = 0.5, color = "blue")
105. validRocPlot <- ggplot(data = data.frame(fpr = 1 - validRoc$specificities, tpr = validRoc$sensitivities), aes(x = fpr, y = tpr)) +
106.   geom_line(color = "red") +
107.   geom_area(aes(ifelse(fpr <= 1, fpr, NA)), fill = "red", alpha = 0.2) + # 使用条件表达式确保不超出坐标范围
108.   geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "black") +
109.   ggtitle("Validation ROC Curve") +
110.   xlab("False Positive Rate") +
111.   ylab("True Positive Rate") +
112.   annotate("text", x = 0.5, y = 0.2, label = paste("Validation AUC =", round(auc(validRoc), 2)), hjust = 0.5, color = "red")
114. # 显示绘图
115. print(trainRocPlot)
116. print(validRocPlot)
119. # Calculate confusion matrices based on 0.5 cutoff for probability
120. confMatTrain <- table(trainData$X, trainPredict >= 0.5)
121. confMatValid <- table(validData$X, validPredict >= 0.5)
123. # Function to plot confusion matrix using ggplot2
124. plot_confusion_matrix <- function(conf_mat, dataset_name) {
125.   conf_mat_df <- as.data.frame(as.table(conf_mat))
126.   colnames(conf_mat_df) <- c("Actual", "Predicted", "Freq")
127.   
128.   p <- ggplot(data = conf_mat_df, aes(x = Predicted, y = Actual, fill = Freq)) +
129.     geom_tile(color = "white") +
130.     geom_text(aes(label = Freq), vjust = 1.5, color = "black", size = 5) +
131.     scale_fill_gradient(low = "white", high = "steelblue") +
132.     labs(title = paste("Confusion Matrix -", dataset_name, "Set"), x = "Predicted Class", y = "Actual Class") +
133.     theme_minimal() +
134.     theme(axis.text.x = element_text(angle = 45, hjust = 1), plot.title = element_text(hjust = 0.5))
135.   
136.   print(p)
137. }
139. # Now call the function to plot and display the confusion matrices
140. plot_confusion_matrix(confMatTrain, "Training")
141. plot_confusion_matrix(confMatValid, "Validation")
143. # Extract values for calculations
144. a_train <- confMatTrain[1, 1]
145. b_train <- confMatTrain[1, 2]
146. c_train <- confMatTrain[2, 1]
147. d_train <- confMatTrain[2, 2]
149. a_valid <- confMatValid[1, 1]
150. b_valid <- confMatValid[1, 2]
151. c_valid <- confMatValid[2, 1]
152. d_valid <- confMatValid[2, 2]
154. # Training Set Metrics
155. acc_train <- (a_train + d_train) / sum(confMatTrain)
156. error_rate_train <- 1 - acc_train
157. sen_train <- d_train / (d_train + c_train)
158. sep_train <- a_train / (a_train + b_train)
159. precision_train <- d_train / (b_train + d_train)
160. F1_train <- (2 * precision_train * sen_train) / (precision_train + sen_train)
161. 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))
162. auc_train <- roc(response = trainData$X, predictor = trainPredict)$auc
164. # Validation Set Metrics
165. acc_valid <- (a_valid + d_valid) / sum(confMatValid)
166. error_rate_valid <- 1 - acc_valid
167. sen_valid <- d_valid / (d_valid + c_valid)
168. sep_valid <- a_valid / (a_valid + b_valid)
169. precision_valid <- d_valid / (b_valid + d_valid)
170. F1_valid <- (2 * precision_valid * sen_valid) / (precision_valid + sen_valid)
171. 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))
172. auc_valid <- roc(response = validData$X, predictor = validPredict)$auc
174. # Print Metrics
175. cat("Training Metrics\n")
176. cat("Accuracy:", acc_train, "\n")
177. cat("Error Rate:", error_rate_train, "\n")
178. cat("Sensitivity:", sen_train, "\n")
179. cat("Specificity:", sep_train, "\n")
180. cat("Precision:", precision_train, "\n")
181. cat("F1 Score:", F1_train, "\n")
182. cat("MCC:", MCC_train, "\n")
183. cat("AUC:", auc_train, "\n\n")
185. cat("Validation Metrics\n")
186. cat("Accuracy:", acc_valid, "\n")
187. cat("Error Rate:", error_rate_valid, "\n")
188. cat("Sensitivity:", sen_valid, "\n")
189. cat("Specificity:", sep_valid, "\n")
190. cat("Precision:", precision_valid, "\n")
191. cat("F1 Score:", F1_valid, "\n")
192. cat("MCC:", MCC_valid, "\n")
193. cat("AUC:", auc_valid, "\n")

复制代码

结果输出：

提供个样本代码吧，我不调了。

五、最后

至于怎么安装，自学了哈。
数据嘛：
链接：https://pan.baidu.com/s/1rEf6JZyzA1ia5exoq5OF7g?pwd=x8xm
提取码：x8xm

免责声明：如果侵犯了您的权益，请联系站长，我们会及时删除侵权内容，谢谢合作！更多信息从访问主页：qidao123.com:ToB企服之家，中国第一个企服评测及商务社交产业平台。