======================================================================

@ JungHwan Yun
@ Master Student in Data-Science
@ Seoul National University of Science & Technology(SeoulTech)
@ E-mail : junghwan.yun@seoultech.ac.kr

======================================================================

======================================================================

[Contents]

======================================================================



From Everitt and Hothorn : An Introduction to Applied Multivariate Analysis with R


1. Ex3.3

  • Ex. 3.3 Find the principal components of the following correlation matrix given by MacDonnell (1902) from measurements of seven physical characteristics in each of 3000 convicted criminals: How would you interpret the derived components?



  • Result : 상관행렬을 이용한 경우의 PCA로, 상관행렬을 이용하여 princomp()를 수행한다.
    • 상관행렬을 Matrix형태로 입력받음.
cor_matrix <- matrix(c(1,0.402,0.396,0.301,0.305,0.339,0.34,
                       0.402,1,0.618,0.15,0.135,0.206,0.183,
                       0.396,0.618,1,0.321,0.289,0.363,0.345,
                       0.301,0.15,0.321,1,0.846,0.759,0.661,
                       0.305,0.135,0.289,0.846,1,0.797,0.8,
                       0.339,0.206,0.363,0.759,0.797,1,0.736,
                       0.34,0.183,0.345,0.661,0.8,0.736,1),nrow = 7,ncol = 7,byrow = T)
dimnames(cor_matrix) <- list(c("Head.Length","Head.Breadth","Face.Breadth","Left.finger.length"
                               ,"Left.forearm.length","Left.foot.length","Height"),
                             c("Head.Length","Head.Breadth","Face.Breadth","Left.finger.length"
                               ,"Left.forearm.length","Left.foot.length","Height"))
print(cor_matrix)
                    Head.Length Head.Breadth Face.Breadth Left.finger.length Left.forearm.length Left.foot.length Height
Head.Length               1.000        0.402        0.396              0.301               0.305            0.339  0.340
Head.Breadth              0.402        1.000        0.618              0.150               0.135            0.206  0.183
Face.Breadth              0.396        0.618        1.000              0.321               0.289            0.363  0.345
Left.finger.length        0.301        0.150        0.321              1.000               0.846            0.759  0.661
Left.forearm.length       0.305        0.135        0.289              0.846               1.000            0.797  0.800
Left.foot.length          0.339        0.206        0.363              0.759               0.797            1.000  0.736
Height                    0.340        0.183        0.345              0.661               0.800            0.736  1.000


  • 상관행렬의 PCA후 주성분을 추출함.
    • 상관행렬을 사용하기 때문에 cor =T 로 설정, 또한 직접적으로 상관행렬을 사용하기 때문에 covmat 옵션을 사용
    • 제1,2,3 주성분을 합하면 누적 85%의 데이터를 설명하는 것이 가능함.
    • 첫번째 주성분에 대한 선형결합을 확인하면 7가지의 변수가 모두 활용됨을 알 수 있음. 두번째 주성분은 머리폭과 얼굴폭의 음의 선형관계를 나타내고 있음. 세번째 주성분은 머리 길이가 양의 관계를 보이고 있음을 확인함. 결국 범죄자들을 머리폭과 얼굴폭이 작거나 머리의 길이가 긴 경우가 많았음을 알 수 있음.
head_pca <- princomp(covmat = cor_matrix,cor = T) 
print(summary(head_pca), loadings = T)
Importance of components:
                          Comp.1    Comp.2     Comp.3    Comp.4     Comp.5     Comp.6     Comp.7
Standard deviation     1.9492241 1.2256950 0.80610632 0.6000474 0.58237656 0.48502898 0.33751644
Proportion of Variance 0.5427821 0.2146183 0.09282963 0.0514367 0.04845178 0.03360759 0.01627391
Cumulative Proportion  0.5427821 0.7574004 0.85023003 0.9016667 0.95011851 0.98372609 1.00000000

Loadings:
                    Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7
Head.Length         -0.276 -0.365  0.882                            
Head.Breadth        -0.212 -0.639 -0.258  0.687                     
Face.Breadth        -0.295 -0.512 -0.381 -0.699 -0.101              
Left.finger.length  -0.438  0.235         0.102 -0.619  0.318  0.503
Left.forearm.length -0.456  0.277         0.113         0.290 -0.785
Left.foot.length    -0.450  0.178                      -0.870       
Height              -0.436  0.180                0.770  0.233  0.353



Applied Multivariate Statistical Analysis by Johnson and Wichern


2. Exercise 8.12(p. 474)

  • 8.12. Consider the air-pollution data listed in Table1.5. Your job is to summarize these data in fewer than p = 7 dimensions if possible. Conduct a principal compoenet analysis of the data using both the covariance matrix S and the correlation matrix R. What have you learnd? Does it make any difference which matrix is chosen for analysis? Can data be summarized in three or fewer dimensions? Can you interpret the principal components?

  • Table1.5 : 42 measurements on air-pollution variables recorded at 12:00 noon in the LA area on different days.

air_pollution <- read.delim("D:/Google Drive/1_MASTER_Class/3_2_Multivariate_Analysis/3_Assignment/Wichern_data/T1-5.DAT", header=F, sep="")
colnames(air_pollution) <- c("Wind","Solar_radiation","CO","NO","NO_2","O_3","HC")
head(air_pollution)
  • 주성분 분석을 돌리기 위해 공분산행렬(S)과 상관행렬(R)을 산출 및 고유값과 고유 벡터를 확인
S <- cov(air_pollution)
print(S)
                      Wind Solar_radiation         CO         NO       NO_2        O_3        HC
Wind             2.5000000      -2.7804878 -0.3780488 -0.4634146 -0.5853659 -2.2317073 0.1707317
Solar_radiation -2.7804878     300.5156794  3.9094077 -1.3867596  6.7630662 30.7909408 0.6236934
CO              -0.3780488       3.9094077  1.5220674  0.6736353  2.3147503  2.8217189 0.1416957
NO              -0.4634146      -1.3867596  0.6736353  1.1823461  1.0882695 -0.8106852 0.1765389
NO_2            -0.5853659       6.7630662  2.3147503  1.0882695 11.3635308  3.1265970 1.0441347
O_3             -2.2317073      30.7909408  2.8217189 -0.8106852  3.1265970 30.9785134 0.5946574
HC               0.1707317       0.6236934  0.1416957  0.1765389  1.0441347  0.5946574 0.4785134
eigen(S)
$values
[1] 304.2578640  28.2761046  11.4644830   2.5243296   1.2795247   0.5287288   0.2096157

$vectors
             [,1]        [,2]        [,3]          [,4]          [,5]         [,6]         [,7]
[1,]  0.010039244  0.07622439  0.03087761  0.9203045748  0.3423859285  0.011779079 -0.169729925
[2,] -0.993199405  0.11615518  0.00659069 -0.0002118679  0.0022391022  0.003353218 -0.001781987
[3,] -0.014062314 -0.09956775 -0.18282641 -0.1382922410  0.6500776063 -0.563893916  0.443577538
[4,]  0.004710175  0.01320423 -0.13021553 -0.3277842624  0.6431560485  0.497513370 -0.462855916
[5,] -0.024255644 -0.15038113 -0.95526318  0.1023719020 -0.2065840405 -0.009009299 -0.105029951
[6,] -0.112429558 -0.97335904  0.16981025  0.0632480276 -0.0002935726  0.051067254 -0.066992404
[7,] -0.002340785 -0.02382046 -0.08519558  0.1095073458  0.0619613872  0.657012233  0.738019426
R <- cor(air_pollution)
print(R)
                      Wind Solar_radiation         CO          NO       NO_2        O_3         HC
