主成分分析の具体的な分析手順

##データについて
###概要
- 中学2年生の成績（各教科100点満点）
- 標本数：166
- 変数の数：科目数＝9
 - 国語，社会，数学，理科，音楽，英語，体育，技術家庭科，英語
- 使用データのダウンロード
 - [成績のデータ（csv）](https://statistics.co.jp/reference/statistical_data/statistical_data.htm)  

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/397449/dbb16551-c3cb-7f37-0ccf-ec614ac6769f.png)

##分析の方向性
1. 分析目的  
9科目の得点を適当に組み合わせた変数を作り，できるだけ少ない変数で生徒の特徴を捉えたい．
1. 基礎集計  
異常値や外れ値を確認し，全体の特徴を把握する．
1. 主成分分析  
次元縮約の手法として主成分分析を用いる．
1. 結果の解釈  
主成分分析から得られた軸の解釈を行い，評価する

##基礎集計
体育と他の科目との相関が低いように見て取れる．筆記科目と体育科目に分けることができそうである．

```R
#箱ひげ図の作成
par(family="Osaka")
boxplot(sample)
```
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/397449/8356ced1-7746-ae10-b31b-6d0092590a76.png)

```R
#データの読み込み
sample <- read.csv("seiseki.csv",header=T)
#パッケージの準備
install.packages("psych")
library("psych")
#プロットの作成
pairs.panels(sample)
```
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/397449/113b8275-7e7b-398c-eb47-28eefba70148.png)

##主成分分析
###① 主成分を求める
```R
#主成分分析
result <- prcomp(sample,scale=T)
#固有ベクトル（主成分軸の係数）
result$rotation
```
- 関数`prcomp`の引数`scale`
引数 `scale=T` を指定することで**相関行列**から主成分分析を行う．引数`scale=F`を指定することで**分散共分散行列**から主成分分析を行う．

- 第1主成分
=0.363×国語+0.369×社会+0.357×数学+0.367×理科+0.354×音楽+0.313×美術+**0.139×体育+0.317**×技術家庭+0.357×英語

- 第2主成分
=-0.149×国語+0.147×社会+0.181×数学+0.251×理科-0.010×音楽-0.312×美術**-0.859×体育**+0.149×技術家庭+0.047×英語

- 格納変数の意味  

|$|意味|
|:--|--:|
|x|固有ベクトル|
|rotation|主成分得点|
|sdev|固有値の平方根|

- 各主成分の固有ベクトルの結果

