########## caret 包总结 ###########使用caret::mdrr1、降维a)删除的变量是常数自变量，或者是方差极小的自变量:nearZeroVar:诊断预测变量是唯一值(即0方差自变量)nearZeroVar(x, freqCut = 95/5, uniqueCut = 10, saveMetrics = FALSE)参数:x:只能为数值numeric vector，matrix，data framefreqCut :第一众数 与 第二众数的比率的cutoff(临界值)(比如100个数值,有95个1，5个0；第一众数为95，第二众数为0，比率为95/5)uniqueCut: 剔重后的唯一值 与 样本总数量的百分比 (上例为 2/100),大于这个值不会被剔除saveMetrics:如果为T，返回样本每个属性的freqRatio,percentUnique,以及判定结果(zeroVar[0方差只有一个值],nzv[近似0方差(通过前两个参数判定)])
来看看函数写的?
帮助文档detail的例子写的很详细
test <- function(x,freqCut=95/5,uniqueCut=10,saveMetrics=FALSE)
{
if(is.vector(x))
x<-matrix(x,ncol=1)
# 按列处理
freqRatio<-apply(x,2,function(data){
# 频数表
t<-table(data[!is.na(data)])
# 如果matrix按列统计频率,只有唯一值(rep(3,5)) 或 被考察matrix为空，返回值为0 并 跳出函数
if(length(t)<=1){
return(0)
}
# 取出频数表中频数最大的下标
w<-which.max(t)
# 计算频数表最大的频数(第一众数) / 求除去第一众数的下标剩下的所有频数最大的值(第二众数);max忽略缺失值
return(max(t,na.rm=TRUE)/max(t[-w],na.rm=TRUE))
})
print(freqRatio)
# 计算matrix x按列 非NA的唯一值的数量(长度)
lunique<-apply(x,2,function(data)length(unique(data[!is.na(data)])))
# (唯一值的数量/列的总数量)*100
percentUnique<-100*lunique/apply(x,2,length)
print(percentUnique)
# 该列只有一个唯一值(该列为常量) 或 x都为NA
# all:的参数为逻辑型is.na(data),返回逻辑向量(T|F),all:所有为T,返回T，否则为F；另外还有any():只要有一个即可
# 返回逻辑向量
zeroVar<-(lunique==1)|apply(x,2,function(data)all(is.na(data)))
print(zeroVar)
# 默认为F,如果为真,返回c(1,2)众数占比,unique唯一值总数占总数的比例，
# c(1,2)占比大于阈值freqCut并且唯一值比例小于阈值uniqueCut 或 0方差[常数] 逻辑型[T/F]
if(saveMetrics){
out<-data.frame(freqRatio=freqRatio,percentUnique=percentUnique,
zeroVar=zeroVar,nzv=(freqRatio]]]]>freqCut&percentUnique<=
uniqueCut)|zeroVar)
}
else{
# freqRatio,percentUnique(列计算后的向量),三个向量从index=1开始，一一对应,进行判断条件
#满足条件时(TRUE),返回对应的下标(不区分是那个向量的下标),也就是源数据属性的下标,
#out:问题数据就out了(形象),比如matrix为10列，其中3，5列为问题属性列,返回值即为3，5
out<-which((freqRatio]]]]>freqCut&percentUnique<=
uniqueCut)|zeroVar)
names(out)<-NULL
}
out
}findCorrelation: This function searches through a correlation matrix and returns a vector of integers corresponding to columns to remove to reduce pair-wise correlations.
1、通过对相关系数矩阵的查找,返回一个整数向量。这个整数向量对应具有很高相关性的 一对属性列的下标
The absolute values of pair-wise correlations are considered. If two variables have a high correlation, the function looks at the mean absolute correlation of each variable and removes the variable with the largest mean absolute correlation.
2、计算的是一对相关系数的绝对值(abs)。如果 两个变量有很高的相关系数, 那么函数将会探查 每一个变量相关系数的绝对值的均值 并且删除具有最大绝对值相关系数均值的变量 即：找出均值最大的相关系数的变量,返回下标
findCorrelation <- function (x, cutoff = 0.9, verbose = FALSE) { varnum <- dim(x)[1] if (!isTRUE(all.equal(x, t(x)))) stop("correlation matrix is not symmetric") if (varnum == 1) stop("only one variable given") # 相关系数矩阵的每一个元素取绝对值 x <- abs(x) originalOrder <- 1:varnum # 对向量取均值(这里单独写成函数,是避免apply函数使用mean时,无法使用na.rm=T 的选项) # 例如:apply(tmp, 2, mean) 此时如果tmp有NA，将会返回NA averageCorr <- function(x) mean(x, na.rm = TRUE) # 系数矩阵另存变量 tmp <- x # 对角阵设置NA diag(tmp) <- NA # 按列计算 已经绝对值处理过的相关系数矩阵tmp 的均值, 然后降序排序(即当前变量与其它变量的相关性) # 找出最相关的属性变量降序排序,返回值为排序的下标vector maxAbsCorOrder <- order(apply(tmp, 2, averageCorr), decreasing = TRUE) print("maxAbsCorOrder") print(maxAbsCorOrder) # expample: # abscor <- abs(cor(iris[,-5]));maxAbsCorOrder = 3 4 1 2 # 下面的生成的x即为:第3行，第3列(3,3) 重新排序到第1行，第1列(1,1), # 第3行,第4列(3,4)-->第2行,第1列(2,1); # 即以3 4 1 2 为索引,将排序后的matrix,按列排序 x <- x[maxAbsCorOrder, maxAbsCorOrder] newOrder <- originalOrder[maxAbsCorOrder] print("newOrder") print(newOrder) # 删除列下标 deletecol <- 0 print(x) # 循环已经按照相关系数大小排序后的 matrix 进行循环,如果每一个元素大于指定的阈值(cutoff), # 并且 for (i in 1:(varnum - 1)) { for (j in (i + 1):varnum) { if (!any(i == deletecol) & !any(j == deletecol)) { if (verbose) cat("Considering row\t", newOrder[i], "column\t", newOrder[j], "value\t", round(x[i, j], 3), "\n") # 如果x[i,j] 相关系数 大于 指定的阈值(如0.9) if (abs(x[i, j]) > cutoff) { # 1、举例:比如c(1,2)元素相关系数为0.98,那么意味着,第一个和第二个元素相关性超出阈值 # 那么取出哪个作为相关性最大的属性呢? # 思路: # 1、统计第一个属性与其它属性的相关系数(即除去本节点外的其它行元素的均值) # 2、第二个元素与其它元素的均值(去除当前节点) # 3、如果第一个元素与其它元素均值大于 第二个元素与其它元素相关系数的均值,则取第一个元素的下标 # 4、并且unique 剔重 # 5、否则，将第二个元素的下标取出 if (mean(x[i, -i]) > mean(x[-j, j])) { deletecol <- unique(c(deletecol, i)) if (verbose) cat(" Flagging column\t", newOrder[i], "\n") } else { deletecol <- unique(c(deletecol, j)) if (verbose) cat(" Flagging column\t", newOrder[j], "\n") } } } } } # 最开始deletecol赋值为0,此时剔除掉 deletecol <- deletecol[deletecol != 0] # newOrder为按照列计算相关系数均值降序排序的 向量vector,如c(3,4,2,1), # deletecol:按照系数降序排序的只取出最大相关系数均值的 下标 newOrder[deletecol] }
preProcess：函数将多个函数进行了整合
例如: 1、如果使用methods = "bagImpute", 即使用装袋法的方式,拟合数据，那么看看preProcess是如何处理的?
命令行: preProcess 函数返回片段(找到与bagImpute调用的代码段) if (any(method == "bagImpute")) { if (verbose) cat("Computing bagging models for each predictor...") # bagModels <- as.list(colnames(x)) # 给列表定义名称(名称和列表内容一致) names(bagModels) <- colnames(x) bagModels <- lapply(bagModels, bagImp, x = x) if (verbose) cat(" done\n") }
关键代码为: bagModels <- lapply(bagModels, bagImp, x = x) 对数据x(数值型 的 matrix 或者 data frame)，对x使用bagImp方法进行拟合k紧邻，其中bagModels为数据框x的属性名称，类型必须为list。为什么呢？看bagImp方法 命令行: bagImp # Error: object 'bagImp' not found methods(bagImp) # Error: object 'bagImp' not found
getAnywhere(bagImp) # 最后一招奏效 描述 A single object matching 'bagImp' was foundIt was found in the following places namespace:caretwith value函数定义:
function (var, x, B = 10){ # 加载bagging的包ipred library(ipred) # 转换为数据框 if (!is.data.frame(x)) x <- as.data.frame(x) # 拟合(结合preProcess调用处的代码,即 var = bagModels, x = x, nbagg = 10) # mod <- bagging(as.formula(paste(var, "~.")), data = x, nbagg = B) list(var = var, model = mod)}<environment: namespace:caret>
> ma [,1] [,2] [,3] [,4] [1,] 1 5 9 13 [2,] 2 6 10 14 [3,] 3 7 11 15 [4,] 4 8 12 16 > colnames(ma) <- c("v1","v2","v3","v4") > ma v1 v2 v3 v4 [1,] 1 5 9 13 [2,] 2 6 10 14 [3,] 3 7 11 15 [4,] 4 8 12 16 > ma.list <- as.list(colnames(ma))> ma.list[[1]][1] "v1"
[[2]][1] "v2"
[[3]][1] "v3"
[[4]][1] "v4"
> names(ma.list) <- colnames(ma)> ma.list$v1[1] "v1"
$v2[1] "v2"
$v3[1] "v3"
$v4[1] "v4"
> as.formula(paste(ma.list,"~.")) v1 ~ . > fora <- as.formula(paste(ma.list,"~.")) > class(fora) [1] "formula" 为什么去掉as.fornula 之后，结果是下面这样呢？看看as.formula > paste(ma.list,"~.") [1] "v1 ~." "v2 ~." "v3 ~." "v4 ~."
看看会不会去掉v2以后的内容 function (object, env = parent.frame()) { if (inherits(object, "formula")) object else { rval <- formula(object, env = baseenv()) if (identical(environment(rval), baseenv()) || !missing(env)) environment(rval) <- env rval } }
paste(ma.list,"~.")[1] [1] "v1 ~." > paste(ma.list,"~.")[2] [1] "v2 ~."
formula会默认取第一个