Wind             1.0000000     -0.10144191 -0.1938032 -0.26954261 -0.1098249 -0.2535928 0.15609793
Solar_radiation -0.1014419      1.00000000  0.1827934 -0.07356907  0.1157320  0.3191237 0.05201044
CO              -0.1938032      0.18279338  1.0000000  0.50215246  0.5565838  0.4109288 0.16603235
NO              -0.2695426     -0.07356907  0.5021525  1.00000000  0.2968981 -0.1339521 0.23470432
NO_2            -0.1098249      0.11573199  0.5565838  0.29689814  1.0000000  0.1666422 0.44776780
O_3             -0.2535928      0.31912373  0.4109288 -0.13395214  0.1666422  1.0000000 0.15445056
HC               0.1560979      0.05201044  0.1660323  0.23470432  0.4477678  0.1544506 1.00000000
eigen(R)
$values
[1] 2.3367826 1.3860007 1.2040659 0.7270865 0.6534765 0.5366888 0.1558989

$vectors
           [,1]         [,2]       [,3]         [,4]        [,5]         [,6]        [,7]
[1,]  0.2368211  0.278445138  0.6434744  0.172719491  0.56053441 -0.223579220 -0.24146701
[2,] -0.2055665 -0.526613869  0.2244690  0.778136601 -0.15613432 -0.005700851 -0.01126548
[3,] -0.5510839 -0.006819502 -0.1136089  0.005301798  0.57342221 -0.109538907  0.58524622
[4,] -0.3776151  0.434674253 -0.4070978  0.290503052 -0.05669070 -0.450234781 -0.46088973
[5,] -0.4980161  0.199767367  0.1965567 -0.042428178  0.05021430  0.744968707 -0.33784371
[6,] -0.3245506 -0.566973655  0.1598465 -0.507915905  0.08024349 -0.330583071 -0.41707805
[7,] -0.3194032  0.307882771  0.5410484 -0.143082348 -0.56607057 -0.266469812  0.31391372
  • 각각의 공분산행렬과 상관행렬을 이용 PCA를 수행
S_pca <- princomp(x=air_pollution) 
print(summary(S_pca),loadings = T)
Importance of components:
                          Comp.1     Comp.2     Comp.3      Comp.4      Comp.5      Comp.6       Comp.7
Standard deviation     17.234083 5.25384279 3.34537279 1.569785488 1.117613433 0.718428856 0.4523547944
Proportion of Variance  0.872948 0.08112714 0.03289281 0.007242569 0.003671092 0.001516979 0.0006014096
Cumulative Proportion   0.872948 0.95407514 0.98696795 0.994210520 0.997881611 0.999398590 1.0000000000

Loadings:
                Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7
Wind                                  0.920  0.342        -0.170
Solar_radiation -0.993  0.116                                   
CO                            -0.183 -0.138  0.650 -0.564  0.444
NO                            -0.130 -0.328  0.643  0.498 -0.463
NO_2                   -0.150 -0.955  0.102 -0.207        -0.105
O_3             -0.112 -0.973  0.170                            
HC                                    0.110         0.657  0.738
R_pca <- princomp(x=air_pollution,cor =T)
print(summary(R_pca),loadings = T)
Importance of components:
                          Comp.1    Comp.2    Comp.3    Comp.4     Comp.5     Comp.6     Comp.7
Standard deviation     1.5286539 1.1772853 1.0972994 0.8526937 0.80837896 0.73259047 0.39484041
Proportion of Variance 0.3338261 0.1980001 0.1720094 0.1038695 0.09335379 0.07666983 0.02227128
Cumulative Proportion  0.3338261 0.5318262 0.7038356 0.8077051 0.90105889 0.97772872 1.00000000

Loadings:
                Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7
Wind             0.237  0.278  0.643  0.173  0.561 -0.224 -0.241
Solar_radiation -0.206 -0.527  0.224  0.778 -0.156              
CO              -0.551        -0.114         0.573 -0.110  0.585
NO              -0.378  0.435 -0.407  0.291        -0.450 -0.461
NO_2            -0.498  0.200  0.197                0.745 -0.338
O_3             -0.325 -0.567  0.160 -0.508        -0.331 -0.417
HC              -0.319  0.308  0.541 -0.143 -0.566 -0.266  0.314
  • 결과 해석
    • 공분산(S)을 이용한 결과 제1주성분이 87%의 데이터를 설명가능하다고 되어 있는데, 제1주성분의 주된 변수는 Solar_radiation(태양복사열) 임.
    • 상관행렬(R)을 이용한 경우 제1,2,3,4주성분을 누적해야 80%의 데이터를 설명 가능함. 그 주성분의 요소들은 다양하게 구성되어있음.
    • 데이터셋에서 각 변수들의 스케일(단위)가 다른 경우에는 공분산을 이용할 때 정규화를 시켜주거나 상관행렬을 이용하는 것이 좋은 결과를 얻을 수 있음.
    • 그렇기 때문에 스케일이 다른 변수들을 비교하는 경우에는 상관관계를 이용하는 것이 더 적절하다고 판단됨.
    • 상관행렬을 이용한 주성분분석을 하게되었을때 최소 4개 이상의 주성분을 이용하는 것이 좋다고 판단됨. 즉 제1,2,3,4주성분을 이용할 경우 전체 데이터의 80%를 설명할 수 있기때문에 즉 설명력이 충분하다고 이야기 할 수 있음.