<table>
	<thead>
		<tr>
			<th>
				
			</th>
			<th>
				PC1
			</th>
			<th>
				PC2
			</th>
			<th>
				PC3
			</th>
			<th>
				PC4
			</th>
			<th>
				PC5
			</th>
			<th>
				PC6
			</th>
			<th>
				PC7
			</th>
			<th>
				PC8
			</th>
			<th>
				PC9
			</th>
		</tr>
	</thead>
	<tbody>
		<tr>
			<th>
				kokugo
			</th>
			<td>
				0.363
			</td>
			<td>
				-0.149
			</td>
			<td>
				0.074
			</td>
			<td>
				-0.236
			</td>
			<td>
				0.301
			</td>
			<td>
				-0.494
			</td>
			<td>
				0.62
			</td>
			<td>
				0.11
			</td>
			<td>
				-0.231
			</td>
		</tr>
		<tr>
			<th>
				shakai
			</th>
			<td>
				0.369
			</td>
			<td>
				0.147
			</td>
			<td>
				-0.062
			</td>
			<td>
				-0.107
			</td>
			<td>
				0.087
			</td>
			<td>
				-0.573
			</td>
			<td>
				-0.517
			</td>
			<td>
				-0.235
			</td>
			<td>
				0.412
			</td>
		</tr>
		<tr>
			<th>
				sugaku
			</th>
			<td>
				0.357
			</td>
			<td>
				0.181
			</td>
			<td>
				-0.4
			</td>
			<td>
				0.029
			</td>
			<td>
				0.061
			</td>
			<td>
				0.408
			</td>
			<td>
				0.409
			</td>
			<td>
				-0.446
			</td>
			<td>
				0.377
			</td>
		</tr>
		<tr>
			<th>
				rika
			</th>
			<td>
				0.367
			</td>
			<td>
				0.251
			</td>
			<td>
				0.008
			</td>
			<td>
				0.067
			</td>
			<td>
				-0.262
			</td>
			<td>
				0.039
			</td>
			<td>
				-0.177
			</td>
			<td>
				-0.392
			</td>
			<td>
				-0.736
			</td>
		</tr>
		<tr>
			<th>
				ongaku
			</th>
			<td>
				0.354
			</td>
			<td>
				-0.01
			</td>
			<td>
				-0.2
			</td>
			<td>
				0.357
			</td>
			<td>
				-0.642
			</td>
			<td>
				-0.132
			</td>
			<td>
				0.119
			</td>
			<td>
				0.495
			</td>
			<td>
				0.133
			</td>
		</tr>
		<tr>
			<th>
				bijutu
			</th>
			<td>
				0.313
			</td>
			<td>
				-0.312
			</td>
			<td>
				0.264
			</td>
			<td>
				0.712
			</td>
			<td>
				0.44
			</td>
			<td>
				0.136
			</td>
			<td>
				-0.125
			</td>
			<td>
				0.002
			</td>
			<td>
				-0.003
			</td>
		</tr>
		<tr>
			<th>
				taiiku
			</th>
			<td>
				0.139
			</td>
			<td>
				-0.859
			</td>
			<td>
				-0.08
			</td>
			<td>
				-0.284
			</td>
			<td>
				-0.269
			</td>
			<td>
				0.107
			</td>
			<td>
				-0.128
			</td>
			<td>
				-0.235
			</td>
			<td>
				0.007
			</td>
		</tr>
		<tr>
			<th>
				gika
			</th>
			<td>
				0.317
			</td>
			<td>
				0.149
			</td>
			<td>
				0.784
			</td>
			<td>
				-0.293
			</td>
			<td>
				-0.19
			</td>
			<td>
				0.287
			</td>
			<td>
				0.042
			</td>
			<td>
				0.062
			</td>
			<td>
				0.231
			</td>
		</tr>
		<tr>
			<th>
				eigo
			</th>
			<td>
				0.357
			</td>
			<td>
				0.047
			</td>
			<td>
				-0.317
			</td>
			<td>
				-0.355
			</td>
			<td>
				0.338
			</td>
			<td>
				0.361
			</td>
			<td>
				-0.32
			</td>
			<td>
				0.525
			</td>
			<td>
				-0.146
			</td>
		</tr>
	</tbody>
</table>
###② 寄与率と累積寄与率を求める
```R
#寄与率と累積寄与率を求める
summary(result)
```
- 各項目の意味
 - Standard deviation：標準偏差
 - Proportion of Variance：寄与率
 - Cumulative Proportion：累積寄与率

- 累積寄与率
第1主成分で67%，第2主成分で79%の情報を締めている．第3主成分以降の変化率が緩いので第2主成分まで選択する．

<table>
	<thead>
		<tr>
			<th>
				
			</th>
			<th>
				PC1
			</th>
			<th>
				PC2
			</th>
			<th>
				PC3
			</th>
			<th>
				PC4
			</th>
			<th>
				PC5
			</th>
			<th>
				PC6
			</th>
			<th>
				PC7
			</th>
			<th>
				PC8
			</th>
			<th>
				PC9
			</th>
		</tr>
	</thead>
	<tbody>
		<tr>
			<th>
				Standard deviation
			</th>
			<td>
				2.451
			</td>
			<td>
				1.048
			</td>
			<td>
				0.701
			</td>
			<td>
				0.638
			</td>
			<td>
				0.548
			</td>
			<td>
				0.471
			</td>
			<td>
				0.428
			</td>
			<td>
				0.414
			</td>
			<td>
				0.349
			</td>
		</tr>
		<tr>
			<th>
				Proportion of Variance
			</th>
			<td>
				0.667
			</td>
			<td>
				0.122
			</td>
			<td>
				0.055
			</td>
			<td>
				0.045
			</td>
			<td>
				0.033
			</td>
			<td>
				0.025
			</td>
			<td>
				0.02
			</td>
			<td>
				0.019
			</td>
			<td>
				0.014
			</td>
		</tr>
		<tr>
			<th>
				Cumulative Proportion
			</th>
			<td>
				0.667
			</td>
			<td>
				0.789
			</td>
			<td>
				0.844
			</td>
			<td>
				0.889
			</td>
			<td>
				0.923
			</td>
			<td>
				0.947
			</td>
			<td>
				0.967
			</td>
			<td>
				0.986
			</td>
			<td>
				1
			</td>
		</tr>
	</tbody>
