19. 주성분 분석(Principal Component Analysis, PCA)

안녕하세요. 오늘은 주성분 분석에 대해서 알아보려고 합니다. 

SPSS를 이용해보신 분은 (제가 SAS는 이용해 본 적이 없어서..) 아시다시피

요인분석 하다가 주성분분석 하고, 회전된 성분행렬 이런 것들을 많이 보신적 있죠? 베리맥스 방식..등등..

사실 이 부분도 다변량 파트에서 되게 깊게 가려면 깊게 가는데.. 아시다시피.. 깊게 하나만 파도 넘~나 오래 걸리고, 

제가 그만큼 아는 지식인도 아니구요..ㅎㅎ;;

오늘은 간단하게 R을 통해 어떻게 하는지 개념설명과 실습을 해볼게요.

1. 주성분 분석의 개념

 -상관관계가 있는 변수들을 결합해 상관관계가 없는 변수로, 분산을 극대화하는 변수이다. 

  선형 결합을 하여 변수를 축약하는 데 사용한다.

 # 여기서 이해가 안되실 수도 있는데, 즉 주성분 분석은 분산을 극대화하여 최대한 묶어내는 방식입니다. 

  반대로 분산이 작다면 그만큼 밀집해 있는 거겠죠.

 데이터 내부 구조를 파악할 수 있는 방법으로, 예측모델을 만들 때 주로 사용한다.

 보통 희생되는 정보가 가장 적은 방향을 결정하는 것으로서, 보통 3개 이내의 변수로 축약하고 이로 인한 정보손실은 20%정도로 한다.

 #즉, 선형으로 쭉 분산을 최대한 넓게 하여서 묶고, 그것에 수직으로 묶고 이런식으로 변수끼리 최대한 상관관계가 있는 것들끼리 

  묶어내고, 필요 없는 변수를 골라낼 수 있죠. 그것에 대한 정보손실이 총 정보중 20% 내가 되도록 한다는 의미입니다.

2. R을 통한 분석 사례

 1) data load와 방향 일치.

#여기서 데이터는 heptathlon 을 사용하며, 이 데이터는 올림픽 여자 7종경기 기록입니다. 종목에 따라 기록이 큰 숫자가 좋은 것도 있고, 기록이 크면 안 좋은 종목도

 있습니다. 따라서 한 방향으로 맞추어주어야 올바르게 데이터 분석을 할 수 있습니다. 여기서는 시간 기록을 가장 늦은 선수의 기록에서 빼는 것으로 하여 수치가 클수록

 좋은 것으로 방향을 일정하게 맞춥니다.

install.packages("HSAUR")

library(HSAUR)
data(heptathlon)

head(heptathlon)

heptathlon$hurdles <-max(heptathlon$hurdles)-heptathlon$hurdles
heptathlon$run200m <-max(heptathlon$run200m)-heptathlon$run200m
heptathlon$run800m <-max(heptathlon$run800m)-heptathlon$run800m

#여기선 heptathlon데이터 안에서 허들과 200m ,800m달리기를 큰 것에서 작은 것으로 빼줬습니다. 왜냐면 이 것들은 빠를수록 좋은 기록들이라 클수록 좋게

  다시 만들어 준 셈이죠. 그렇게해서 데이터를 잘 바뀌었는지 확인해봅니다.

head(heptathlon)

                    hurdles highjump  shot run200m longjump javelin run800m
Joyner-Kersee (USA)    3.73     1.86 15.80    4.05     7.27   45.66   34.92
John (GDR)             3.57     1.80 16.23    2.96     6.71   42.56   37.31
Behmer (GDR)           3.22     1.83 14.20    3.51     6.68   44.54   39.23
Sablovskaite (URS)     2.81     1.80 15.23    2.69     6.25   42.78   31.19
Choubenkova (URS)      2.91     1.74 14.76    2.68     6.32   47.46   35.53
Schulz (GDR)           2.67     1.83 13.50    1.96     6.33   42.82   37.64

#잘 바뀌었습니다. 자 이제 산점도를 확인해봅니다.

#스코어 열은 산점도를 찍을 필요 없기때문에 빼줍니다.

score<-which(colnames(heptathlon)=="score")
plot(heptathlon[-score])

# 자 이렇게 산점도가 나타났죠. 산점도를 보면 어느정도 종목 간에 상관관계가 있음을 알 수 있습니다.

# 다만, javelin 종목에서는 유달리 상관관계가 보이지 않고 이상하게~ 분포되어있죠 분산이 너무 큽니다.

# 그 이유는 뭘까요, 책에서는 다른 종목이 힘을 기반으로 한다면 투창은 기술이 중요하기 때문이랍니다! ..(그럴까요? 스스로 생각해보는게..~)

# 그렇게 되면 주성분분석을 실시하면 자벨린종목은 빠지게되겠죠? 그렇게 될까요? 해보겠습니다.

# 일단 상관계수를 확인해봅니다.

 