3. Exercise 8.13(p. 475)

  • 8.13. In the radiotherapy data listed in Table 1.7(see also the radiotherapy data on the website ..). the n = 98 observations on p = 6 variables represent patient`s reations to radotherapy
    1. Obtain the covariance and correlation matrics S and R for these data.
    2. Pick one of the matrices S or R(justify yout choice) and determine the eigenvalues and eigenvectors. Prepare a table showing, in decreasing order by size, the percnet that each eigenvalue contribute to the total sample variance.
    3. Conduct a principal component analysis of the data using the matrices picked in Part b.
    4. Given the results in Part b and c, decide on the number of important sample principal components. Is it possible to summarize the radiotherapy data with a single reaction index components? Explain.
    5. Prepare a table of correlation coefficients between each principal component you decide to retain and the original variables.
radiotherapy <- read.delim("D:/Google Drive/1_MASTER_Class/3_2_Multivariate_Analysis/3_Assignment/Wichern_data/T1-7.DAT", header=F, sep="")
colnames(radiotherapy) <- c("Symptoms","Activity","Sleep","Eat","Appetite","Skin_reaction")
head(radiotherapy)


  1. Obtain the covariance and correlation matrics S and R for these data.
    • 공분산행렬(S)와 상관행렬(R)을 도출.
S <- cov(radiotherapy)
print(S)
               Symptoms    Activity      Sleep        Eat     Appetite Skin_reaction
Symptoms      4.6547509  0.93134537 0.58969909 0.27691531  1.074885659   0.158150852
Activity      0.9313454  0.61282116 0.11093341 0.11846905  0.388886434  -0.024851988
Sleep         0.5896991  0.11093341 0.57142886 0.08700496  0.347989910   0.110131391
Eat           0.2769153  0.11846905 0.08700496 0.11040907  0.217405649   0.021814433
Appetite      1.0748857  0.38888643 0.34798991 0.21740565  0.862172372  -0.008817694
Skin_reaction 0.1581509 -0.02485199 0.11013139 0.02181443 -0.008817694   0.861455923
R <- cor(radiotherapy)
print(R)
                Symptoms    Activity     Sleep        Eat    Appetite Skin_reaction
Symptoms      1.00000000  0.55143669 0.3615773 0.38627479  0.53655840    0.07897812
Activity      0.55143669  1.00000000 0.1874625 0.45544470  0.53500626   -0.03420407
Sleep         0.36157729  0.18746250 1.0000000 0.34638617  0.49577944    0.15696886
Eat           0.38627479  0.45544470 0.3463862 1.00000000  0.70464665    0.07073348
Appetite      0.53655840  0.53500626 0.4957794 0.70464665  1.00000000   -0.01023155
Skin_reaction 0.07897812 -0.03420407 0.1569689 0.07073348 -0.01023155    1.00000000


  1. Pick one of the matrices S or R(justify yout choice) and determine the eigenvalues and eigenvectors. Prepare a table showing, in decreasing order by size, the percnet that each eigenvalue contribute to the total sample variance.
    • 아이젠벡터와 아이젠벡터값을 확인함. 위 데이터의 경우 각 변수의 스케일이 다르기 때문에 상관행렬(R)로 분석을 진행
eigen(S)
$values
[1] 5.28338056 0.88731486 0.76752442 0.43491104 0.24952575 0.05038164

$vectors
           [,1]        [,2]        [,3]        [,4]        [,5]        [,6]
[1,] 0.92848514 -0.01984119  0.34897158 -0.11153020 -0.05642494  0.01085087
[2,] 0.21161527  0.16899493 -0.22680309  0.71009823  0.60716267 -0.04831192
[3,] 0.14237865 -0.15094403 -0.50211919 -0.63510070  0.54883906  0.01559889
[4,] 0.06797085  0.01498160 -0.20314436  0.08586371 -0.12741820  0.96451019
[5,] 0.25882546  0.14375511 -0.72595939  0.11288932 -0.55384501 -0.25659019
[6,] 0.03538335 -0.96300206 -0.07981758  0.24464677 -0.06297391 -0.03444497
eigen(R)
$values
[1] 2.8643078 1.0764496 0.7776412 0.6503143 0.3880318 0.2432554

$vectors
            [,1]        [,2]       [,3]        [,4]        [,5]        [,6]
[1,] -0.44485828 -0.02665962 -0.3393295  0.55114851  0.60085058 -0.14649150
[2,] -0.42929971 -0.29173810 -0.4986071  0.06136723 -0.68729718 -0.07640845
[3,] -0.35877306  0.38013490  0.6281571  0.42105976 -0.33183937 -0.21163500
[4,] -0.46285372 -0.02095878  0.1245847 -0.66560356  0.20741295 -0.53268901
[5,] -0.52127626 -0.07369010  0.2033387 -0.20052634  0.10317525  0.79412736
[6,] -0.05587718  0.87396001 -0.4298804 -0.17871526 -0.05308994  0.11626161


  1. Conduct a principal component analysis of the data using the matrices picked in Part b.
    • 상관행렬을 사용하여 PCA수행
R_pca <- princomp(x=radiotherapy,cor =T)
print(summary(R_pca),loadings = T)
Importance of components:
                          Comp.1    Comp.2    Comp.3    Comp.4     Comp.5     Comp.6
Standard deviation     1.6924266 1.0375209 0.8818396 0.8064207 0.62292196 0.49320928
Proportion of Variance 0.4773846 0.1794083 0.1296069 0.1083857 0.06467196 0.04054257
Cumulative Proportion  0.4773846 0.6567929 0.7863998 0.8947855 0.95945743 1.00000000

Loadings:
              Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6
Symptoms      -0.445        -0.339  0.551 -0.601 -0.146
Activity      -0.429 -0.292 -0.499         0.687       
Sleep         -0.359  0.380  0.628  0.421  0.332 -0.212
Eat           -0.463         0.125 -0.666 -0.207 -0.533
Appetite      -0.521         0.203 -0.201 -0.103  0.794
Skin_reaction         0.874 -0.430 -0.179         0.116
  1. Given the results in Part b and c, decide on the number of important sample principal components. Is it possible to summarize the radiotherapy data with a single reaction index components? Explain.
    • Rule of thumb 적용하여 사용할 주성분의 개수를 정함.
    • Rule of thumb 1 : 누적비율이 적어도 0.8이상 = 제1,2,3,4주성분을 사용하면 누적비율이 92%
    • Rule of thumb 2 : 고유값이 1 이상인 주성분을 선택 = 제 1,2주성분이 고유값이 1 이상임.
    • Rule of thumb 3 : scree plot을 살펴보고 elbow를 확인 = Elbow는 제 4,5주성분 사이로 판단됨.
    • 결과해석 : 산출된 주성분들의 선형식을 살펴볼때 매우 다양한 변수들이 관련되어져있는것을 확인 할 수 있음. 이는 단순히 한가지 변수만으로 주성분을 설명하기에는 다소 무리가 있다고 판단됨.
plot(R_pca)

  1. Prepare a table of correlation coefficients between each principal component you decide to retain and the original variables.
    • 상관행렬과 주성분 분석결과의 변수들을 비교함.
    • 제1주성분의 경우 높은 coefficient를 가지는 변수는 Eat(식사)과 Appetitie(식욕), Symptoms(틍증) 순 임. Eat과 Appetitie의 상관관계는 0.7로 매우 높은 양의 상관관계를 나타낸다고 할 수 있음. 실제로도 식사에 대한것과 식욕에 대한 정보는 매우 종속적일 수 밖에 없음.
    • 제2주성분은 Skin_reation(피부반응)이 주된 변수라고 할 수 있음. 상관관계를 살펴봐도 다른 변수들과 큰 상관관계가 없는 것을 확인 할 수 있음.
print(R) #correlation
                Symptoms    Activity     Sleep        Eat    Appetite Skin_reaction
Symptoms      1.00000000  0.55143669 0.3615773 0.38627479  0.53655840    0.07897812
Activity      0.55143669  1.00000000 0.1874625 0.45544470  0.53500626   -0.03420407
Sleep         0.36157729  0.18746250 1.0000000 0.34638617  0.49577944    0.15696886
Eat           0.38627479  0.45544470 0.3463862 1.00000000  0.70464665    0.07073348
Appetite      0.53655840  0.53500626 0.4957794 0.70464665  1.00000000   -0.01023155
Skin_reaction 0.07897812 -0.03420407 0.1569689 0.07073348 -0.01023155    1.00000000
print(R_pca$loadings) #PCA

Loadings:
              Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6
Symptoms      -0.445        -0.339  0.551 -0.601 -0.146
Activity      -0.429 -0.292 -0.499         0.687       
Sleep         -0.359  0.380  0.628  0.421  0.332 -0.212
Eat           -0.463         0.125 -0.666 -0.207 -0.533
Appetite      -0.521         0.203 -0.201 -0.103  0.794
Skin_reaction         0.874 -0.430 -0.179         0.116

               Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6
SS loadings     1.000  1.000  1.000  1.000  1.000  1.000
Proportion Var  0.167  0.167  0.167  0.167  0.167  0.167
Cumulative Var  0.167  0.333  0.500  0.667  0.833  1.000

3. Exercise 8.18(p. 476)

  • 8.18 The data on national track recoreds for women are listed in Table 1.9
    1. Obtain the sample correlation matrix R for these data, and determine its eginvalues and eigenvectors.
    2. Determine the first two principal components for the standardized variables. Prepare a table showing the correlations of the standardized variables with the components and the cumulative percentage of the total (standardized) sample variance explained by the two compoenets.
    3. Interpret the two principal components obtained in Part B
    1. Rank the nations based on their score on the first principal component
Records <- read.delim("D:/Google Drive/1_MASTER_Class/3_2_Multivariate_Analysis/3_Assignment/Wichern_data/T1-9.DAT", header=F, sep="",stringsAsFactors = F)
colnames(Records) <- c("Country","100m(s)","200m(s)","400m(s)","800m(m)","1500m(m)","3000m(m)","Marathon(m)")
head(Records)
  1. Obtain the sample correlation matrix R for these data, and determine its eginvalues and eigenvectors.
    • 나라에 해당하는 첫번째 변수를 제거하고 주성분분석에 활용
    • 상관행렬 산출 및 eigen values & vectors 산출
Country <- Records$Country
Records_subset <- Records[,2:8]
Record_cor <- cor(Records_subset)
print(Record_cor)
              100m(s)   200m(s)   400m(s)   800m(m)  1500m(m)  3000m(m) Marathon(m)
100m(s)     1.0000000 0.9410886 0.8707802 0.8091758 0.7815510 0.7278784   0.6689597
200m(s)     0.9410886 1.0000000 0.9088096 0.8198258 0.8013282 0.7318546   0.6799537
400m(s)     0.8707802 0.9088096 1.0000000 0.8057904 0.7197996 0.6737991   0.6769384
800m(m)     0.8091758 0.8198258 0.8057904 1.0000000 0.9050509 0.8665732   0.8539900
1500m(m)    0.7815510 0.8013282 0.7197996 0.9050509 1.0000000 0.9733801   0.7905565
3000m(m)    0.7278784 0.7318546 0.6737991 0.8665732 0.9733801 1.0000000   0.7987302
Marathon(m) 0.6689597 0.6799537 0.6769384 0.8539900 0.7905565 0.7987302   1.0000000
eigen(Record_cor)
$values
[1] 5.80762446 0.62869342 0.27933457 0.12455472 0.09097174 0.05451882 0.01430226

$vectors
           [,1]       [,2]       [,3]        [,4]        [,5]        [,6]        [,7]
[1,] -0.3777657 -0.4071756 -0.1405803  0.58706293 -0.16706891  0.53969730  0.08893934
[2,] -0.3832103 -0.4136291 -0.1007833  0.19407501  0.09350016 -0.74493139 -0.26565662
[3,] -0.3680361 -0.4593531  0.2370255 -0.64543118  0.32727328  0.24009405  0.12660435
[4,] -0.3947810  0.1612459  0.1475424 -0.29520804 -0.81905467 -0.01650651 -0.19521315
[5,] -0.3892610  0.3090877 -0.4219855 -0.06669044  0.02613100 -0.18898771  0.73076817
[6,] -0.3760945  0.4231899 -0.4060627 -0.08015699  0.35169796  0.24049968 -0.57150644
[7,] -0.3552031  0.3892153  0.7410610  0.32107640  0.24700821 -0.04826992  0.08208401
  1. Determine the first two principal components for the standardized variables. Prepare a table showing the correlations of the standardized variables with the components and the cumulative percentage of the total (standardized) sample variance explained by the two compoenets.
    • 데이터의 현재 단위가 100m/200m/400m는 초 단위 이며, 800m/1500m/3000m/Marathon의 경우 분단위로 되어 있음. 그렇기에 표본 상관행렬을 사용함.
    • 상위 2개의 주성분으로는 누적비율이 91%가 나오는 것을 확인 할 수 있음.
Record_PCA <- prcomp(Records_subset, scale = T)
summary(Record_PCA)
Importance of components:
                          PC1     PC2    PC3     PC4    PC5     PC6     PC7
Standard deviation     2.4099 0.79290 0.5285 0.35292 0.3016 0.23349 0.11959
Proportion of Variance 0.8297 0.08981 0.0399 0.01779 0.0130 0.00779 0.00204
Cumulative Proportion  0.8297 0.91947 0.9594 0.97717 0.9902 0.99796 1.00000
print(Record_PCA)
Standard deviations:
[1] 2.4099013 0.7929019 0.5285211 0.3529231 0.3016152 0.2334927 0.1195921

Rotation:
                   PC1        PC2        PC3         PC4         PC5         PC6         PC7
100m(s)     -0.3777657  0.4071756  0.1405803 -0.58706293  0.16706891 -0.53969730 -0.08893934
200m(s)     -0.3832103  0.4136291  0.1007833 -0.19407501 -0.09350016  0.74493139  0.26565662
400m(s)     -0.3680361  0.4593531 -0.2370255  0.64543118 -0.32727328 -0.24009405 -0.12660435
800m(m)     -0.3947810 -0.1612459 -0.1475424  0.29520804  0.81905467  0.01650651  0.19521315
1500m(m)    -0.3892610 -0.3090877  0.4219855  0.06669044 -0.02613100  0.18898771 -0.73076817
3000m(m)    -0.3760945 -0.4231899  0.4060627  0.08015699 -0.35169796 -0.24049968  0.57150644
Marathon(m) -0.3552031 -0.3892153 -0.7410610 -0.32107640 -0.24700821  0.04826992 -0.08208401
  1. Interpret the two principal components obtained in Part B
    • 앞서 얻은 2개의 주성분을 이용해서 전체의 91%를 설명할 수 있지만 1개의 주성분의 누적 비율이 82%로 하나의 주성분으로도 충분히 설명력이 있는 것을 확인 할 수 있음.
    • scree plot에서도 제1주성분이 elbow임을 확인 할 수 있음.
plot(Record_PCA)

  1. Rank the nations based on their score on the first principal component
    • 제1주성분의 선형식을 이용하여 각 나라들의 순위를 산출함.
    • 미국, 독일, 러시아, 중국, 프랑스 순으로 확인 되었음.
library(plyr)
a1 <- Record_PCA$rotation[,1]
center <- Record_PCA$center
scale <- Record_PCA$scale
hm <- as.matrix(Records_subset)
PCA_score <- drop(scale(hm,center = center,scale = scale) %*% a1)
PCA_score<- data.frame(PCA_score)
PCA_score<- cbind(Country,PCA_score)
colnames(PCA_score) <- c("Country","Score")
arrange(PCA_score,desc(Score))
LS0tDQp0aXRsZTogIlJlcG9ydDEiDQpvdXRwdXQ6DQogIGh0bWxfbm90ZWJvb2s6DQogICAgZmlnX2NhcHRpb246IHllcw0KICAgIGZpZ193aWR0aDogMTANCiAgICBoaWdobGlnaHQ6IGhhZGRvY2sNCiAgICB0aGVtZTogY29zbW8NCiAgICB0b2M6IHllcw0KICBodG1sX2RvY3VtZW50Og0KICAgIHRvYzogeWVzDQogIHBkZl9kb2N1bWVudDoNCiAgICB0b2M6IHllcw0KICB3b3JkX2RvY3VtZW50Og0KICAgIHRvYzogeWVzDQotLS0NCg0KPT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PQ0KDQpAIEp1bmdId2FuIFl1biAgDQpAIE1hc3RlciBTdHVkZW50IGluIERhdGEtU2NpZW5jZSAgICANCkAgU2VvdWwgTmF0aW9uYWwgVW5pdmVyc2l0eSBvZiBTY2llbmNlICYgVGVjaG5vbG9neShTZW91bFRlY2gpICAgDQpAIEUtbWFpbCA6IGp1bmdod2FuLnl1bkBzZW91bHRlY2guYWMua3IgIA0KDQo9PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09DQoNCj09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT0NCg0KKipbQ29udGVudHNdKioNCg0KKiBUb3BpYyA6IFJlcG9ydCAxKFBDQSkNCiogTXVsdGl2YXJpYXRlX0FuYWx5c2lzIGluIFN0YXRpc3RpY3MNCiogVmVyc2lvbiA6IDEuMA0KPGJyPg0KDQo9PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09DQoNCjxicj48YnI+DQoNCiMgX19Gcm9tIEV2ZXJpdHQgYW5kIEhvdGhvcm4gOiBBbiBJbnRyb2R1Y3Rpb24gdG8gQXBwbGllZCBNdWx0aXZhcmlhdGUgQW5hbHlzaXMgd2l0aCBSX18NCg0KLS0tDQoNCiMjIDEuIEV4My4zDQogICsgRXguIDMuMyBGaW5kIHRoZSBwcmluY2lwYWwgY29tcG9uZW50cyBvZiB0aGUgZm9sbG93aW5nIGNvcnJlbGF0aW9uIG1hdHJpeCBnaXZlbiBieSBNYWNEb25uZWxsICgxOTAyKSBmcm9tIG1lYXN1cmVtZW50cyBvZiBzZXZlbiBwaHlzaWNhbCBjaGFyYWN0ZXJpc3RpY3MgaW4gZWFjaCBvZiAzMDAwIGNvbnZpY3RlZCBjcmltaW5hbHM6IF9fSG93IHdvdWxkIHlvdSBpbnRlcnByZXQgdGhlIGRlcml2ZWQgY29tcG9uZW50cz9fXw0KPGJyPg0KICANCiAgKyAhW10oRDovR29vZ2xlIERyaXZlLzFfTUFTVEVSX0NsYXNzLzNfMl9NdWx0aXZhcmlhdGVfQW5hbHlzaXMvM19Bc3NpZ25tZW50LzFfSFdfY29kZS9UYWJsZTFfMS5wbmcpIA0KDQo8YnI+PGJyPg0KDQogICsgUmVzdWx0IDogu/Ow/Mfgt8TAuyDAzL/rx9EgsOa/7MDHIFBDQbfOLCC787D8x+C3xMC7IMDMv+vHz7+pIHByaW5jb21wKCm4piC89sfgx9G02S4NCiAgICAqILvzsPzH4LfEwLsgTWF0cml4x/zFwrfOIMDUt8K53sC9Lg0KICANCmBgYHtyfQ0KY29yX21hdHJpeCA8LSBtYXRyaXgoYygxLDAuNDAyLDAuMzk2LDAuMzAxLDAuMzA1LDAuMzM5LDAuMzQsDQogICAgICAgICAgICAgICAgICAgICAgIDAuNDAyLDEsMC42MTgsMC4xNSwwLjEzNSwwLjIwNiwwLjE4MywNCiAgICAgICAgICAgICAgICAgICAgICAgMC4zOTYsMC42MTgsMSwwLjMyMSwwLjI4OSwwLjM2MywwLjM0NSwNCiAgICAgICAgICAgICAgICAgICAgICAgMC4zMDEsMC4xNSwwLjMyMSwxLDAuODQ2LDAuNzU5LDAuNjYxLA0KICAgICAgICAgICAgICAgICAgICAgICAwLjMwNSwwLjEzNSwwLjI4OSwwLjg0NiwxLDAuNzk3LDAuOCwNCiAgICAgICAgICAgICAgICAgICAgICAgMC4zMzksMC4yMDYsMC4zNjMsMC43NTksMC43OTcsMSwwLjczNiwNCiAgICAgICAgICAgICAgICAgICAgICAgMC4zNCwwLjE4MywwLjM0NSwwLjY2MSwwLjgsMC43MzYsMSksbnJvdyA9IDcsbmNvbCA9IDcsYnlyb3cgPSBUKQ0KZGltbmFtZXMoY29yX21hdHJpeCkgPC0gbGlzdChjKCJIZWFkLkxlbmd0aCIsIkhlYWQuQnJlYWR0aCIsIkZhY2UuQnJlYWR0aCIsIkxlZnQuZmluZ2VyLmxlbmd0aCINCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAsIkxlZnQuZm9yZWFybS5sZW5ndGgiLCJMZWZ0LmZvb3QubGVuZ3RoIiwiSGVpZ2h0IiksDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgIGMoIkhlYWQuTGVuZ3RoIiwiSGVhZC5CcmVhZHRoIiwiRmFjZS5CcmVhZHRoIiwiTGVmdC5maW5nZXIubGVuZ3RoIg0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICwiTGVmdC5mb3JlYXJtLmxlbmd0aCIsIkxlZnQuZm9vdC5sZW5ndGgiLCJIZWlnaHQiKSkNCg0KcHJpbnQoY29yX21hdHJpeCkNCmBgYA0KPGJyPg0KDQoqILvzsPzH4LfEwMcgUENByMQgwda8urrQwLsgw9/D4sfULiANCiAgICArILvzsPzH4LfEwLsgu+e/68fPseIgtqe5rr+hIGNvciA9VCC3ziC8s8GkLCC2x8fRIMH3waLA+8C4t84gu/Ow/Mfgt8TAuyC757/rx8+x4iC2p7muv6EgY292bWF0IL/JvMfAuyC757/rDQogICAgKyDBpjEsMiwzIMHWvLq60MC7IMfVx8+46SC0qcD7IDg1JcDHILWlwMzFzbimILyzuO3Hz7TCILDNwMwgsKG0ycfULg0KICAgICsgw7m5+MKwIMHWvLq60L+hILTrx9EgvLHH/LDhx9XAuyDIrsDOx8+46SA3sKHB9sDHILqvvPawoSC48LXOIMiwv+u1ysC7IL7LILz2IMDWwL0uILXOufjCsCDB1ry6utDAuiC407iuxviw+iC+87G8xvjAxyDAvcDHILyxx/yw/LDouKYgs6rFuLO7sO0gwNbAvS4gvLy5+MKwIMHWvLq60MC6ILjTuK4gsebAzLChIL7nwMcgsPyw6LimILq4wMyw7SDA1sC9wLsgyK7AzsfULiCw4bG5ILn8wcvA2rXpwLsguNO4rsb4sPogvvOxvMb4wMwgwNuwxbOqILjTuK7AxyCx5sDMsKEgseQgsOa/7LChILi5vtLAvcC7IL7LILz2IMDWwL0uIA0KICAgIA0KYGBge3J9DQpoZWFkX3BjYSA8LSBwcmluY29tcChjb3ZtYXQgPSBjb3JfbWF0cml4LGNvciA9IFQpIA0KcHJpbnQoc3VtbWFyeShoZWFkX3BjYSksIGxvYWRpbmdzID0gVCkNCmBgYA0KDQo8YnI+PGJyPg0KDQojIF9fQXBwbGllZCBNdWx0aXZhcmlhdGUgU3RhdGlzdGljYWwgQW5hbHlzaXMgYnkgSm9obnNvbiBhbmQgV2ljaGVybl9fDQoNCi0tLQ0KDQojIyAyLiBFeGVyY2lzZSA4LjEyKHAuIDQ3NCkNCiAgKyA4LjEyLiBDb25zaWRlciB0aGUgYWlyLXBvbGx1dGlvbiBkYXRhIGxpc3RlZCBpbiBUYWJsZTEuNS4gWW91ciBqb2IgaXMgdG8gc3VtbWFyaXplIHRoZXNlIGRhdGEgaW4gZmV3ZXIgdGhhbiBwID0gNyBkaW1lbnNpb25zIGlmIHBvc3NpYmxlLiBDb25kdWN0IGEgcHJpbmNpcGFsIGNvbXBvZW5ldCBhbmFseXNpcyBvZiB0aGUgZGF0YSB1c2luZyBib3RoIHRoZSBjb3ZhcmlhbmNlIG1hdHJpeCBTIGFuZCB0aGUgY29ycmVsYXRpb24gbWF0cml4IFIuIFdoYXQgaGF2ZSB5b3UgbGVhcm5kPyBEb2VzIGl0IG1ha2UgYW55IGRpZmZlcmVuY2Ugd2hpY2ggbWF0cml4IGlzIGNob3NlbiBmb3IgYW5hbHlzaXM/IENhbiBkYXRhIGJlIHN1bW1hcml6ZWQgaW4gdGhyZWUgb3IgZmV3ZXIgZGltZW5zaW9ucz8gQ2FuIHlvdSBpbnRlcnByZXQgdGhlIHByaW5jaXBhbCBjb21wb25lbnRzPw0KICANCiAgKyBfX1RhYmxlMS41X18gOiA0MiBtZWFzdXJlbWVudHMgb24gYWlyLXBvbGx1dGlvbiB2YXJpYWJsZXMgcmVjb3JkZWQgYXQgMTI6MDAgbm9vbiBpbiB0aGUgTEEgYXJlYSBvbiBkaWZmZXJlbnQgZGF5cy4NCg0KYGBge3J9DQphaXJfcG9sbHV0aW9uIDwtIHJlYWQuZGVsaW0oIkQ6L0dvb2dsZSBEcml2ZS8xX01BU1RFUl9DbGFzcy8zXzJfTXVsdGl2YXJpYXRlX0FuYWx5c2lzLzNfQXNzaWdubWVudC9XaWNoZXJuX2RhdGEvVDEtNS5EQVQiLCBoZWFkZXI9Riwgc2VwPSIiKQ0KY29sbmFtZXMoYWlyX3BvbGx1dGlvbikgPC0gYygiV2luZCIsIlNvbGFyX3JhZGlhdGlvbiIsIkNPIiwiTk8iLCJOT18yIiwiT18zIiwiSEMiKQ0KaGVhZChhaXJfcG9sbHV0aW9uKQ0KYGBgDQoNCiAgKiDB1ry6utAgutC8rsC7ILW5uK6x4iDAp8fYILD4utC76sfgt8QoUymw+iC787D8x+C3xChSKcC7ILvqw+IgudcgsO3Ar7CqsPogsO3AryC6pMXNuKYgyK7Azg0KYGBge3J9DQoNClMgPC0gY292KGFpcl9wb2xsdXRpb24pDQpwcmludChTKQ0KZWlnZW4oUykNCg0KUiA8LSBjb3IoYWlyX3BvbGx1dGlvbikNCnByaW50KFIpDQplaWdlbihSKQ0KYGBgDQoNCiogsKKwosDHILD4utC76sfgt8Sw+iC787D8x+C3xMC7IMDMv+sgUENBuKYgvPbH4A0KDQpgYGB7cn0NClNfcGNhIDwtIHByaW5jb21wKHg9YWlyX3BvbGx1dGlvbikgDQpwcmludChzdW1tYXJ5KFNfcGNhKSxsb2FkaW5ncyA9IFQpDQpgYGANCmBgYHtyfQ0KUl9wY2EgPC0gcHJpbmNvbXAoeD1haXJfcG9sbHV0aW9uLGNvciA9VCkNCnByaW50KHN1bW1hcnkoUl9wY2EpLGxvYWRpbmdzID0gVCkNCmBgYA0KDQoqILDhsPogx9i8rg0KICAgICsgsPi60LvqKFMpwLsgwMy/68fRILDhsPogwaYxwda8urrQwMwgODclwMcgtaXAzMXNuKYgvLO47bChtMnHz7TZsO0gtce+7iDA1rTCtaUsIMGmMcHWvLq60MDHIMHWtcgguq+89rTCIFNvbGFyX3JhZGlhdGlvbijFwr7nurm757+tKSDA0y4gICANCiAgICArILvzsPzH4LfEKFIpwLsgwMy/68fRILDmv+wgwaYxLDIsMyw0wda8urrQwLsgtKnA+8fYvt8gODAlwMcgtaXAzMXNuKYgvLO47SCwobTJx9QuICCx1yDB1ry6utDAxyC/5LzStenAuiC02b7nx8+w1CCxuLy6tce+7sDWwL0uDQogICAgKyC1pcDMxc28wr+hvK0gsKIguq+89rXpwMcgvbrEycDPKLTcwKcpsKEgtNm4pSCw5r/sv6G0wiCw+LrQu+rAuyDAzL/rx9IgtqcgwaSx1MituKYgvcPE0cHWsMWzqiC787D8x+C3xMC7IMDMv+vHz7TCILDNwMwgwcHAuiCw4bD6uKYgvvLAuyC89iDA1sC9LiANCiAgICArILHXt7ix4iC2p7muv6EgvbrEycDPwMwgtNm4pSC6r7z2tenAuyC68bGzx8+0wiCw5r/sv6G0wiC787D8sPyw6LimIMDMv+vHz7TCILDNwMwgtPUgwPvA/cfPtNmw7SDGx7TctcouIA0KICAgICsgu/Ow/Mfgt8TAuyDAzL/rx9Egwda8urrQutC8rsC7IMfPsNS1x776wLu2pyDD1rzSIDSwsyDAzLvzwMcgwda8urrQwLsgwMy/68fPtMIgsM3AzCDBwbTZsO0gxse03LXKLiDB7yDBpjEsMiwzLDTB1ry6utDAuyDAzL/rx9IgsOa/7CDA/MO8ILWlwMzFzcDHIDgwJbimILyzuO3H0iC89iDA1rHitqe5rr+hIMHvILyzuO23wsDMIMPmutDHz7TZsO0gwMy+37HiIMfSILz2IMDWwL0uIA0KDQoNCiAgICANCiMjIDMuIEV4ZXJjaXNlIDguMTMocC4gNDc1KQ0KICAqIDguMTMuIEluIHRoZSByYWRpb3RoZXJhcHkgZGF0YSBsaXN0ZWQgaW4gVGFibGUgMS43KHNlZSBhbHNvIHRoZSByYWRpb3RoZXJhcHkgZGF0YSBvbiB0aGUgd2Vic2l0ZSAuLikuIHRoZSBuID0gOTggb2JzZXJ2YXRpb25zIG9uIHAgPSA2IHZhcmlhYmxlcyByZXByZXNlbnQgcGF0aWVudGBzIHJlYXRpb25zIHRvIHJhZG90aGVyYXB5DQogICAgKGEpIE9idGFpbiB0aGUgY292YXJpYW5jZSBhbmQgY29ycmVsYXRpb24gbWF0cmljcyBTIGFuZCBSIGZvciB0aGVzZSBkYXRhLiANCiAgICAoYikgUGljayBvbmUgb2YgdGhlIG1hdHJpY2VzIFMgb3IgUihqdXN0aWZ5IHlvdXQgY2hvaWNlKSBhbmQgZGV0ZXJtaW5lIHRoZSBlaWdlbnZhbHVlcyBhbmQgZWlnZW52ZWN0b3JzLiBQcmVwYXJlIGEgdGFibGUgc2hvd2luZywgaW4gZGVjcmVhc2luZyBvcmRlciBieSBzaXplLCB0aGUgcGVyY25ldCB0aGF0IGVhY2ggZWlnZW52YWx1ZSBjb250cmlidXRlIHRvIHRoZSB0b3RhbCBzYW1wbGUgdmFyaWFuY2UuDQogICAgKGMpIENvbmR1Y3QgYSBwcmluY2lwYWwgY29tcG9uZW50IGFuYWx5c2lzIG9mIHRoZSBkYXRhIHVzaW5nIHRoZSBtYXRyaWNlcyBwaWNrZWQgaW4gUGFydCBiLg0KICAgIChkKSBHaXZlbiB0aGUgcmVzdWx0cyBpbiBQYXJ0IGIgYW5kIGMsIGRlY2lkZSBvbiB0aGUgbnVtYmVyIG9mIGltcG9ydGFudCBzYW1wbGUgcHJpbmNpcGFsIGNvbXBvbmVudHMuIElzIGl0IHBvc3NpYmxlIHRvIHN1bW1hcml6ZSB0aGUgcmFkaW90aGVyYXB5IGRhdGEgd2l0aCBhIHNpbmdsZSByZWFjdGlvbiBpbmRleCBjb21wb25lbnRzPyBFeHBsYWluLg0KICAgIChlKSBQcmVwYXJlIGEgdGFibGUgb2YgY29ycmVsYXRpb24gY29lZmZpY2llbnRzIGJldHdlZW4gZWFjaCBwcmluY2lwYWwgY29tcG9uZW50IHlvdSBkZWNpZGUgdG8gcmV0YWluIGFuZCB0aGUgb3JpZ2luYWwgdmFyaWFibGVzLiANCiAgDQpgYGB7cn0NCnJhZGlvdGhlcmFweSA8LSByZWFkLmRlbGltKCJEOi9Hb29nbGUgRHJpdmUvMV9NQVNURVJfQ2xhc3MvM18yX011bHRpdmFyaWF0ZV9BbmFseXNpcy8zX0Fzc2lnbm1lbnQvV2ljaGVybl9kYXRhL1QxLTcuREFUIiwgaGVhZGVyPUYsIHNlcD0iIikNCmNvbG5hbWVzKHJhZGlvdGhlcmFweSkgPC0gYygiU3ltcHRvbXMiLCJBY3Rpdml0eSIsIlNsZWVwIiwiRWF0IiwiQXBwZXRpdGUiLCJTa2luX3JlYWN0aW9uIikNCmhlYWQocmFkaW90aGVyYXB5KQ0KYGBgDQo8YnI+DQoNCiAgKGEpIE9idGFpbiB0aGUgY292YXJpYW5jZSBhbmQgY29ycmVsYXRpb24gbWF0cmljcyBTIGFuZCBSIGZvciB0aGVzZSBkYXRhLiANCiAgICArILD4utC76sfgt8QoUym/zSC787D8x+C3xChSKcC7ILW1w+IuDQoNCmBgYHtyfQ0KUyA8LSBjb3YocmFkaW90aGVyYXB5KQ0KcHJpbnQoUykNCmBgYA0KYGBge3J9DQpSIDwtIGNvcihyYWRpb3RoZXJhcHkpDQpwcmludChSKQ0KYGBgDQo8YnI+DQoNCiAgKGIpIFBpY2sgb25lIG9mIHRoZSBtYXRyaWNlcyBTIG9yIFIoanVzdGlmeSB5b3V0IGNob2ljZSkgYW5kIGRldGVybWluZSB0aGUgZWlnZW52YWx1ZXMgYW5kIGVpZ2VudmVjdG9ycy4gUHJlcGFyZSBhIHRhYmxlIHNob3dpbmcsIGluIGRlY3JlYXNpbmcgb3JkZXIgYnkgc2l6ZSwgdGhlIHBlcmNuZXQgdGhhdCBlYWNoIGVpZ2VudmFsdWUgY29udHJpYnV0ZSB0byB0aGUgdG90YWwgc2FtcGxlIHZhcmlhbmNlLg0KICAgICsgvsbAzMGouqTFzb/NIL7GwMzBqLqkxc2wqsC7IMiuwM7H1C4gwKcgtaXAzMXNwMcgsOa/7CCwoiC6r7z2wMcgvbrEycDPwMwgtNm4o7HiILanua6/oSC787D8x+C3xChSKbfOILrQvK7AuyDB+MfgIA0KDQpgYGB7cn0NCmVpZ2VuKFMpDQplaWdlbihSKQ0KYGBgDQo8YnI+DQoNCiAgKGMpIENvbmR1Y3QgYSBwcmluY2lwYWwgY29tcG9uZW50IGFuYWx5c2lzIG9mIHRoZSBkYXRhIHVzaW5nIHRoZSBtYXRyaWNlcyBwaWNrZWQgaW4gUGFydCBiLg0KICAgICsgu/Ow/Mfgt8TAuyC757/rx8+/qSBQQ0G89sfgDQpgYGB7cn0NClJfcGNhIDwtIHByaW5jb21wKHg9cmFkaW90aGVyYXB5LGNvciA9VCkNCnByaW50KHN1bW1hcnkoUl9wY2EpLGxvYWRpbmdzID0gVCkNCmBgYA0KICANCiAgKGQpIEdpdmVuIHRoZSByZXN1bHRzIGluIFBhcnQgYiBhbmQgYywgZGVjaWRlIG9uIHRoZSBudW1iZXIgb2YgaW1wb3J0YW50IHNhbXBsZSBwcmluY2lwYWwgY29tcG9uZW50cy4gSXMgaXQgcG9zc2libGUgdG8gc3VtbWFyaXplIHRoZSByYWRpb3RoZXJhcHkgZGF0YSB3aXRoIGEgc2luZ2xlIHJlYWN0aW9uIGluZGV4IGNvbXBvbmVudHM/IEV4cGxhaW4uDQogICAgKyBSdWxlIG9mIHRodW1iIMD7v+vHz7+pILvnv+vH0iDB1ry6utDAxyCws7z2uKYgwaTH1C4NCiAgICArIFJ1bGUgb2YgdGh1bWIgMSA6ILSpwPu68cCywMwgwPu+7rW1IDAuOMDMu/MgPSDBpjEsMiwzLDTB1ry6utDAuyC757/rx8+46SC0qcD7uvHAssDMIDkyJQ0KICAgICsgUnVsZSBvZiB0aHVtYiAyIDogsO3Ar7CqwMwgMSDAzLvzwM4gwda8urrQwLsgvLHFwyAgPSDBpiAxLDLB1ry6utDAzCCw7cCvsKrAzCAxIMDMu/PA0y4gDQogICAgKyBSdWxlIG9mIHRodW1iIDMgOiBzY3JlZSBwbG90wLsgu+zG7Lq4sO0gZWxib3e4piDIrsDOID0gRWxib3e0wiDBpiA0LDXB1ry6utAgu+fAzLfOIMbHtNy1yi4gDQogICAgKyCw4bD6x9i8riA6ILvqw+K1yCDB1ry6utC16cDHILyxx/y9xMC7ILvsxuy6vLanILjFv+wgtNm+58fRILqvvPa16cDMILD8t8O1x77uwa7A1rTCsM3AuyDIrsDOIMfSILz2IMDWwL0uIMDMtMIgtNy8+Mj3IMfRsKHB9iC6r7z2uLjAuLfOIMHWvLq60MC7ILyzuO3Hz7Hiv6G0wiC02bzSILmruK6woSDA1rTZsO0gxse03LXKLg0KDQpgYGB7cn0NCnBsb3QoUl9wY2EpDQpgYGANCg0KICAoZSkgUHJlcGFyZSBhIHRhYmxlIG9mIGNvcnJlbGF0aW9uIGNvZWZmaWNpZW50cyBiZXR3ZWVuIGVhY2ggcHJpbmNpcGFsIGNvbXBvbmVudCB5b3UgZGVjaWRlIHRvIHJldGFpbiBhbmQgdGhlIG9yaWdpbmFsIHZhcmlhYmxlcy4gDQogICAgKyC787D8x+C3xLD6IMHWvLq60CC60LyusOGw+sDHILqvvPa16cC7ILrxsbPH1C4gDQogICAgKyDBpjHB1ry6utDAxyCw5r/sILP0wLogY29lZmZpY2llbnS4piCwocH2tMIguq+89rTCIEVhdCi9xLvnKbD6IEFwcGV0aXRpZSi9xL/lKSwgU3ltcHRvbXMounbB9SkgvPggwNMuIEVhdLD6IEFwcGV0aXRpZcDHILvzsPyw/LDotMIgMC43t84guMW/7CCz9MC6IL7nwMcgu/Ow/LD8sOi4piCzqsW4s7202bDtIMfSILz2IMDWwL0uIL3Hwaa3zrW1IL3Eu+e/oSC068fRsM2w+iC9xL/lv6EgtOvH0SDBpLq4tMIguMW/7CDBvrzTwPvAzyC89iC527+hIL74wL0uDQogICAgKyDBpjLB1ry6utDAuiBTa2luX3JlYXRpb24ox8e6zrndwMApwMwgwda1yCC6r7z2tvOw7SDH0iC89iDA1sC9LiC787D8sPyw6LimILvsxuy6wbW1ILTZuKUguq+89rXpsPogxasgu/Ow/LD8sOiwoSC++LTCILDNwLsgyK7AziDH0iC89iDA1sC9LiAgDQpgYGB7cn0NCnByaW50KFIpICNjb3JyZWxhdGlvbg0KcHJpbnQoUl9wY2EkbG9hZGluZ3MpICNQQ0ENCmBgYA0KDQojIyAzLiBFeGVyY2lzZSA4LjE4KHAuIDQ3NikNCiAgKiA4LjE4IFRoZSBkYXRhIG9uIG5hdGlvbmFsIHRyYWNrIHJlY29yZWRzIGZvciB3b21lbiBhcmUgbGlzdGVkIGluIFRhYmxlIDEuOQ0KICAgIChhKSBPYnRhaW4gdGhlIHNhbXBsZSBjb3JyZWxhdGlvbiBtYXRyaXggUiBmb3IgdGhlc2UgZGF0YSwgYW5kIGRldGVybWluZSBpdHMgZWdpbnZhbHVlcyBhbmQgZWlnZW52ZWN0b3JzLg0KICAgIChiKSBEZXRlcm1pbmUgdGhlIGZpcnN0IHR3byBwcmluY2lwYWwgY29tcG9uZW50cyBmb3IgdGhlIHN0YW5kYXJkaXplZCB2YXJpYWJsZXMuIFByZXBhcmUgYSB0YWJsZSBzaG93aW5nIHRoZSBjb3JyZWxhdGlvbnMgb2YgdGhlIHN0YW5kYXJkaXplZCB2YXJpYWJsZXMgd2l0aCB0aGUgY29tcG9uZW50cyBhbmQgdGhlIGN1bXVsYXRpdmUgcGVyY2VudGFnZSBvZiB0aGUgdG90YWwgKHN0YW5kYXJkaXplZCkgc2FtcGxlIHZhcmlhbmNlIGV4cGxhaW5lZCBieSB0aGUgdHdvIGNvbXBvZW5ldHMuDQogICAgKGMpIEludGVycHJldCB0aGUgdHdvIHByaW5jaXBhbCBjb21wb25lbnRzIG9idGFpbmVkIGluIFBhcnQgQg0KICAgIChEKSBSYW5rIHRoZSBuYXRpb25zIGJhc2VkIG9uIHRoZWlyIHNjb3JlIG9uIHRoZSBmaXJzdCBwcmluY2lwYWwgY29tcG9uZW50DQogICAgDQpgYGB7cn0NClJlY29yZHMgPC0gcmVhZC5kZWxpbSgiRDovR29vZ2xlIERyaXZlLzFfTUFTVEVSX0NsYXNzLzNfMl9NdWx0aXZhcmlhdGVfQW5hbHlzaXMvM19Bc3NpZ25tZW50L1dpY2hlcm5fZGF0YS9UMS05LkRBVCIsIGhlYWRlcj1GLCBzZXA9IiIsc3RyaW5nc0FzRmFjdG9ycyA9IEYpDQpjb2xuYW1lcyhSZWNvcmRzKSA8LSBjKCJDb3VudHJ5IiwiMTAwbShzKSIsIjIwMG0ocykiLCI0MDBtKHMpIiwiODAwbShtKSIsIjE1MDBtKG0pIiwiMzAwMG0obSkiLCJNYXJhdGhvbihtKSIpDQpoZWFkKFJlY29yZHMpDQpgYGANCiAgICANCiAgKGEpIE9idGFpbiB0aGUgc2FtcGxlIGNvcnJlbGF0aW9uIG1hdHJpeCBSIGZvciB0aGVzZSBkYXRhLCBhbmQgZGV0ZXJtaW5lIGl0cyBlZ2ludmFsdWVzIGFuZCBlaWdlbnZlY3RvcnMuDQogICAgKyCzqrbzv6Egx9i058fPtMIgw7m5+MKwILqvvPa4piDBprDFx8+w7SDB1ry6utC60Lyuv6EgyLC/6w0KICAgICsgu/Ow/Mfgt8Qgu+rD4iC51yBlaWdlbiB2YWx1ZXMgJiB2ZWN0b3JzILvqw+IgDQpgYGB7cn0NCkNvdW50cnkgPC0gUmVjb3JkcyRDb3VudHJ5DQpSZWNvcmRzX3N1YnNldCA8LSBSZWNvcmRzWywyOjhdDQpSZWNvcmRfY29yIDwtIGNvcihSZWNvcmRzX3N1YnNldCkNCnByaW50KFJlY29yZF9jb3IpDQplaWdlbihSZWNvcmRfY29yKQ0KYGBgDQoNCiAgKGIpIERldGVybWluZSB0aGUgZmlyc3QgdHdvIHByaW5jaXBhbCBjb21wb25lbnRzIGZvciB0aGUgc3RhbmRhcmRpemVkIHZhcmlhYmxlcy4gUHJlcGFyZSBhIHRhYmxlIHNob3dpbmcgdGhlIGNvcnJlbGF0aW9ucyBvZiB0aGUgc3RhbmRhcmRpemVkIHZhcmlhYmxlcyB3aXRoIHRoZSBjb21wb25lbnRzIGFuZCB0aGUgY3VtdWxhdGl2ZSBwZXJjZW50YWdlIG9mIHRoZSB0b3RhbCAoc3RhbmRhcmRpemVkKSBzYW1wbGUgdmFyaWFuY2UgZXhwbGFpbmVkIGJ5IHRoZSB0d28gY29tcG9lbmV0cy4NCiAgICArILWlwMzFzcDHIMf2wOcgtNzAp7ChIDEwMG0vMjAwbS80MDBttMIgw8ogtNzApyDAzLjnLCA4MDBtLzE1MDBtLzMwMDBtL01hcmF0aG9uwMcgsOa/7CC60LTcwKe3ziC1x77uIMDWwL0uILHXt7ix4r+hIMelursgu/Ow/Mfgt8TAuyC757/rx9QuDQogICAgKyC788CnIDKws8DHIMHWvLq60MC4t860wiC0qcD7uvHAssDMIDkxJbChILOqv8C0wiCwzcC7IMiuwM4gx9IgvPYgwNbAvS4gDQogICAgDQpgYGB7cn0NClJlY29yZF9QQ0EgPC0gcHJjb21wKFJlY29yZHNfc3Vic2V0LCBzY2FsZSA9IFQpDQpzdW1tYXJ5KFJlY29yZF9QQ0EpDQpwcmludChSZWNvcmRfUENBKQ0KYGBgDQoNCiAgKGMpIEludGVycHJldCB0aGUgdHdvIHByaW5jaXBhbCBjb21wb25lbnRzIG9idGFpbmVkIGluIFBhcnQgQg0KICAgICsgvtW8rSC+8sC6IDKws8DHIMHWvLq60MC7IMDMv+vH2LytIMD8w7zAxyA5MSW4piC8s7jtx9IgvPYgwNbB9ri4IDGws8DHIMHWvLq60MDHILSpwPsguvHAssDMIDgyJbfOIMfPs6rAxyDB1ry6utDAuLfOtbUgw+a60Mj3ILyzuO23wsDMIMDWtMIgsM3AuyDIrsDOIMfSILz2IMDWwL0uIA0KICAgICsgc2NyZWUgcGxvdL+hvK21tSDBpjHB1ry6utDAzCBlbGJvd8DTwLsgyK7AziDH0iC89iDA1sC9LiANCg0KYGBge3J9DQpwbG90KFJlY29yZF9QQ0EpDQpgYGANCg0KICAoRCkgUmFuayB0aGUgbmF0aW9ucyBiYXNlZCBvbiB0aGVpciBzY29yZSBvbiB0aGUgZmlyc3QgcHJpbmNpcGFsIGNvbXBvbmVudA0KICAgICsgwaYxwda8urrQwMcgvLHH/L3EwLsgwMy/68fPv6kgsKIgs6q287XpwMcgvPjAp7imILvqw+LH1C4NCiAgICArILnMsbksILW2wM8sILevvcO+xiwgwd+xuSwgx8G2+726ILz4wLi3ziDIrsDOILXHvvrAvS4gDQoNCmBgYHtyfQ0KbGlicmFyeShwbHlyKQ0KYTEgPC0gUmVjb3JkX1BDQSRyb3RhdGlvblssMV0NCmNlbnRlciA8LSBSZWNvcmRfUENBJGNlbnRlcg0Kc2NhbGUgPC0gUmVjb3JkX1BDQSRzY2FsZQ0KaG0gPC0gYXMubWF0cml4KFJlY29yZHNfc3Vic2V0KQ0KUENBX3Njb3JlIDwtIGRyb3Aoc2NhbGUoaG0sY2VudGVyID0gY2VudGVyLHNjYWxlID0gc2NhbGUpICUqJSBhMSkNClBDQV9zY29yZTwtIGRhdGEuZnJhbWUoUENBX3Njb3JlKQ0KUENBX3Njb3JlPC0gY2JpbmQoQ291bnRyeSxQQ0Ffc2NvcmUpDQpjb2xuYW1lcyhQQ0Ffc2NvcmUpIDwtIGMoIkNvdW50cnkiLCJTY29yZSIpDQphcnJhbmdlKFBDQV9zY29yZSxkZXNjKFNjb3JlKSkNCmBgYA0K