</table>

###③ 因子負荷量を求める
```R
#因子負荷量の算出
result.fl<- sweep(result$rotation,MARGIN=2,result$sdev,FUN="*")
subject <- c("国", "社", "数", "理", "音", "美", "体", "技", "英")

#第1主成分に関する因子負荷量のプロット
plot(result.fl[,1], pch=subject, ylim=c(-1,1), 
     main="PC1", ylab="PC1", cex=3, cex.lab=1.5)
abline(h = 0)

#第2主成分に関する因子負荷量のプロット
plot(result.fl[,2], pch=subject, ylim=c(-1,1), 
     main="PC1", ylab="PC2", cex=3, cex.lab=1.5)
abline(h = 0)

#2次元でプロット
plot(result.fl[,1],result.fl[,2],pch=subject,
     xlim=c(-1,1),ylim=c(-1,1),main=title,
     xlab="PC1",ylab="PC2", cex=3, cex.lab=1.5)
abline(h = 0)
abline(v = 0)
```
- 因子負荷量  
固有ベクトル`result$rotation`と,対応した固有値の平方根`result$sdev`との積をとる．[sweep関数の使い方](http://cse.naro.affrc.go.jp/takezawa/r-tips/r/24.html)

<table>
	<thead>
		<tr>
			<th>
				
			</th>
			<th>
				PC1
			</th>
			<th>
				PC2
			</th>
			<th>
				PC3
			</th>
			<th>
				PC4
			</th>
			<th>
				PC5
			</th>
			<th>
				PC6
			</th>
			<th>
				PC7
			</th>
			<th>
				PC8
			</th>
			<th>
				PC9
			</th>
		</tr>
	</thead>
	<tbody>
		<tr>
			<th>
				kokugo
			</th>
			<td>
				0.889
			</td>
			<td>
				-0.157
			</td>
			<td>
				0.052
			</td>
			<td>
				-0.151
			</td>
			<td>
				0.165
			</td>
			<td>
				-0.233
			</td>
			<td>
				0.265
			</td>
			<td>
				0.045
			</td>
			<td>
				-0.081
			</td>
		</tr>
		<tr>
			<th>
				shakai
			</th>
			<td>
				0.903
			</td>
			<td>
				0.154
			</td>
			<td>
				-0.043
			</td>
			<td>
				-0.068
			</td>
			<td>
				0.047
			</td>
			<td>
				-0.27
			</td>
			<td>
				-0.221
			</td>
			<td>
				-0.097
			</td>
			<td>
				0.144
			</td>
		</tr>
		<tr>
			<th>
				sugaku
			</th>
			<td>
				0.875
			</td>
			<td>
				0.19
			</td>
			<td>
				-0.28
			</td>
			<td>
				0.019
			</td>
			<td>
				0.033
			</td>
			<td>
				0.192
			</td>
			<td>
				0.175
			</td>
			<td>
				-0.185
			</td>
			<td>
				0.132
			</td>
		</tr>
		<tr>
			<th>
				rika
			</th>
			<td>
				0.9
			</td>
			<td>
				0.263
			</td>
			<td>
				0.006
			</td>
			<td>
				0.043
			</td>
			<td>
				-0.144
			</td>
			<td>
				0.018
			</td>
			<td>
				-0.075
			</td>
			<td>
				-0.162
			</td>
			<td>
				-0.257
			</td>
		</tr>
		<tr>
			<th>
				ongaku
			</th>
			<td>
				0.868
			</td>
			<td>
				-0.01
			</td>
			<td>
				-0.14
			</td>
			<td>
				0.228
			</td>
			<td>
				-0.352
			</td>
			<td>
				-0.062
			</td>
			<td>
				0.051
			</td>
			<td>
				0.205
			</td>
			<td>
				0.046
			</td>
		</tr>
		<tr>
			<th>
				bijutu
			</th>
			<td>
				0.766
			</td>
			<td>
				-0.327
			</td>
			<td>
				0.185
			</td>
			<td>
				0.454
			</td>
			<td>
				0.241
			</td>
			<td>
				0.064
			</td>
			<td>
				-0.053
			</td>
			<td>
				0.001
			</td>
			<td>
				-0.001
			</td>
		</tr>
		<tr>
			<th>
				taiiku
			</th>
			<td>
				0.341
			</td>
			<td>
				-0.9
			</td>
			<td>
				-0.056
			</td>
			<td>
				-0.181
			</td>
			<td>
				-0.147
			</td>
			<td>
				0.05
			</td>
			<td>
				-0.055
			</td>
			<td>
				-0.097
			</td>
			<td>
				0.003
			</td>
		</tr>
		<tr>
			<th>
				gika
			</th>
			<td>
				0.776
			</td>
			<td>
				0.156
			</td>
			<td>
				0.549
			</td>
			<td>
				-0.187
			</td>
			<td>
				-0.104
			</td>
			<td>
				0.135
			</td>
			<td>
				0.018
			</td>
			<td>
				0.026
			</td>
			<td>
				0.081
			</td>
		</tr>
		<tr>
			<th>
				eigo
			</th>
			<td>
				0.875
			</td>
			<td>
				0.049
			</td>
			<td>
				-0.222
			</td>
			<td>
				-0.226
			</td>
			<td>
				0.185
			</td>
			<td>
				0.17
			</td>
			<td>
				-0.137
			</td>
			<td>
				0.217
			</td>
			<td>
				-0.051
			</td>
		</tr>
	</tbody>
</table>
- 第1主成分に関する因子負荷量のプロット（1次元）  
体育以外は主成分と強い相関を示している．**筆記試験の因子**ではないかと考えられる．
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/397449/912985a2-5dcc-4876-fb7f-790475c74b9f.png)
- 第2主成分に関する因子負荷量のプロット（1次元）  
体育が主成分と強い相関があるので**体育の因子**と考えられる．
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/397449/0e74c054-6702-b6e6-04eb-d78c6d41512e.png)
- 因子負荷量のプロット（2次元）  
x軸方向が筆記試験との関連の強さ，y軸方向が体育との関連の強さを表しているとみてよさそうである．
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/397449/fde4bc6d-552e-e5fd-8d5d-5ab393693409.png)

