在caret（short for classification and regression training）包中有多个函数可以实现特征选择，总的分为封装法和过滤法。封装法，将特征选择过程与训练过程融合在一起，以模型的预测能力作为特征选择的衡量标准。封装法可以选出高质量的变量子集，但运行速度上会大打折扣。在caret包中，封装法有递归特征消除(recursive feature elimination：rfe)算法，遗传算法（genetic algorithms：ga）和模拟退火（Simulated annealing：sa）算法。过滤法的特征选择与训练过程相互独立，通过分析变量内部的关系进行筛选操作，与训练模型的选择并没有关系。过滤法通过变量间的相关性、近零方差检验、聚类分析等方法选择出来的变量，再用于不同的训练模型构建、评估等。过滤法虽然在速度上比封装法更占优势，但可能会删除非常有实质意义的变量。caret包中的过滤法有Selection By Filtering (SBF)。
递归特征消除(recursive feature elimination RFE)算法
RFE算法是基于预测器重要性排序的预测器向后选择。在建模之前，对预测因子进行排序，不太重要的因子依次剔除。其目标是找到可以用于生成准确模型的预测器子集。http://topepo.github.io/caret/recursive-feat-elimination。
使用rfeControl() 对特征选择的参数进行选择，使用ref() 返回特征筛选结果。
下面主要讲解每个函数里参数表示的含义及选择的标准。
Usage (默认参数设置)
rfeControl(
functions = NULL,
rerank = FALSE,
method = "boot",
saveDetails = FALSE,
number = ifelse(method %in% c("cv", "repeatedcv"), 10, 25),
repeats = ifelse(method %in% c("cv", "repeatedcv"), 1, number),
verbose = FALSE,
returnResamp = "final",
p = 0.75,
index = NULL,
indexOut = NULL,
timingSamps = 0,
seeds = NA,
allowParallel = TRUE
)
Arguments
functions #functions选择用什么样的模型进行自变量排序，可以选择的有rfFuncs（随机森林），lmFuncs（线性回归），nbFuncs（朴素贝叶斯，只能用于分类），treebagFuncs（装袋决策树），ldaFuncs（只能用于分类），lrFuncs，caretFuncs。
rerank #逻辑值：每次计算的变量重要性是否删除
method #样本重采样方法，用于重复训练/测试集的分割：boot、cv、LOOCV或LGOCV
saveDetails #逻辑值：从选择过程中保存预测和变量的重要性
number #重采样迭代的次数，默认如果method是"cv"或者"repeatedcv"，number=10，其余为25。可自定义迭代次数。
repeats #只对重复的k折叠交叉验证，要计算的折叠完整集的数目，如果method是"cv"或者"repeatedcv"，repeats=1，其余的话与number取值一致。
Verbose # 逻辑值：是否打印每次重采样迭代的记录
returnResamp #字符串（“final”, “all” or “none”）：指示保存多少重采样的摘要指标。
p #训练集占所有样本的比例。
index #列表or NULL：指定样本进行迭代训练，每个列表元素代表用于迭代训练的样本行。
indexOut #列表or NULL：指定每次取样都要保留的样品。如果为NULL，则使用index中不包含的唯一样本集。
timingSamps #数值：输入训练集样本的数目，估计预测样本所需的时间。0则代表不需要估计。
seeds # 整数集or NA or NULL or列表：整数集表示每次重采样迭代时的种子；NA值代表工作中不设置种子；NULL值代表使用一组随机整数设置种子。也可以使用列表，列表应该有B+1个元素，其中B是重复采样的数量。列表的前B个元素应该是长度为P的整数的向量，其中P是被求值的子集的个数(包括整个集合)，列表的最后一个元素只需要是一个整数(对于最终的模型)。
allowParallel #逻辑值：如果加载了一个并行后端并可用，函数是否应该使用它
用法
rfe(
x,
y,
sizes = 2^(2:4),
metric = ifelse(is.factor(y), "Accuracy", "RMSE"),
maximize = ifelse(metric == "RMSE", FALSE, TRUE),
rfeControl = rfeControl(),
...
)
参数
x, #矩阵或数据框：训练集的特征矩阵或数据框，该对象必须有唯一的列名。
y, #向量：训练集的结果向量，数值型向量（regression）或因子型向量（classification）
sizes #向量：程序要测试的特征数目.
metric #字符串：后续模型总结使用的维度。regression使用"RMSE" 和"Rsquared"；classification使用"Accuracy" and "Kappa"。
maximize # 逻辑值，如果metric=“RMSE”，则为FALSE，否则为TRUE
rfeControl # 模型参数
ref()返回的是一个列表。内容包含
Example
1、回归预测：使用lmFuncs，rfFuncs和treebagFuncs分别进行特征筛选，选择最优模型筛选的特征。
data(BloodBrain)
data(BloodBrain)
x <- scale(bbbDescr[,-nearZeroVar(bbbDescr)])
x <- x[, -findCorrelation(cor(x), .8)]
x <- as.data.frame(x, stringsAsFactors = TRUE)
inTrain <- createDataPartition(logBBB, p = .75, list = FALSE)[,1]
trainx <- x[ inTrain, ]
testx <- x[-inTrain, ]
trainy <- logBBB[ inTrain]
testy <- logBBB[-inTrain]
set.seed(1)
lmProfile <- rfe(trainx, trainy,
sizes = c(2, 4, 6, 8, 15, 30,45,60,length(x)),
rfeControl = rfeControl(functions = lmFuncs))
set.seed(1)
#耗时
rfFuncs <- rfe(trainx, trainy,
sizes = c(2, 4, 6, 8, 15, 30,45,60,length(x)),
rfeControl = rfeControl(functions = rfFuncs))
set.seed(1)
treebagFuncs <- rfe(trainx, trainy,
sizes = c(2, 4, 6, 8, 15, 30,45,60,length(x)),
rfeControl = rfeControl(functions = treebagFuncs))
比较不同模型的性能
xyplot(lmProfile$results$RMSE + rfFuncs$results$RMSE + treebagFuncs$results$RMSE ~
lmProfile$results$Variables,ylab = "RMSE",xlab = "Variables",
type = c("g", "p", "l"),
auto.key = TRUE)
xyplot(lmProfile$results$Rsquared + rfFuncs$results$Rsquared + treebagFuncs$results$Rsquared ~
lmProfile$results$Variables,ylab = "Rsquared",xlab = "Variables",
type = c("g", "p", "l"),
auto.key = TRUE)
返回最优RMSE的特征数量
lmProfile$bestSubset
rfFuncs$bestSubset
treebagFuncs$bestSubset
postResample(predict(lmProfile, testx), testy)
postResample(predict(rfFuncs, testx), testy)
postResample(predict(treebagFuncs, testx), testy)
结论：可以看到虽然随机森林的方法在测试集和验证集的性能均达到最优（RMSE最低，Rsquared最高），但是保留了所有的特征，并没有起到特征筛选的作用；线性回归虽然在测试集中保留15个特征可以使模型达到最优，但是在验证集的性能却要差一点。所以，实际使用的时候，还是要根据项目需求来选择是否要对特征进行筛选，然后进行下一步的模型构建。
2、分类预测ldaFuncs只能用于分类
data(mdrr)
mdrrDescr <- mdrrDescr[,-nearZeroVar(mdrrDescr)]
mdrrDescr <- mdrrDescr[, -findCorrelation(cor(mdrrDescr), .8)]
set.seed(1)
inTrain <- createDataPartition(mdrrClass, p = .75, list = FALSE)[,1]
train <- mdrrDescr[ inTrain, ]
test <- mdrrDescr[-inTrain, ]
trainClass <- mdrrClass[ inTrain]
testClass <- mdrrClass[-inTrain]
set.seed(2)
ldaProfile <- rfe(train, trainClass,
sizes = c(1:10, 15, 30),
rfeControl = rfeControl(functions = ldaFuncs,method = "cv"))
set.seed(2)
nbFuncs <- rfe(train, trainClass,
sizes = c(1:10, 15, 30),metric="Accuracy",
rfeControl = rfeControl(functions = nbFuncs,method = "cv"))
set.seed(2)
lrFuncs <- rfe(train, trainClass,
sizes = c(1:10, 15, 30),
rfeControl = rfeControl(functions = lrFuncs,method = "cv"))
set.seed(2)
caretFuncs <- rfe(train, trainClass,
sizes = c(1:10, 15, 30),
rfeControl = rfeControl(functions = caretFuncs,method = "cv"))
xyplot(ldaProfile$results$Accuracy + nbFuncs$results$Accuracy + lrFuncs$results$Accuracy ~
ldaProfile$results$Variables,ylab = "Accuracy",xlab = "Variables",
type = c("g", "p", "l"),
auto.key = TRUE)
xyplot(ldaProfile$results$Kappa + nbFuncs$results$Kappa + lrFuncs$results$Kappa ~
ldaProfile$results$Variables,ylab = "Kappa",xlab = "Variables",
type = c("g", "p", "l"),
auto.key = TRUE)
postResample(predict(ldaProfile, test), testClass)
postResample(predict(nbFuncs, test), testClass)
postResample(predict(lrFuncs, test), testClass)
