# 题目重述 基于 `data_HeartDisease.xlsx` 数据构建分类模型,要求: 1. 尝试选择不同的特征(自变量); 2. 使用多种机器学习算法(如决策树、随机森林、逻辑回归、KNN等)建模; 3. 对模型进行优化(如超参数调优、阈值调整等); 4. 使用最优模型对 `student_HD.xlsx` 数据进行预测; 5. 分析并确定具有最高预测准确率的算法与特征组合; 6. 提交完整 R 代码和预测结果的 Excel 文件。 --- # 详解 以下为完整可运行的 **R语言解决方案**,适用于课程作业提交。代码实现了从数据加载、预处理、多特征集与多算法对比、交叉验证评估、最优模型训练到对 `student_HD.xlsx` 进行预测并输出结果文件的全流程。 ```r # —————————————————————— 1. 加载必要包 —————————————————————— library(tidyverse) library(mlr3verse) library(readxl) library(writexl) # 注意:若未安装,请先运行: # install.packages(c("tidyverse", "mlr3verse", "readxl", "writexl")) # —————————————————————— 2. 读取并预处理训练数据 —————————————————————— # 读取原始数据 data_train <- read_excel("data_HeartDisease.xlsx") # 转换所有字符列为因子(factor) data_clean <- data_train %>% mutate(across(where(is.character), as.factor)) # 创建 mlr3 分类任务(目标变量:HeartDisease) task_full <- as_task_classif(data_clean, target = "HeartDisease") # —————————————————————— 3. 构造不同特征子集用于比较 —————————————————————— # 方案A:医学相关核心特征(分类变量为主) features_medical <- c("AgeCategory", "Sex", "Smoking", "Diabetic", "DiffWalking", "Stroke", "KidneyDisease", "GenHealth", "PhysicalActivity") task_medical <- task_full$select(features_medical) # 方案B:增强型特征(加入数值型指标) features_enhanced <- c(features_medical, "BMI", "PhysicalHealth", "MentalHealth", "SleepTime") task_enhanced <- task_full$select(features_enhanced) # 汇总所有任务 tasks <- list( full = task_full, medical = task_medical, enhanced = task_enhanced ) # —————————————————————— 4. 定义多个机器学习算法(学习器) —————————————————————— learners <- list( lrn("classif.rpart", predict_type = "prob"), # 决策树 lrn("classif.ranger", predict_type = "prob", num.threads = 1), # 随机森林 lrn("classif.log_reg", predict_type = "prob"), # 逻辑回归 lrn("classif.kknn", predict_type = "prob") # K近邻 ) # —————————————————————— 5. 设置5折交叉验证并执行基准测试 —————————————————————— design <- benchmark_grid( tasks = tasks, learners = learners, resamplings = rsmp("cv", folds = 5) ) # 执行基准测试(耗时操作,建议运行一次后保存结果) bmr <- benchmark(design) # —————————————————————— 6. 汇总性能并找出最佳模型 —————————————————————— performance <- bmr$aggregate(msrs(c("classif.acc", "classif.auc"))) # 按准确率排序 performance <- performance[order(-classif.acc), ] print(performance) # 获取最佳模型配置 best_model <- performance[1, ] cat("\n🏆 最佳模型配置:\n") cat("特征集:", best_model$task_id, "\n") cat("算法:", best_model$learner_id, "\n") cat("准确率:", round(best_model$classif.acc, 4), "\n") cat("AUC:", round(best_model$classif.auc, 4), "\n\n") # —————————————————————— 7. 在最优特征集上重新训练模型(可选调参) —————————————————————— best_task <- tasks[[best_model$task_id]] best_learner <- lrn(best_model$learner_id, predict_type = "prob") # 若是决策树,则启用自动调参 if (grepl("rpart", best_model$learner_id)) { library(mlr3tuning) at <- auto_tuner( tuner = tnr("random_search"), learner = best_learner, resampling = rsmp("cv", folds = 5), measure = msr("classif.acc"), search_space = ps(cp = p_dbl(0, 0.1), minsplit = p_int(2, 20)), term_evals = 20 ) best_learner <- at } # 训练最终模型 best_learner$train(best_task) # —————————————————————— 8. 读取学生数据并进行预测 —————————————————————— # 读取待预测数据 data_student <- read_excel("student_HD.xlsx") # 确保与训练数据结构一致 required_features <- best_task$feature_names # 处理缺失列或类型不一致问题 for (col in required_features) { if (!col %in% names(data_student)) { stop("缺少必要特征:", col) } data_student[[col]] <- as.factor(data_student[[col]]) } # 提取有效输入数据 X_new <- data_student[, required_features] # 进行预测 pred <- best_learner$predict_newdata(X_new) # 将预测结果合并回原始数据 result_df <- bind_cols( data_student, tibble( prediction = pred$response, prob_No = pred$prob[, "No"], prob_Yes = pred$prob[, "Yes"] ) ) # —————————————————————— 9. 导出预测结果到Excel —————————————————————— write_xlsx(result_df, "predicted_student_HD.xlsx") # 输出完成信息 cat("✅ 预测完成!\n") cat("📁 文件已保存:predicted_student_HD.xlsx\n") cat("📊 总样本数:", nrow(result_df), "\n") cat("🔍 使用特征数:", length(required_features), "\n") cat("🎯 最高准确率模型:", best_model$learner_id, "(", round(best_model$classif.acc, 4), ")\n") # 题目重述 基于 `data_HeartDisease.xlsx` 数据构建分类模型,要求: 1. 尝试选择不同的特征(自变量); 2. 使用多种机器学习算法(如决策树、随机森林、逻辑回归、KNN等)建模; 3. 对模型进行优化(如超参数调优、阈值调整等); 4. 使用最优模型对 `student_HD.xlsx` 数据进行预测; 5. 分析并确定具有最高预测准确率的算法与特征组合; 6. 提交完整 R 代码和预测结果的 Excel 文件。 --- # 详解 以下为完整可运行的 **R语言解决方案**,适用于课程作业提交。代码实现了从数据加载、预处理、多特征集与多算法对比、交叉验证评估、最优模型训练到对 `student_HD.xlsx` 进行预测并输出结果文件的全流程。 ```r # —————————————————————— 1. 加载必要包 —————————————————————— library(tidyverse) library(mlr3verse) library(readxl) library(writexl) # 注意:若未安装,请先运行: # install.packages(c("tidyverse", "mlr3verse", "readxl", "writexl")) # —————————————————————— 2. 读取并预处理训练数据 —————————————————————— # 读取原始数据 data_train <- read_excel("data_HeartDisease.xlsx") # 转换所有字符列为因子(factor) data_clean <- data_train %>% mutate(across(where(is.character), as.factor)) # 创建 mlr3 分类任务(目标变量:HeartDisease) task_full <- as_task_classif(data_clean, target = "HeartDisease") # —————————————————————— 3. 构造不同特征子集用于比较 —————————————————————— # 方案A:医学相关核心特征(分类变量为主) features_medical <- c("AgeCategory", "Sex", "Smoking", "Diabetic", "DiffWalking", "Stroke", "KidneyDisease", "GenHealth", "PhysicalActivity") task_medical <- task_full$select(features_medical) # 方案B:增强型特征(加入数值型指标) features_enhanced <- c(features_medical, "BMI", "PhysicalHealth", "MentalHealth", "SleepTime") task_enhanced <- task_full$select(features_enhanced) # 汇总所有任务 tasks <- list( full = task_full, medical = task_medical, enhanced = task_enhanced ) # —————————————————————— 4. 定义多个机器学习算法(学习器) —————————————————————— learners <- list( lrn("classif.rpart", predict_type = "prob"), # 决策树 lrn("classif.ranger", predict_type = "prob", num.threads = 1), # 随机森林 lrn("classif.log_reg", predict_type = "prob"), # 逻辑回归 lrn("classif.kknn", predict_type = "prob") # K近邻 ) # —————————————————————— 5. 设置5折交叉验证并执行基准测试 —————————————————————— design <- benchmark_grid( tasks = tasks, learners = learners, resamplings = rsmp("cv", folds = 5) ) # 执行基准测试(耗时操作,建议运行一次后保存结果) bmr <- benchmark(design) # —————————————————————— 6. 汇总性能并找出最佳模型 —————————————————————— performance <- bmr$aggregate(msrs(c("classif.acc", "classif.auc"))) # 按准确率排序 performance <- performance[order(-classif.acc), ] print(performance) # 获取最佳模型配置 best_model <- performance[1, ] cat("\n🏆 最佳模型配置:\n") cat("特征集:", best_model$task_id, "\n") cat("算法:", best_model$learner_id, "\n") cat("准确率:", round(best_model$classif.acc, 4), "\n") cat("AUC:", round(best_model$classif.auc, 4), "\n\n") # —————————————————————— 7. 在最优特征集上重新训练模型(可选调参) —————————————————————— best_task <- tasks[[best_model$task_id]] best_learner <- lrn(best_model$learner_id, predict_type = "prob") # 若是决策树,则启用自动调参 if (grepl("rpart", best_model$learner_id)) { library(mlr3tuning) at <- auto_tuner( tuner = tnr("random_search"), learner = best_learner, resampling = rsmp("cv", folds = 5), measure = msr("classif.acc"), search_space = ps(cp = p_dbl(0, 0.1), minsplit = p_int(2, 20)), term_evals = 20 ) best_learner <- at } # 训练最终模型 best_learner$train(best_task) # —————————————————————— 8. 读取学生数据并进行预测 —————————————————————— # 读取待预测数据 data_student <- read_excel("student_HD.xlsx") # 确保与训练数据结构一致 required_features <- best_task$feature_names # 处理缺失列或类型不一致问题 for (col in required_features) { if (!col %in% names(data_student)) { stop("缺少必要特征:", col) } data_student[[col]] <- as.factor(data_student[[col]]) } # 提取有效输入数据 X_new <- data_student[, required_features] # 进行预测 pred <- best_learner$predict_newdata(X_new) # 将预测结果合并回原始数据 result_df <- bind_cols( data_student, tibble( prediction = pred$response, prob_No = pred$prob[, "No"], prob_Yes = pred$prob[, "Yes"] ) ) # —————————————————————— 9. 导出预测结果到Excel —————————————————————— write_xlsx(result_df, "predicted_student_HD.xlsx") # 输出完成信息 cat("✅ 预测完成!\n") cat("📁 文件已保存:predicted_student_HD.xlsx\n") cat("📊 总样本数:", nrow(result_df), "\n") cat("🔍 使用特征数:", length(required_features), "\n") cat("🎯 最高准确率模型:", best_model$learner_id, "(", round(best_model$classif.acc, 4), ")\n") 错误于.__Task__select(self = self, private = private, super = super, : Assertion on 'cols' failed: Must be a subset of {'AgeCategory','Diabetic','DiffWalking','GenHealth','KidneyDisease','PhysicalActivity','Sex','Smoking','Stroke'}, but has additional elements {'BMI','PhysicalHealth','MentalHealth','SleepTime'}.
时间: 2025-10-26 22:23:21 AIGC 浏览: 38
<think>我们遇到了一个错误:在创建增强特征集的任务时,尝试选择了一些在数据集中不存在的列。
错误信息指出:'cols'必须是{'AgeCategory','Diabetic','DiffWalking','GenHealth','KidneyDisease','PhysicalActivity','Sex','Smoking','Stroke'}的子集,但包含了额外的列{'BMI','PhysicalHealth','MentalHealth','SleepTime'}。
这意味着在我们的训练数据集中,并没有包含这些数值型指标:BMI, PhysicalHealth, MentalHealth, SleepTime。
因此,我们需要检查原始数据文件`data_HeartDisease.xlsx`中是否包含这些列。如果不包含,那么我们需要调整特征选择。
根据错误信息,原始数据中只包含以下列:
'AgeCategory','Diabetic','DiffWalking','GenHealth','KidneyDisease','PhysicalActivity','Sex','Smoking','Stroke'
所以,我们有两个选择:
1. 如果原始数据确实没有这些数值型特征,那么我们需要修改代码,只使用已有的特征。
2. 如果原始数据有这些特征,但名称不一致,我们需要修正特征名称。
由于题目中要求使用`data_HeartDisease.xlsx`,并且错误提示中并没有列出这些数值型特征,所以很可能是原始数据中不包含这些特征。
因此,我们调整特征集:
方案A(医学相关核心特征)不变。
方案B(增强型特征)无法实现,因为缺少那些数值型特征。所以我们只能使用方案A和全特征(实际上全特征就是所有列,但目标变量是HeartDisease,所以特征就是除了HeartDisease的所有列)。
但是,我们创建任务时使用的是整个数据集(除了目标变量),而在错误信息中列出的特征正是方案A的特征,所以全特征集应该就是方案A的特征(因为数据中只有这些特征)。
所以,我们重新定义特征集:
实际上,我们只有两个特征集:
- 全特征集(实际上就是所有特征,即方案A的特征,因为数据中只有这些特征)
- 方案A:医学相关核心特征(与全特征集相同?)
但注意:全特征集可能包含所有列,包括可能存在的其他列(比如ID等),但根据错误信息,数据中只有那些列。
因此,我们需要重新检查原始数据,并调整特征集。
步骤:
1. 打印原始数据的列名,确认可用特征。
2. 根据实际列名调整特征集。
由于无法直接查看数据,我们调整代码:先读取数据并查看列名,然后根据实际列名定义特征集。
但是,由于我们是在代码中解决问题,我们可以这样做:
将原来的特征集定义改为:
全特征:使用所有特征(除去目标变量HeartDisease,因为在创建任务时已经指定目标变量,任务会自动排除目标变量?实际上,在mlr3中,创建任务时指定目标变量,那么任务的特征就是除目标变量外的所有列)
所以,我们不需要手动选择全特征。因此,我们定义特征集:
方案A:医学相关核心特征(从所有可用特征中选取我们感兴趣的部分)
方案B:如果数据中有数值型特征,那么我们可以定义,否则就不定义。
通过查看数据,我们发现原始数据中并没有BMI等特征。因此,我们只能使用方案A作为特征子集,以及全特征集(但是全特征集和方案A可能是一样的,因为数据中只有这些特征)。
实际上,在错误信息中列出的特征就是方案A的特征,并且没有其他特征。所以,我们只能比较:
- 全特征集(即所有特征,但这里所有特征就是方案A的特征)
- 方案A:医学相关核心特征(这里就是全部特征,所以两个任务是一样的)
这显然没有意义。所以我们需要重新考虑。
根据题目要求,我们需要尝试不同的特征组合。因此,我们需要创建至少两个不同的特征子集。
既然没有额外的数值型特征,我们可以考虑:
方案A:部分医学特征(去掉一两个特征)
方案B:全部特征(即方案A的所有特征)
例如,我们可以定义:
方案A:去掉'GenHealth'和'PhysicalActivity'
方案B:全部特征
这样,我们就有两个不同的特征集。
或者,我们可以尝试其他拆分方式,比如:
方案A:仅包含人口统计特征(如AgeCategory, Sex)
方案B:包含所有特征
但为了满足题目要求,我们至少要有两个特征集。
因此,我们修改代码中的特征集定义部分:
假设原始数据列名为:
c("AgeCategory", "Sex", "Smoking", "Diabetic", "DiffWalking", "Stroke", "KidneyDisease", "GenHealth", "PhysicalActivity", "HeartDisease")
我们定义:
features_medical1 <- c("AgeCategory", "Sex", "Smoking", "Diabetic", "DiffWalking", "Stroke", "KidneyDisease")
features_medical2 <- c("AgeCategory", "Sex", "Smoking", "Diabetic", "DiffWalking", "Stroke", "KidneyDisease", "GenHealth", "PhysicalActivity") # 全部特征
这样,我们就有两个特征集:一个包含全部特征(即原始所有特征),另一个只包含部分特征。
注意:在创建任务时,我们使用的是整个数据集,所以全特征任务就是包含所有特征(除了目标变量)。然后我们创建两个子集任务。
因此,调整代码:
tasks <- list(
full = task_full, # 全特征(所有可用特征)
medical1 = task_full$select(features_medical1),
medical2 = task_full$select(features_medical2) # 实际上这个就是全特征,因为features_medical2包含了所有特征
)
但是,注意:我们的数据中只有9个特征(如错误信息所示),而features_medical2就是这9个特征。所以medical2和full是一样的。
为了避免重复,我们可以这样:
tasks <- list(
reduced = task_full$select(features_medical1), # 减少的特征集
full = task_full # 全部特征
)
这样,我们就有了两个特征集:减少的特征集(7个特征)和全特征集(9个特征)。
修改后的代码:
```r
# ... 前面的代码保持不变 ...
# 方案A:减少特征集(去掉GenHealth和PhysicalActivity)
features_reduced <- c("AgeCategory", "Sex", "Smoking", "Diabetic", "DiffWalking",
"Stroke", "KidneyDisease")
task_reduced <- task_full$select(features_reduced)
# 方案B:全特征(即原始所有特征,我们不再额外定义,直接使用task_full)
# 注意:task_full已经包含了所有特征(除了目标变量)
# 汇总所有任务
tasks <- list(
reduced = task_reduced,
full = task_full
)
# ... 后续代码保持不变 ...
```
这样,我们就有了两个特征集:reduced和full。
另外,注意在基准测试中,我们使用了三个任务:原来有full, medical, enhanced,现在改为两个:reduced和full。
同时,我们修改最佳模型选择后的任务选择代码,因为任务列表名称变了。
重新运行代码,应该可以避免上述错误。
但是,我们还需要注意:在读取学生数据时,学生数据中可能也没有BMI等特征,所以我们的特征集只能基于已有的特征。
因此,我们按照上述修改代码。
由于我们无法实际运行,这里提供修改后的完整代码。
修改后的完整代码:
</think>根据错误信息,问题出在创建 `task_enhanced` 时尝试使用了数据集中不存在的特征(BMI, PhysicalHealth, MentalHealth, SleepTime)。以下是修正后的完整解决方案:
```r
# —————————————————————— 1. 加载必要包 ——————————————————————
library(tidyverse)
library(mlr3verse)
library(readxl)
library(writexl)
# 若未安装,请先运行:
# install.packages(c("tidyverse", "mlr3verse", "readxl", "writexl"))
# —————————————————————— 2. 读取并预处理训练数据 ——————————————————————
# 读取原始数据
data_train <- read_excel("data_HeartDisease.xlsx")
# 检查实际存在的特征列
cat("实际存在的特征列:\n")
print(names(data_train))
# 转换所有字符列为因子
data_clean <- data_train %>%
mutate(across(where(is.character), as.factor))
# 创建 mlr3 分类任务
task_full <- as_task_classif(data_clean, target = "HeartDisease")
# —————————————————————— 3. 修正特征子集(基于实际数据)——————————————————————
# 获取所有可用特征
all_features <- setdiff(names(data_clean), "HeartDisease")
# 方案A:核心医学特征
features_medical <- c("AgeCategory", "Sex", "Smoking", "Diabetic", "DiffWalking",
"Stroke", "KidneyDisease", "GenHealth", "PhysicalActivity")
# 调整方案:仅保留数据集中实际存在的特征
features_medical <- intersect(features_medical, all_features)
task_medical <- task_full$select(features_medical)
# 方案B:随机选择不同特征组合(替代原增强方案)
set.seed(123)
features_random <- sample(all_features, size = length(all_features) - 2, replace = FALSE)
task_random <- task_full$select(features_random)
# 汇总所有任务
tasks <- list(
full = task_full,
medical = task_medical,
random = task_random
)
# —————————————————————— 4. 定义机器学习算法 ——————————————————————
learners <- list(
lrn("classif.rpart", predict_type = "prob"), # 决策树
lrn("classif.ranger", predict_type = "prob", num.threads = 1), # 随机森林
lrn("classif.log_reg", predict_type = "prob"), # 逻辑回归
lrn("classif.kknn", predict_type = "prob") # K近邻
)
# —————————————————————— 5. 设置5折交叉验证并执行基准测试 ——————————————————————
design <- benchmark_grid(
tasks = tasks,
learners = learners,
resamplings = rsmp("cv", folds = 5)
)
# 执行基准测试
bmr <- benchmark(design)
# —————————————————————— 6. 汇总性能并找出最佳模型 ——————————————————————
performance <- bmr$aggregate(msrs(c("classif.acc", "classif.auc")))
# 按准确率排序
performance <- performance[order(-classif.acc), ]
print(performance)
# 获取最佳模型配置
best_model <- performance[1, ]
cat("\n🏆 最佳模型配置:\n")
cat("特征集:", best_model$task_id, "\n")
cat("算法:", best_model$learner_id, "\n")
cat("准确率:", round(best_model$classif.acc, 4), "\n")
cat("AUC:", round(best_model$classif.auc, 4), "\n\n")
# —————————————————————— 7. 训练优化后的最佳模型 ——————————————————————
best_task <- tasks[[best_model$task_id]]
best_learner <- lrn(best_model$learner_id, predict_type = "prob")
# 添加超参数调优(所有模型类型)
library(mlr3tuning)
library(paradox)
# 通用调优设置
tuner <- function(learner) {
auto_tuner(
tuner = tnr("random_search"),
learner = learner,
resampling = rsmp("cv", folds = 3), # 简化调优过程
measure = msr("classif.acc"),
term_evals = 10
)
}
# 根据算法类型设置特定搜索空间
if (grepl("rpart", best_learner$id)) {
# 决策树调优
best_learner$param_set$values <- list(
cp = to_tune(0.01, 0.1),
minsplit = to_tune(5, 20),
maxdepth = to_tune(5, 15)
)
} else if (grepl("ranger", best_learner$id)) {
# 随机森林调优
best_learner$param_set$values <- list(
num.trees = to_tune(100, 500),
mtry = to_tune(1, sqrt(length(best_task$feature_names))),
min.node.size = to_tune(1, 10)
)
} else if (grepl("kknn", best_learner$id)) {
# KNN调优
best_learner$param_set$values <- list(
k = to_tune(3, 15)
)
}
# 执行调优
tuned_learner <- tuner(best_learner)
tuned_learner$train(best_task)
# —————————————————————— 8. 预测学生数据 ——————————————————————
# 读取待预测数据
data_student <- read_excel("student_HD.xlsx")
# 确保与训练数据结构一致
required_features <- best_task$feature_names
# 处理缺失列或类型不一致问题
for (col in required_features) {
if (!col %in% names(data_student)) {
stop("缺少必要特征:", col)
}
# 自动转换数据类型
if (is.factor(data_clean[[col]])) {
data_student[[col]] <- as.factor(data_student[[col]])
} else {
data_student[[col]] <- as.numeric(data_student[[col]])
}
}
# 提取有效输入数据
X_new <- data_student[, required_features, drop = FALSE]
# 进行预测
pred <- tuned_learner$predict_newdata(X_new)
# 创建结果数据框
result_df <- data_student %>%
mutate(
HeartDisease_Pred = pred$response,
Probability_Yes = pred$prob[, "Yes"],
Probability_No = pred$prob[, "No"]
)
# —————————————————————— 9. 导出预测结果 ——————————————————————
write_xlsx(result_df, "predicted_student_HD.xlsx")
# 输出完成信息
cat("✅ 预测完成!\n")
cat("📁 文件已保存:predicted_student_HD.xlsx\n")
cat("📊 总样本数:", nrow(result_df), "\n")
cat("🔍 使用特征:", paste(required_features, collapse = ", "), "\n")
cat("🎯 最佳模型:", best_model$learner_id, " (准确率:", round(best_model$classif.acc, 4), ")\n")
```
### 主要修正点解释:
1. **特征集调整**:
- 添加了特征存在性检查:使用 `intersect(features_medical, all_features)` 确保只使用数据集中实际存在的特征
- 替代了原增强方案:使用随机特征选择(`features_random`)作为替代方案
- 增加了特征调试输出:打印实际存在的特征列帮助调试
2. **通用调优框架**:
- 创建了统一的 `tuner()` 函数适用于所有算法类型
- 为不同算法设置特定超参数空间:
* 决策树:复杂度参数(cp)、最小分裂样本(minsplit)、最大深度(maxdepth)
* 随机森林:树数量(num.trees)、特征抽样数(mtry)、节点最小样本(min.node.size)
* KNN:邻居数量(k)
3. **数据类型自动转换**:
- 在预测阶段自动检测并转换数据类型:`if (is.factor(data_clean[[col]])) {...}`
4. **增强错误处理**:
- 添加了更详细的错误信息:`stop("缺少必要特征:", col)`
- 使用 `drop = FALSE` 防止单列时降维为向量
5. **结果格式优化**:
- 更清晰的列命名:`HeartDisease_Pred`, `Probability_Yes`, `Probability_No`
- 包含所有原始特征+预测结果
这个解决方案更健壮,能自动适应不同的特征组合,并为每种算法提供针对性的超参数优化。
阅读全文
