如何处理数据集中高度相关的特征变量
作者: 江俊
时间: “2018/03/25”
以下所有代码均使用R语言
数据集下载地址：https://download.csdn.net/download/smallernovice/10307411
问题描述
聚类分析以及回归分析中经常会遇到特征变量之间高度相关的问题，常规做法是计算变量之间的相关关系矩阵，从中发现相关性高于某个值（比如0.8）的两个变量，然后将其中一个删除（一般做法），问题是当面对数量很多的特征变量时，相关系数矩阵很大，在R语言中观察很容易遗漏并且相当麻烦，因此开始思考能不能建立一个函数自动完成这些变量的筛选以及删除操作，于是有了如下的代码，注释中包含了思考过程。
- 为什么会有这段代码：
关于回归分析和聚类分析中，挑选自变量相关性比较低的问题，每次都需要从关系矩阵中肉眼查看，感觉很累而且容易漏，所以自己写了个代码，虽然还是要自己进行挑选，不过已经少了很多工作量，下面是代码，最后是输出结果： - 代码：
rm(list=ls())
setwd("G:\\第20期\\案例分析\\客户分群")
#读取数据
data<-read.csv("practice_sample.csv")
sum(is.na(data))
#包含缺失值的变量
var_na<-data[,colSums(is.na(data))>0]
#不包含缺失值的变量
var_na_no<-data[,colSums(is.na(data))==0]
#对含缺失值变量按缺失值的数量排序显示
sort(colSums(is.na(var_na)),decreasing = T)- 输出结果：
Warning message:
In strsplit(code, "\n", fixed = TRUE) :
input string 1 is invalid in this locale
[1] 222723
VW263 VW166 VW043 XB851 XB843 DS907 AU002 DS776
122377 35201 21271 17389 17389 7278 976 842 - 自定义函数筛选相关系数高的特征变量
#代码演示，此处只使用不含缺失值的变量
x<-data.frame(scale(var_na_no))
#计算相关系数矩阵
c<-cor(x)
#自定函数：筛选出相关性高于0.5的变量(数值可选)
select_x<-function(c,m){ # x:相关系数矩阵, m:相关系数
#将相关性高于m的系数取1，即目标变量
c<-ifelse(c>m,1,0)
c<-as.data.frame(c)
n<-nrow(c)
#避免重复选取组合，将上三角矩阵全部设置成0(非目标变量)
for(i in 1:n){
for(j in 1:n){
c[i,j]<-ifelse(i>j,c[i,j],0)
}
}
#求出符合条件的索引
index<-which(c==1)[!(which(c==1) %in% c((1:n)^2))]
#列号
index_c<-ifelse(index %% n==0,n,index %% n)
#行号
index_r<-(index-index_c) %/% n
#名称
c$name<-row.names(c)
#第二个变量名
name_index_c<-c$name[index_c]
#第一个变量名
name_index_r<-c$name[index_r]
#输出结果
cat("\n自变量中相关系数大于",m,"的所有组合如下所示：\n")
for(i in 1:length(name_index_r)){
cat(" ",i,":",name_index_r[i],"---",name_index_c[i],"\n")
}
#返回需要删除的变量名
return(unique(name_index_c))
}
#需要删除的变量名
delete_varname<-select_x(c,0.8)
#显示需要删除的变量的名字
cat("需要删除的变量名是：\n")
delete_varname
#在原始数据中删除高度相关的变量
x_n<-x[,!(colnames(x) %in% delete_varname)]- 输出结果：
Warning message:
In strsplit(code, "\n", fixed = TRUE) :
input string 1 is invalid in this locale
自变量中相关系数大于 0.8 的所有组合如下所示：
1 : AU004 --- R1_AU004
2 : AU009 --- R1_AU009
3 : AU010 --- R1_AU010
4 : AU023 --- R1_AU023
5 : AU029 --- R1_AU029
6 : AU011 --- R1_AU011
7 : MD037 --- R1_MD037
8 : MD038 --- R1_MD038
9 : MD040 --- R1_MD039
10 : MV001 --- R1_MV001
11 : MD001 --- R1_MD001
12 : MV029 --- R1_MV029
需要删除的变量名是：
[1] "R1_AU004" "R1_AU009" "R1_AU010" "R1_AU023" "R1_AU029" "R1_AU011"
[7] "R1_MD037" "R1_MD038" "R1_MD039" "R1_MV001" "R1_MD001" "R1_MV029"
[13] "R1_MV044"#删除完成后再次检查相关性
c<-cor(x_n)
delete_varname<-select_x(c,0.8)
x_n<-x_n[,!(colnames(x_n) %in% delete_varname)]
#检查之后发现无高度相关的变量了
c<-cor(x_n)
delete_varname<-select_x(c,0.8)- 输出检查结果：
Warning message:
In strsplit(code, "\n", fixed = TRUE) :
input string 1 is invalid in this locale
自变量中相关系数大于 0.8 的所有组合如下所示：
1 : MD039 --- R1_MD040
自变量中相关系数大于 0.8 的所有组合如下所示：
1 : NA --- NA
0 : --- 从结果可以看出剩余的特征变量相互之间的相关程度均小于0.8了。
如何处理选取数据集中的主成分
问题描述
一个数据集中的主成分是原始特征变量的线性组合，包含了大部分原始数据的信息，但是如何选取选成分的个数呢？我们可设定包含原始数据百分之N（假设是80%）信息的主成分就是我们想要的。
直接上代码,注释中包含了思考过程：
#使用最后的变量进行主成分分析
#快速添加主成分
main_element<-function(x,p){ #x:数据 p:希望主成分达到至少多少信息占比
sigma<-cov(x)
primary<-eigen(sigma)
#需要进行主成分分析的变量数，自动计算
n<-ncol(x)
#为主成分命名
c<-("F1")
for(i in 2:n){
c<-c(c,paste0("F",i))
}
#把主成分的值添加到原数据中
for(i in 1:n){
x<-cbind(x,t(primary$vectors[,i] %*% t(x[,1:n])))
}
colnames(x)[seq(n+1,2*n,by=1)]=c
#计算数据中的主成分的方差，比较与特征值的计算结果是否相同
F_var<-sapply(x[,seq(n+1,2*n,by=1)],var)
#计算方差占比
var_prop<-F_var/sum(F_var)
#计算累计方差占比,先赋初值后修改
var_prop_sum<-var_prop
#计算累计值
for(i in 2:n){
var_prop_sum[i]<-var_prop_sum[i]+var_prop_sum[i-1]
}
#输出结果
cat("\n------主成分方差------|-----数据中主成分方差计算结果为---|---占比---|---累计占比------\n")
for(i in 1:n){
cat(" ",c[i],":",round(primary$values[i],6)," ",round(F_var[i],6)," ",round(var_prop[i],6)," ",round(var_prop_sum[i],6),"\n")
}
cat("\n主成分方差之和为：",sum(primary$values)," ",sum(F_var),"\n")
#因为计算机做不到完全等于零，只能使用一个极小值
if(sum(primary$values)-sum(F_var)<=1e-12){
cat("\n------------恭喜你运算成功了！得到了正确答案------------\n")
}else{
cat("\n---------哦好像有点不对，程序肯定没毛病，我保证---------\n")
}
#寻找主成分个数，可自定义信息占比
cat("你希望主成分的信息占比达到：",p,"\n")
#主成分名称索引，用来索引最后输出的满足信息占比的主成分
index<-n
for(i in 1:n){
if(var_prop_sum[i]>=p){
index<-i
break
}else{
index<-index
}
}
cat("选取以下主成分即可满足条件：",c[1:i],"\n","信息占比达到了：",var_prop_sum[i],"\n")
return(x)
}
#调用函数,自动生成主成分
X<-main_element(x_n,0.8)- 输出结果：
Warning message:
In strsplit(code, "\n", fixed = TRUE) :
input string 1 is invalid in this locale
------主成分方差------|-----数据中主成分方差计算结果为---|---占比---|---累计占比------
F1 : 4.689037 4.689037 0.203871 0.203871
F2 : 2.794819 2.794819 0.121514 0.325385
F3 : 2.197071 2.197071 0.095525 0.42091
F4 : 1.900431 1.900431 0.082627 0.503537
F5 : 1.135796 1.135796 0.049382 0.55292
F6 : 1.016926 1.016926 0.044214 0.597134
F7 : 0.932838 0.932838 0.040558 0.637692
F8 : 0.892267 0.892267 0.038794 0.676486
F9 : 0.852577 0.852577 0.037069 0.713555
F10 : 0.77263 0.77263 0.033593 0.747147
F11 : 0.729279 0.729279 0.031708 0.778855
F12 : 0.649599 0.649599 0.028243 0.807099
F13 : 0.602 0.602 0.026174 0.833273
F14 : 0.546778 0.546778 0.023773 0.857046
F15 : 0.519842 0.519842 0.022602 0.879647
F16 : 0.476207 0.476207 0.020705 0.900352
F17 : 0.432067 0.432067 0.018786 0.919138
F18 : 0.386693 0.386693 0.016813 0.93595
F19 : 0.358755 0.358755 0.015598 0.951548
F20 : 0.332781 0.332781 0.014469 0.966017
F21 : 0.309065 0.309065 0.013438 0.979455
F22 : 0.268893 0.268893 0.011691 0.991146
F23 : 0.20365 0.20365 0.008854 1
主成分方差之和为： 23 23
------------恭喜你运算成功了！得到了正确答案------------
你希望主成分的信息占比达到： 0.8
选取以下主成分即可满足条件： F1 F2 F3 F4 F5 F6 F7 F8 F9 F10 F11 F12
信息占比达到了： 0.8070987 主成分也已经选出来了，快使用这些主成分去做回归分析或者聚类分析吧！
转载请注明出处
3165
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
