資料分析學習體驗——特徵變數相關係數和主成分分析
阿新 • • 發佈：2019-01-09
如何處理資料集中高度相關的特徵變數
作者: 江俊
時間: “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 - 輸出結果：
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 - 自定義函式篩選相關係數高的特徵變數
#程式碼演示，此處只使用不含缺失值的變數
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 主成分也已經選出來了，快使用這些主成分去做迴歸分析或者聚類分析吧！
轉載請註明出處