PCA主成分分析和因子分析筆記_數學建模系列 PCA主成分分析和因子分析筆記_數學建模系列

轉載自：https://blog.csdn.net/dearrita/article/details/52202258

PCA主成分分析和因子分析筆記_數學建模系列

2016年08月13日 23:07:27 thermodynamicB 閱讀數：3740

																														</div>
			<div class="operating">
								</div>
		</div>
	</div>
</div>
<article class="baidu_pl">
	<div id="article_content" class="article_content clearfix csdn-tracking-statistics" data-pid="blog" data-mod="popu_307" data-dsm="post">
							<div class="article-copyright">
              					<svg class="icon" title="CSDN認證原創" aria-hidden="true" style="width:53px; height: 18px; vertical-align: -4px;">
						<use xmlns:xlink="http://www.w3.org/1999/xlink" xlink:href="#CSDN_Cert"></use>
				</svg>
              					
				版權聲明：本文爲博主原創文章，未經博主允許不得轉載。					https://blog.csdn.net/DearRita/article/details/52202258				</div>
							            <div id="content_views" class="markdown_views">
						<!-- flowchart 箭頭圖標 勿刪 -->
						<svg xmlns="http://www.w3.org/2000/svg" style="display: none;"><path stroke-linecap="round" d="M5,0 0,2.5 5,5z" id="raphael-marker-block" style="-webkit-tap-highlight-color: rgba(0, 0, 0, 0);"></path></svg>
						<h1 align="center" id="pca主成分分析和因子分析筆記數學建模系列"><a name="t0"></a>PCA主成分分析和因子分析筆記_數學建模系列</h1>

---

這裏的主成分分析和因子分析爲兩種降維方法。

什麼時候要降維呢？

當需要對一個樣本集中的樣本進行排序時，可能有多個維度可以對這些樣本進行評價，但維度過多會造成不變，因此我們希望能夠用更少的維度評價，同時儘量減少評價的準確度損失。

主成分分析，簡單來說，就是直接選擇對評價結果貢獻度較高的幾個維度，或者直接去掉對評價結果貢獻度較低的幾個維度；（公式參考）
因子分析，則是以已知的所有維度爲基礎，創造數量更少的全新的一組維度來進行評價。先對原始的一組維度進行相關性分析，合併相關性高的，保留相關性低的。或者說，找出一組能夠『代表』原維度組的新維度，同時能保留新維度組沒有涵蓋的特色部分。（公式參考）

1. 主成分分析（PCA）：

1） in R

數據要求：
m∗∗n（除去表頭）的矩陣，樣本集大小爲m，屬性個數爲n；或說有m個待評價目標，評價因子個數爲n。
每列表頭爲因子/屬性名，每行表頭爲一個目標/樣本集中的一個樣本，每行內容爲各因子對此目標（的某種評價）的貢獻值/此樣本的各項屬性值。

## 數據讀入 ##
industryData <- read.csv("*C:\\Users\\lenovo\\Desktop\\1.csv*", header = TRUE, sep = ",")
X <- industryData[,-1]

## 計算相關係數矩陣和特徵值、特徵向量 ##
industry.cor <- cor(X)
industry.cor
industry.eig <- eigen(industry.cor)
industry.eig

## 主成分分析並生成報表 ##
industry.pr <- princomp(X, cor = TRUE)
summary(industry.pr, loadings = TRUE)

## 繪圖 ##
screeplot(industry.pr, type = "lines") #繪製碎石圖
biplot(industry.pr, choices = 1:2) #繪製關於第1主成分和第2主成分的散點圖

## 製作彙總表 ##
field = as.character(industryData[, 1]) #提取出第一列的中文
result = cbind(field, as.data.frame(scale(X))) #變量標準化並組成新的表格
numOfCharacter <- 3 #提取的特徵數
industry.predict <- predict(industry.pr) #計算樣本的主成分
result = cbind(result, industry.predict[,1:numOfCharacter]) #將計算出的主成分得分加載在標準化數據表格之後

## 計算每個提取的主成分的方差貢獻率 ##
varProportion <- numeric(numOfCharacter) 
for (i in 1:length(varProportion))
{
  varProportion[i] <- industry.eig$values[i]/sum(industry.eig$values);
}