###④主成分得点
```R
#固有値ベクトル
PC12_eigen_vec<- 3*cbind(0,0,result.fl[,1],result.fl[,2])
#主成分得点をプロット
plot(result$x[,1:2],ylim=c(-4,4))
#矢印
for (i in 1:nrow(PC12_eigen_vec)) {
  arrows(PC12_eigen_vec[i,1],PC12_eigen_vec[i,2], 
        PC12_eigen_vec[i,3],PC12_eigen_vec[i,4],
        col="blue") 
  text(PC12_eigen_vec[i,3]+0.3, PC12_eigen_vec[i,4],
       subject[i],col="blue", cex=1.2, cex.lab=1.5)
}
#水平線
abline(h = 0)
abline(v = 0)

#簡単に解釈しやす形でプロットできるがごちゃごちゃするので代わりにplotを使い描写
#biplot(result)
```
- 第1主成分の解釈  
筆記試験の総合得点を表しており，右にあるデータであればあるほど筆記試験の総合得点が高い．
- 第2主成分の解釈  
体育の因子で，下にあるデータであればあるほど体育の成績がいい
- 主成分得点のプロット
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/397449/7e621c24-e118-58f9-5197-e3d23c2b2bf9.png)

##結果の解釈
右下に行けば行くほど筆記と体育共に優れている人といえる．
![プレゼンテーション1.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/397449/72fc3597-21b1-c69f-3337-417ad13b28de.png)