Sep 19 2014

主成分分析と重回帰分析を組み合わせる

放送大学「心理統計法」第14章　多変量解析のすすめ

みずみずしさ<-c(3,6,6,6,7,6,5,6,5,5,5,7,7,4,5,5,5,4,6,6,6,7,4,5,5,5,5,6)
なめらかさ <-c(6,5,7,1,6,2,5,4,5,6,6,3,3,4,5,3,4,4,5,5,3,5,5,4,5,5,4,3)
しみこみの速さ<-c(2,5,5,2,5,6,6,6,5,4,6,6,5,5,6,5,7,5,3,3,2,5,3,4,6,5,4,4)
さらさら感 <-c(2,3,6,7,3,6,3,3,5,5,3,3,7,5,3,5,6,4,3,4,5,1,3,4,4,4,4,7)
しっとり感 <-c(5,3,3,1,3,1,5,2,3,5,6,4,1,5,6,3,2,5,5,4,6,7,4,5,6,3,4,1)
つるつる感 <-c(5,5,5,2,5,4,4,4,5,4,6,4,6,4,4,2,4,4,5,4,5,4,5,4,4,4,5,3)
やわらかさ <-c(5,6,4,2,4,2,5,1,5,6,7,4,2,5,5,3,4,4,4,5,5,7,5,4,5,3,5,2)
香りの好み <-c(5,6,1,1,1,1,1,1,4,4,1,2,3,1,2,2,2,1,3,5,4,4,3,4,3,5,4,1)
心地よさ <-c(6,6,3,2,2,2,3,3,5,5,6,2,3,4,4,4,4,3,4,4,5,4,4,5,4,5,4,1)
d<-data.frame(みずみずしさ,なめらかさ,しみこみの速さ,さらさら感,しっとり感,つるつる感,やわらかさ,香りの好み,心地よさ)
result<- princomp(~みずみずしさ+なめらかさ+しみこみの速さ+さらさら感+しっとり感+つるつる感+やわらかさ+香りの好み, cor=TRUE, data=d)

固有値

1	result$sdev^2 # component variances

Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7 Comp.8
3.3564371 1.3426892 1.0813617 0.8056899 0.5029603 0.4290183 0.3509757 0.1308679

説明率、累積説明率

1	summary(result) # proportions of variance

Importance of components:
Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7 Comp.8
Standard deviation 1.8320581 1.1587447 1.0398854 0.8976023 0.70919692 0.65499492 0.59243201 0.36175662
Proportion of Variance 0.4195546 0.1678361 0.1351702 0.1007112 0.06287003 0.05362729 0.04387196 0.01635848
Cumulative Proportion 0.4195546 0.5873908 0.7225610 0.8232722 0.88614226 0.93976956 0.98364152 1.00000000

主成分負荷量　（テキストとは符号が逆の可能性あり）

1 2	library(knitr) kable(t(result$sdev * t(result$loadings ) )[, 1:3,drop = FALSE],digits=5)

	Comp.1	Comp.2	Comp.3
みずみずしさ	0.34362	0.27407	0.68568
なめらかさ	-0.77847	0.25826	0.09472
しみこみの速さ	0.08675	0.89300	-0.10309
さらさら感	0.76950	-0.15316	0.07733
しっとり感	-0.83347	0.01943	-0.30085
つるつる感	-0.54494	0.20069	0.59096
やわらかさ	-0.88216	0.02886	-0.05928
香りの好み	-0.51270	-0.58179	0.37732

主成分得点（標準化したもの_テキストとは符号が逆の可能性あり）

1 2	result$scores2<-scale(result$scores) kable(result$scores2[,1:3],digits=4,row.names=T)

	Comp.1	Comp.2	Comp.3
1	-1.5461	-1.8890	-0.6410
2	-0.8453	-0.3072	1.5418
3	0.0834	1.0938	0.7851
4	2.3658	-1.8230	-0.7070
5	-0.0855	1.3763	1.2171
6	1.7742	0.6595	0.1993
7	-0.3864	1.1818	-1.1294
8	1.0160	1.1611	0.0673
9	-0.2849	-0.1279	0.5954
10	-0.7638	-0.5998	-0.2096
11	-1.3976	1.6809	-0.1309
12	0.3857	1.0092	0.4280
13	1.2944	0.2204	2.6219
14	-0.0390	0.1999	-1.6683
15	-0.6255	0.9173	-1.0699
16	1.1216	-0.3757	-1.6511
17	0.7568	0.9921	-0.3891
18	-0.0126	0.2593	-1.6781
19	-0.5316	-0.4739	0.7746
20	-0.4341	-1.2468	0.8008
21	-0.3225	-1.6447	0.8293
22	-1.4197	0.4786	0.3854
23	-0.7684	-0.8773	-0.3732
24	-0.2174	-0.8412	-0.3134
25	-0.5736	0.5708	-0.8040
26	-0.0069	-0.5150	0.2585
27	-0.4222	-0.6757	0.3935
28	1.8850	-0.4037	-0.1329

主成分得点（標準化したもの）上位３つをデータセットdに付け加える

1
2
3

d$PC1<-result$scores2[,1]
d$PC2<-result$scores2[,2]
d$PC3<-result$scores2[,3]

AICを用いて変数選択

Model <- lm(心地よさ~PC1+PC2+PC3, data=d)
select<-step(Model)
library(xtable)
print(xtable(select),type="html")

変数選択

Start: AIC=-4.37
心地よさ ~ PC1 + PC2 + PC3

Df Sum of Sq RSS AIC

PC3 1 0.0009 18.002 -6.3689
18.001 -4.3703
PC2 1 3.6362 21.637 -1.2186
PC1 1 24.4694 42.470 17.6647

Step: AIC=-6.37
心地よさ ~ PC1 + PC2