round(cor(heptathlon[,-score]), 2)

         hurdles highjump shot run200m longjump javelin run800m
hurdles     1.00     0.81 0.65    0.77     0.91    0.01    0.78
highjump    0.81     1.00 0.44    0.49     0.78    0.00    0.59
shot        0.65     0.44 1.00    0.68     0.74    0.27    0.42
run200m     0.77     0.49 0.68    1.00     0.82    0.33    0.62
longjump    0.91     0.78 0.74    0.82     1.00    0.07    0.70
javelin     0.01     0.00 0.27    0.33     0.07    1.00   -0.02
run800m     0.78     0.59 0.42    0.62     0.70   -0.02    1.00

# round()함수는 default 값이 0이라고 R에서 알려주네요. 2라고 치면, 소숫점 셋 째자리에서 반올림하여 나타냅니다.

# 즉 여기서도 볼 수 있듯 2번째 자리까지만 나왔죠!

# 결과를 보면, 확실히 자벨린은 어딜 가나 상관계수가 조금 낮네요. 200m와는 약간 있는 정도구요~

# 이제 주성분 분석을 해볼까요?

#prcomp()함수는 주성분분석하는 함수입니다. heptathlon의 스코어열을 빼주고, scale은 TRUE로 하여 데이터 스케일링을 합니다.)

heptathlon_pca<-prcomp(heptathlon[,-score], scale=TRUE)

print(heptathlon_pca)

Standard deviations:
[1] 2.1119364 1.0928497 0.7218131 0.6761411 0.4952441 0.2701029 0.2213617

Rotation:
                    PC1           PC2           PC3             PC4            PC5
hurdles  -0.4528710  0.15792058 -0.04514996  0.02653873 -0.09494792
highjump -0.3771992  0.24807386 -0.36777902  0.67999172  0.01879888
shot      -0.3630725 -0.28940743  0.67618919  0.12431725  0.51165201
run200m  -0.4078950 -0.26038545  0.08359211 -0.36106580 -0.64983404
longjump -0.4562318  0.05587394  0.13931653  0.11129249 -0.18429810
javelin    -0.0754090 -0.84169212 -0.47156016  0.12079924  0.13510669
run800m  -0.3749594  0.22448984 -0.39585671 -0.60341130  0.50432116
                   PC6         PC7
hurdles   -0.78334101  0.38024707
highjump   0.09939981 -0.43393114
shot       -0.05085983 -0.21762491
run200m   0.02495639 -0.45338483
longjump  0.59020972  0.61206388
javelin    -0.02724076  0.17294667
run800m   0.15555520 -0.09830963

#자 요렇게 나왔습니다. 보기좀 불편하시더라도,, 일일히 스페이스키를 누르기에는..너무 시간낭비라서. 조금만 신경써서 봐주시면 될 것 같습니다!

#실습이 의미있으니까요~! 이렇게 prcomp()함수를 사용하면 각 요소에 대한 계수와 주성분 점수를 얻을 수 있습니다.

#summary()함수를 이용해서 추가적인 정보를 얻을 수도 있습니다. 한번 볼까요.

summary(heptathlon_pca)
Importance of components:
                                  PC1    PC2      PC3       PC4     PC5         PC6     PC7
Standard deviation       2.1119 1.0928  0.72181  0.67614  0.49524  0.27010 0.2214
Proportion of Variance 0.6372 0.1706 0.07443 0.06531 0.03504 0.01042 0.0070
Cumulative Proportion  0.6372 0.8078 0.88223 0.94754 0.98258 0.99300 1.0000

# summary를 통해서 볼 떄는 Cumulative Proportion항목을 잘 보시면 될 것 같습니다. 분산점유는 실제적인 값이구요,

# Cumulative Proportion은 누적입니다. 여기서 보면 PC1과 PC2 rotation이 전체의 거의 81%정도를 설명하는군요

# 그러면 확인해봅니다.

(a1<-heptathlon_pca$rotation[,1])

   hurdles      highjump       shot          run200m     longjump     javelin        run800m 
-0.4528710 -0.3771992 -0.3630725 -0.4078950 -0.4562318 -0.0754090 -0.3749594

(a2<-heptathlon_pca$rotation[,2])

​

(a2<-heptathlon_pca$rotation[,2])

​

    hurdles       highjump        shot           run200m         longjump      javelin        run800m 
 0.15792058  0.24807386 -0.28940743 -0.26038545  0.05587394 -0.84169212     0.22448984 

# a1를 보면, hurdles와 run200m, longjump종목이 중요하다는 것을 알 수 있고, a2를 보면  javelin이 가장 덜 중요함을 알 수 있습니다.

# barplot을 통해서도 처음 두 성분이 얼마나 중요한지 알 수 있습니다.

#요렇게 PC7까지 있지만 1, 2가 대부분 다 설명한다는 것을 알 수 있죠.

#이제 rescale을 해보겠습니다. rescale을 위해서 center값과 scale값을 추출합니다.