## 計算每個觀測的總得分 ##
totalScore <- numeric(nrow(industry.predict))
for (i in 1:length(totalScore))
{
  for (j in 1:length(varProportion))
  {
    totalScore[i] = totalScore[i] + varProportion[j] * industry.predict[i, j];
  }
}
result = cbind(result, totalScore) #將總得分加載在最後一列

## 對所有觀測按照總得分降序排列 ##
library(plyr)
resultDescent = arrange(result, desc(totalScore))
output <- cbind(as.character(resultDescent$field), as.data.frame.numeric(resultDescent$totalScore))
names(output) <- c("field", "total score")
output

• 1
• 2
• 3
• 4
• 5
• 6
• 7
• 8
• 9
• 10
• 11
• 12
• 13
• 14
• 15
• 16
• 17
• 18
• 19
• 20
• 21
• 22
• 23
• 24
• 25
• 26
• 27
• 28
• 29
• 30
• 31
• 32
• 33
• 34
• 35
• 36
• 37
• 38
• 39
• 40
• 41
• 42
• 43
• 44
• 45
• 46
• 47
• 48
• 49
• 50

2） in matlab

數據要求：
m∗∗n（除去表頭）的矩陣，樣本集大小爲n，屬性個數爲m；或說有n個待評價目標，評價因子個數爲m。

%讀入數據
x=xlsread(‘*data*’);

%求算標準差
sd=std(x);

%對原始數據標準化
n=size(x,1);
jj=ones(n,1);
jj=jj*sd;
x=x./jj;

%對x數據進行主成分分析
[t,score,r]=princomp(x);

