在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)