#heptathlon_pca값 내부에서 추출해낼 수 있습니다.

#rescale의 뜻은 (규모를 축소하여) 다시 설계하다. 라는 뜻이네요. 이런 뜻을 가지고 따라해보시면 어느 정도 이해하실 거에요~

center<-heptathlon_pca$center

scale<-heptathlon_pca$scale

# 첫 번째 주성분 추출

hm<-as.matrix(heptathlon[,-score])

drop(scale(hm, center=center, scale=scale) %*% heptathlon_pca$rotation[,1])

#drop함수의 discription을 보니까 Delete the dimensions of an array which have only one level.  라고 나와있네요.

# 1개의 수준을 가진 집합체의 차원을 삭제해주는 역할을 하네요.

# hm을 score을 뺀 matrix로 hm에 저장하고, hm을 center와 scale을 추출한 값으로 scale하고,  heptathlon_pca$rotation의 1열 즉, PC1값과

# %*%, 즉 행렬곱셈을 하도록 하였습니다.

Joyner-Kersee (USA)          John (GDR)        Behmer (GDR) 
       -4.121447626        -2.882185935        -2.649633766 
 Sablovskaite (URS)   Choubenkova (URS)        Schulz (GDR) 
       -1.343351210        -1.359025696        -1.043847471 
      Fleming (AUS)       Greiner (USA)    Lajbnerova (CZE) 
       -1.100385639        -0.923173639        -0.530250689 
      Bouraga (URS)       Wijnsma (HOL)     Dimitrova (BUL) 
       -0.759819024        -0.556268302        -1.186453832 
     Scheider (SWI)         Braun (FRG)  Ruotsalainen (FIN) 
        0.015461226         0.003774223         0.090747709 
       Yuping (CHN)         Hagger (GB)         Brown (USA) 
       -0.137225440         0.171128651         0.519252646 
      Mulliner (GB)    Hautenauve (BEL)        Kytola (FIN) 
        1.125481833         1.085697646         1.447055499 
     Geremias (BRA)       Hui-Ing (TAI)      Jeong-Mi (KOR) 
        2.014029620         2.880298635         2.970118607 
        Launa (PNG) 
        6.270021972 

# 이렇게 선수별로 주성분 점수가 계산되었죠. 또는 계산된 주성분 요소로부터 직접 값을 얻을 수도 있습니다.

predict(heptathlon_pca)[,1]

Joyner-Kersee (USA)          John (GDR)        Behmer (GDR) 
       -4.121447626        -2.882185935        -2.649633766 
 Sablovskaite (URS)   Choubenkova (URS)        Schulz (GDR) 
       -1.343351210        -1.359025696        -1.043847471 
      Fleming (AUS)       Greiner (USA)    Lajbnerova (CZE) 
       -1.100385639        -0.923173639        -0.530250689 
      Bouraga (URS)       Wijnsma (HOL)     Dimitrova (BUL) 
       -0.759819024        -0.556268302        -1.186453832 
     Scheider (SWI)         Braun (FRG)  Ruotsalainen (FIN) 
        0.015461226         0.003774223         0.090747709 
       Yuping (CHN)         Hagger (GB)         Brown (USA) 
       -0.137225440         0.171128651         0.519252646 
      Mulliner (GB)    Hautenauve (BEL)        Kytola (FIN) 
        1.125481833         1.085697646         1.447055499 
     Geremias (BRA)       Hui-Ing (TAI)      Jeong-Mi (KOR) 
        2.014029620         2.880298635         2.970118607 
        Launa (PNG) 
        6.270021972

# 동일한 값이 나왔죠.

# 이렇게 여태 얻은 두 개의 주성분을 이용해 시각화(biplot)를 해봅니다.

# 선수들의 2개 주성분에 의한 시각화를 좌측과 아래에 , 종목별 주성분에 대한 시각화는 우측과 상단의 척도에 그립니다.

# 그냥 쓰니까 글자가 겹쳐보여서 이번엔 cex=0.5로  글자를 좀 보기 힘들겠지만 줄여봤습니다.

biplot(heptathlon_pca, cex=0.5, col=c("grey", "black"))

# 이렇게 잘 보이진 않지만 대충~ 보아도 javelin이 다른 종목과는 별개의 역할을 하는 것을 알 수 있죠?

# 이번엔 주성분과 7종 경기 score와의 상관관계를 볼까요?

plot(heptathlon$score, heptathlon_pca$x[,1])

# 즉~ 주성분과 점수와의 관계가 매~우 강한 상관관계가 있다는 결론이 나왔죠!

# 즉, 결론은, 첫 번째 주성분이 올림픽 7종 경기의 공식점수와 한 방향임을 알 수 있습니다.

# 따라서 주성분 분석이 잘 이루어졌죠!

#오늘은 이렇게 주성분분석(Principal Component Analysis)을 해봤는데요~

# 다음 시간에는 데이터 마트의 개념에 대해서 알아보도록 하겠습니다!