%%以下爲繪圖示例2例
%%例1
x=score(:,1:2);%取前兩個主成分（的得分）
idx=kmeans(x,5);%用k-means法聚類（分爲5類）
%繪圖
str=num2str([1:n]');
figure(1),clf
plot(x(:,1),x(:,2),'o')
text(x(:,1),x(:,2)+.5,str,'fontsize',12)
hold on
for i=1:n
    if idx(i)==1
        plot(x(i,1),x(i,2),'o','markerfacecolor','b')
    elseif idx(i)==2
        plot(x(i,1),x(i,2),'o','markerfacecolor','g')
    elseif idx(i)==3
        plot(x(i,1),x(i,2),'o','markerfacecolor','c')
    elseif idx(i)==4
        plot(x(i,1),x(i,2),'o','markerfacecolor','r')
    else
        plot(x(i,1),x(i,2),'o','markerfacecolor','m')
    end
end

%%例2
x=score(:,1:3);%取前三個主成分（的得分）
x(:,3)=x(:,3)-min(x(:,3));
idx=kmeans(x,4);
%繪圖（3D）
str=num2str([1:n]');
figure(1),clf
plot3(x(:,1),x(:,2),x(:,3),'o')
stem3(x(:,1),x(:,2),x(:,3))
text(x(:,1),x(:,2),x(:,3)+.5,str,'fontsize',12)
hold on
for i=1:n
    if idx(i)==1
        plot3(x(i,1),x(i,2),x(i,3),'o','markerfacecolor','b')
    elseif idx(i)==2
        plot3(x(i,1),x(i,2),x(i,3),'o','markerfacecolor','g')
    elseif idx(i)==3
        plot3(x(i,1),x(i,2),x(i,3),'o','markerfacecolor','c')    
    else
        plot3(x(i,1),x(i,2),x(i,3),'o','markerfacecolor','m')
    end
end
xlabel('PC1'),ylabel('PC2'),zlabel('PC3')  

• 1
• 2
• 3
• 4
• 5
• 6
• 7
• 8
• 9
• 10
• 11
• 12
• 13
• 14
• 15
• 16
• 17
• 18
• 19
• 20
• 21
• 22
• 23
• 24
• 25
• 26
• 27
• 28
• 29
• 30
• 31
• 32
• 33
• 34
• 35
• 36
• 37
• 38
• 39
• 40
• 41
• 42
• 43
• 44
• 45
• 46
• 47
• 48
• 49
• 50
• 51
• 52
• 53
• 54
• 55
• 56
• 57
• 58
• 59
• 60
• 61
• 62

2. 因子分析：

1） in R

## 數據讀入 ##
economicData <- read.csv("C:\\Users\\lenovo\\Desktop\\6.csv", header = TRUE, sep = ",")
X <- economicData[,-1]

## 計算相關係數矩陣 ##
economic.cor <- cor(X)
economic.cor

## 繪製碎石圖，分析公因子數量 ##
library(psych)
scree(X)

## 因子分析並生成報表 ##
numOfFactor <- 2
fa.varimax <- fa(X, nfactors = numOfFactor, rotate = "varimax", fm = "pa", scores = T)
fa.varimax

## 構造彙總表 ##
field = as.character(economicData[, 1]) 
#提取出第一列的中文
result = cbind(field, as.data.frame(scale(X))) 
#組合表格，第1列爲各觀測的名稱，之後爲標準化後的變量值

## 計算各因子的綜合得分 ##
weight <- fa.varimax$weights #獲取因子得分系數矩陣
weight
for (k in 1:ncol(weight))
{
  totalScore <- numeric(nrow(X));
  for (i in 1:nrow(X))
  {
    for (j in 1:ncol(X))
    {
      totalScore[i] = totalScore[i] + weight[j, k] * result[i, j+1];
    }
  }
  result = cbind(result, totalScore);
  colnames(result)[1+ncol(X)+k] <- paste("y", as.character(k), sep = "");
}

## 對特定得分進行降序排列 ##
library(plyr)
output = cbind(result$field, result$y1) #y1可改爲需要排序的那一列
output = as.data.frame(output)
colnames(output) <- c("field", "y1") #field可以更改, y1也需要更改
output = arrange(output, desc(y1)) #y1也需要更改
output

• 1
• 2
• 3
• 4
• 5
• 6
• 7
• 8
• 9
• 10
• 11
• 12
• 13
• 14
• 15
• 16
• 17
• 18
• 19
• 20
• 21
• 22
• 23
• 24
• 25
• 26
• 27
• 28
• 29
• 30
• 31
• 32
• 33
• 34
• 35
• 36
• 37
• 38
• 39
• 40
• 41
• 42
• 43
• 44
• 45
• 46
• 47

2） in matlab

%% 從相關係數矩陣出發進行因子分析


%%定義相關係數矩陣PHO
PHO = [1 0.79 0.36 0.76 0.25 0.51
0.79 1 0.31 0.55 0.17 0.35
0.36 0.31 1 0.35 0.64 0.58
0.76 0.55 0.35 1 0.16 0.38
0.25 0.17 0.64 0.16 1 0.63
0.51 0.35 0.58 0.38 0.63 1
];

%%調用factoran函數根據相關係數矩陣作因子分析

%%從相關係數矩陣出發，進行因子分析，公共因子數爲2，設置特殊方差的下限爲0，不進行因子旋轉
[lambda,psi,T] = factoran(PHO,2,'xtype','covariance','delta',0,'rotate','none')

%定義元胞數組，以元胞數組形式顯示結果
%表頭
head = {'變量', '因子f1', '因子f2'};
%變量名
varname = {'身高','坐高','胸圍','手臂長','肋圍','腰圍','<貢獻率>','<累積貢獻率>'}';
Contribut = 100*sum(lambda.^2)/6; % 計算貢獻率，因子載荷陣的列元素之和除以維數
CumCont = cumsum(Contribut); % 計算累積貢獻率
%將因子載荷陣，貢獻率和累積貢獻率放在一起，轉爲元胞數組
result1 = num2cell([lambda; Contribut; CumCont]);
%加上表頭和變量名，然後顯示結果
result1 = [head; varname, result1]


%%從相關係數矩陣出發，進行因子分析，公共因子數爲2，設置特殊方差的下限爲0，
%進行因子旋轉(最大方差旋轉法)

[lambda,psi,T] =factoran(PHO,2,'xtype','covariance','delta',0)
Contribut = 100*sum(lambda.^2)/6 %計算貢獻率，因子載荷陣的列元素之和除以維數
CumCont = cumsum(Contribut) %計算累積貢獻率


%%從相關係數矩陣出發，進行因子分析，公共因子數爲3，設置特殊方差的下限爲0，
% 進行因子旋轉(最大方差旋轉法)
[lambda,psi,T] = factoran(PHO,3,'xtype','covariance','delta',0)
Contribut = 100*sum(lambda.^2)/6 % 計算貢獻率，因子載荷陣的列元素之和除以維數
CumCont = cumsum(Contribut) % 計算累積貢獻率

• 1
• 2
• 3
• 4
• 5
• 6
• 7
• 8
• 9
• 10
• 11
• 12
• 13
• 14
• 15
• 16
• 17
• 18
• 19
• 20
• 21
• 22
• 23
• 24
• 25
• 26
• 27
• 28
• 29
• 30
• 31
• 32
• 33
• 34
• 35
• 36
• 37
• 38
• 39
• 40
• 41
• 42
• 43
• 44

結果1

lambda =

    1.0000   -0.0000
    0.7900   -0.0292
    0.3600    0.6574
    0.7600    0.0004
    0.2500    0.8354
    0.5100    0.6026


psi =

    0.0000
    0.3750
    0.4382
    0.4223
    0.2396
    0.3768


T =

     1     0
     0     1


result1 = 

    '變量'         '因子f1'       '因子f2'       
    '身高'         [ 1.0000]    [-2.1042e-06]
    '坐高'         [ 0.7900]    [    -0.0292]
    '胸圍'         [ 0.3600]    [     0.6574]
    '手臂長'        [ 0.7600]    [ 3.6695e-04]
    '肋圍'         [ 0.2500]    [     0.8354]
    '腰圍'         [ 0.5100]    [     0.6026]
    '<貢獻率>'      [44.2317]    [    24.8999]
    '<累積貢獻率>'    [44.2317]    [    69.1316]

• 1
• 2
• 3
• 4
• 5
• 6
• 7
• 8
• 9
• 10
• 11
• 12
• 13
• 14
• 15
• 16
• 17
• 18
• 19
• 20
• 21
• 22
• 23
• 24
• 25
• 26
• 27
• 28
• 29
• 30
• 31
• 32
• 33
• 34
• 35
• 36
• 37

結果2

 lambda =

    0.9731    0.2304
    0.7755    0.1536
    0.1989    0.7226
    0.7395    0.1755
    0.0508    0.8705
    0.3574    0.7039

psi =

    0.0000
    0.3750
    0.4382
    0.4223
    0.2396
    0.3768


T =

    0.9731    0.2304
   -0.2304    0.9731


Contribut =

   37.7496   31.3820


CumCont =

   37.7496   69.1316

• 1
• 2
• 3
• 4
• 5
• 6
• 7
• 8
• 9
• 10
• 11
• 12
• 13
• 14
• 15
• 16
• 17
• 18
• 19
• 20
• 21
• 22
• 23
• 24
• 25
• 26
• 27
• 28
• 29
• 30
• 31
• 32
• 33

結果3

lambda =

    0.2288    0.9151    0.3320
    0.1546    0.7554    0.1909
    0.7240    0.1431    0.1909
    0.1614    0.4768    0.8638
    0.8740    0.0584   -0.0103
    0.7010    0.3376    0.1226


psi =

    0.0000
    0.3690
    0.4188
    0.0005
    0.2325
    0.3795


T =

    0.2288    0.9151    0.3320
    0.9733   -0.2217   -0.0594
   -0.0192   -0.3367    0.9414


Contribut =

   31.3629   29.5540   15.7400


CumCont =

   31.3629   60.9169   76.6569

• 1
• 2
• 3
• 4
• 5
• 6
• 7
• 8
• 9
• 10
• 11
• 12
• 13
• 14
• 15
• 16
• 17
• 18
• 19
• 20
• 21
• 22
• 23
• 24
• 25
• 26
• 27
• 28
• 29
• 30
• 31
• 32
• 33
• 34
• 35

Reference

R部分：荔枝編寫
matlab部分整理自：
http://www.ilovematlab.cn/thread-203081-1-1.html
http://www.mianfeiwendang.com/doc/a750344524f07a2148591755

本文由廈門大學荔枝帶飛隊編寫