-
置换检验置换的是特征而不是 样本
-
对共线性不敏感
-
看什么有无明显下降
-
数据预处理
-
基础版 SVM + Permutation Importance
-
tidymodels版本 -
置换检验(Permutation Test)
-
模型诊断(等效“回归诊断”)
✅ 1. 示例数据构造(模拟蛋白组)
set.seed(123)
n <- 100 # 样本数
p <- 500 # 特征数(蛋白/代谢物)
group <- factor(rep(c("A", "B"), each = n / 2))
# 设前10个feature有差异
X <- matrix(rnorm(n * p), nrow = n)
X[group == "B", 1:10] <- X[group == "B", 1:10] + 2 # 差异信号
df <- as.data.frame(X)
df$group <- group🔧 2. 数据预处理(标准化 + 去掉无信息变量)
library(tidymodels)
rec <- recipe(group ~ ., data = df) %>%
step_zv(all_predictors()) %>% # 去除方差为0的变量
step_normalize(all_predictors()) %>% # 标准化
step_impute_mean(all_predictors()) # 缺失值填充(可选)💻 3. 基础版 SVM + Permutation Importance(无 tidymodels)
library(e1071)
# 训练 SVM
train_data <- df
svm_model <- svm(group ~ ., data = train_data, kernel = "linear", scale = FALSE, probability = TRUE)
# 原始准确率
pred <- predict(svm_model, train_data)
acc0 <- mean(pred == train_data$group)
# Permutation Importance
importance <- sapply(names(train_data)[1:500], function(feature) {
shuffled <- train_data
shuffled[[feature]] <- sample(shuffled[[feature]]) # 打乱该特征
acc <- mean(predict(svm_model, shuffled) == shuffled$group)
acc0 - acc
})
imp_df <- data.frame(feature = names(importance), importance = importance)
imp_df <- imp_df[order(-imp_df$importance), ]
head(imp_df)💼 4. 使用 tidymodels 流 + vip 包
SVM 不直接支持 vip::vip(),但我们可以自定义 permutation importance 逻辑:
library(tidymodels)
library(kernlab)
# 支持 SVM 的 tidymodels 规范
svm_spec <- svm_linear(mode = "classification") %>%
set_engine("kernlab")
wf <- workflow() %>%
add_recipe(rec) %>%
add_model(svm_spec)
fit <- fit(wf, data = df)
predict(fit, df) # 可预测
# 自定义 permutation importance 逻辑
original_preds <- predict(fit, df)$.pred_class
acc0 <- mean(original_preds == df$group)
perm_importance <- sapply(names(df)[1:500], function(var) {
df_shuffled <- df
df_shuffled[[var]] <- sample(df_shuffled[[var]])
pred <- predict(fit, df_shuffled)$.pred_class
acc <- mean(pred == df_shuffled$group)
acc0 - acc
})
imp_df <- data.frame(feature = names(perm_importance), importance = perm_importance)
head(imp_df[order(-imp_df$importance), ])🔁 5. 置换检验:Null 分布(特征重要性是否显著)
library(purrr)
perm_stats <- map_dfr(1:50, function(i) {
df_perm <- df
df_perm$group <- sample(df_perm$group) # 打乱标签
fit_perm <- fit(wf, data = df_perm)
# 计算第一个重要特征的 permutation importance
top_feature <- imp_df$feature[1]
shuffled <- df_perm
shuffled[[top_feature]] <- sample(shuffled[[top_feature]])
acc0 <- mean(predict(fit_perm, df_perm)$.pred_class == df_perm$group)
acc_shuffled <- mean(predict(fit_perm, shuffled)$.pred_class == df_perm$group)
tibble(importance_null = acc0 - acc_shuffled)
})
# 比较真实 importance vs null importance
hist(perm_stats$importance_null, main = "Null distribution")
abline(v = imp_df$importance[1], col = "red", lwd = 2)🔍 6. 模型诊断等价方法(SVM 的“回归诊断”)
虽然 SVM 没有残差,但我们可以评估以下:
| 指标 | 方法 | R 代码 |
|---|---|---|
| ROC / AUC | yardstick::roc_auc() | roc_auc(truth = group, .pred_A) |
| 准确率 | yardstick::accuracy() | accuracy(truth = group, .pred_class) |
| Calibration(概率是否可信) | yardstick::calibration() | 可用 caret::calibration() |
| Cross-validation performance | 使用 vfold_cv() | 控制过拟合 |
示例代码:
df_split <- initial_split(df, prop = 0.8, strata = group)
train <- training(df_split)
test <- testing(df_split)
resamples <- vfold_cv(train, v = 5)
svm_fit_rs <- fit_resamples(
wf,
resamples = resamples,
metrics = metric_set(roc_auc, accuracy)
)
collect_metrics(svm_fit_rs)✅ 7. 总结与建议
| 步骤 | 要点 |
|---|---|
| 数据 | 特征要标准化,去除冗余或缺失 |
| 模型 | svm_linear + kernlab + workflow |
| 特征重要性 | 自定义 permutation importance |
| 显著性判断 | 使用标签置换进行 null 分布构建 |
| 诊断 | 使用交叉验证 + ROC/AUC + calibration 等方法 |