#Memasukkan Data dari Excel ke R
library(readxl)
Data_PCA<- read_excel("Data_PCA_Anisa Rahma.xlsx")
print(Data_PCA)
## # A tibble: 23 × 8
## x1 x2 x3 x4 x5 x6 x7 x8
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 9.73 98.6 14.1 17.9 1186903 6 65.5 67.3
## 2 8.69 97.5 14.3 24.3 1951110 6.88 67.6 69.6
## 3 8.89 96.7 14.7 30.8 1610706 4.82 64.6 67.9
## 4 9.92 98 14.3 28.4 1400900 5.09 68.5 70.3
## 5 8.32 98.8 13.1 62.2 1699560 8.07 68.9 68.7
## 6 9.87 99.4 14.6 31.5 1565937 4.44 69.0 74.0
## 7 9.87 98.7 14.6 38.5 2431963 6.09 68.2 72.3
## 8 10.4 98.8 14.8 58.2 1877909 8.28 70.0 74
## 9 9.02 95.8 14.5 85.9 1534197 5.94 67.2 71.2
## 10 9.31 99.2 14.9 60.3 1400303 4.2 71.5 73.2
## # ℹ 13 more rows
#Menentukan multikolineritas
VIF <- function(x){
VIF <- diag(solve(cor(x)))
result <- ifelse(VIF > 10,"multicolinearity","non
multicolinearity")
data1 <- data.frame(VIF,result)
return(data1)
}
VIF(Data_PCA)
## VIF result
## x1 13.274889 multicolinearity
## x2 2.554840 non\n multicolinearity
## x3 4.638332 non\n multicolinearity
## x4 1.619996 non\n multicolinearity
## x5 1.236628 non\n multicolinearity
## x6 1.865777 non\n multicolinearity
## x7 6.734589 non\n multicolinearity
## x8 25.985025 multicolinearity
#Karena skala pengukuran berbeda digunakan matrik korelasi
# Standarisasi data (Z-score normalization)
data_scaled <- scale(Data_PCA)
data_scaled
## x1 x2 x3 x4 x5 x6
## [1,] 0.11393812 0.37431941 -0.53766202 -0.7038710 -1.5692786 0.126047363
## [2,] -0.77963562 -0.50386529 -0.24930158 -0.4394085 0.9386230 0.584896039
## [3,] -0.60779452 -1.10761728 0.13887593 -0.1757634 -0.1784824 -0.489226997
## [4,] 0.27718717 -0.08829575 -0.33802787 -0.2722289 -0.8670037 -0.348443881
## [5,] -1.09754167 0.51545624 -1.66892220 1.1069005 0.1131102 1.205384589
## [6,] 0.23422690 0.99375327 0.05014964 -0.1463332 -0.3254010 -0.687366198
## [7,] 0.23422690 0.45272876 0.07233121 0.1381582 2.5166405 0.172975069
## [8,] 0.64664555 0.55466092 0.20542065 0.9442172 0.6983990 1.314882568
## [9,] -0.49609780 -1.80546049 -0.08293979 2.0760516 -0.4295623 0.094762226
## [10,] -0.24692820 0.87613925 0.32741929 1.0304639 -0.8689628 -0.812506745
## [11,] -0.74526740 0.60170653 0.18323907 2.9405622 0.3261224 0.689179829
## [12,] -0.78822768 -1.04488980 -1.00347504 -0.4528973 -1.0218049 -0.854220261
## [13,] -1.02021317 -1.90739264 -0.53766202 -0.6944697 -0.8734358 -1.594635170
## [14,] -0.47891369 -0.04909107 -0.67075145 0.1295744 -0.5687952 0.845605514
## [15,] -0.55624219 -0.26079631 -0.44893573 -0.2227699 2.3208704 0.042620332
## [16,] -0.75385946 -2.03284760 -0.61529752 -0.9380859 -0.3009326 -1.375639211
## [17,] 0.35451567 0.81341177 -0.94802111 -0.2922577 -0.2741408 -1.641562875
## [18,] -0.05790298 -0.51170623 0.46050873 -0.1908872 -0.8815580 -0.708222956
## [19,] 2.94931636 1.17409477 3.59920119 -0.6204856 1.0158120 1.492165011
## [20,] 1.36837819 0.96238953 -0.18275687 -1.2242124 0.1946442 -0.911576346
## [21,] 1.32541792 1.00159420 1.19250061 -0.6405145 -0.4594324 1.090672420
## [22,] 1.30823381 1.02511701 0.78214152 -0.4925462 0.3567505 1.768517054
## [23,] -1.18346222 -0.03340920 0.27196536 -0.8591968 0.1378182 -0.004307374
## x7 x8
## [1,] -1.35566868 -1.06441287
## [2,] -0.39018033 -0.54815734
## [3,] -1.72940611 -0.93260295
## [4,] -0.02089215 -0.39437910
## [5,] 0.18377358 -0.74587222
## [6,] 0.23271539 0.40307092
## [7,] -0.14992055 0.04938096
## [8,] 0.65094537 0.41405508
## [9,] -0.61264308 -0.20105789
## [10,] 1.31388437 0.22952119
## [11,] 0.21491837 -0.41634742
## [12,] -1.43575528 -1.03365722
## [13,] -1.22664029 -0.84912333
## [14,] 0.59755430 -0.37021395
## [15,] 0.41068559 -0.44270941
## [16,] -0.50141170 -0.38559178
## [17,] 0.42403336 0.39208676
## [18,] 0.83781408 0.48874737
## [19,] 1.45181128 3.11176479
## [20,] 1.00688577 1.04015220
## [21,] 0.49077218 1.25324491
## [22,] 1.48740532 1.30157521
## [23,] -1.88068079 -1.29947389
## attr(,"scaled:center")
## x1 x2 x3 x4 x5 x6
## 9.597391e+00 9.811261e+01 1.456478e+01 3.508000e+01 1.665093e+06 5.758261e+00
## x7 x8
## 6.852696e+01 7.211522e+01
## attr(,"scaled:scale")
## x1 x2 x3 x4 x5 x6
## 1.163866e+00 1.275358e+00 9.016493e-01 2.446471e+01 3.047197e+05 1.917844e+00
## x7 x8
## 2.247567e+00 4.552009e+00
# Matriks Korelasi (rho)
cov_matrix <- cov(data_scaled)
print(cov_matrix)
## x1 x2 x3 x4 x5 x6 x7
## x1 1.0000000 0.62378740 0.74684256 -0.27400191 0.17266148 0.3677884 0.6401392
## x2 0.6237874 1.00000000 0.37221030 0.03200511 0.22559562 0.4585452 0.6365419
## x3 0.7468426 0.37221030 1.00000000 -0.09890932 0.23055167 0.4249885 0.4103263
## x4 -0.2740019 0.03200511 -0.09890932 1.00000000 0.06600543 0.2747883 0.1373920
## x5 0.1726615 0.22559562 0.23055167 0.06600543 1.00000000 0.3719925 0.2484724
## x6 0.3677884 0.45854522 0.42498847 0.27478833 0.37199252 1.0000000 0.3589229
## x7 0.6401392 0.63654185 0.41032628 0.13739205 0.24847241 0.3589229 1.0000000
## x8 0.9235412 0.56821282 0.78555799 -0.13180932 0.23840152 0.3562927 0.7856225
## x8
## x1 0.9235412
## x2 0.5682128
## x3 0.7855580
## x4 -0.1318093
## x5 0.2384015
## x6 0.3562927
## x7 0.7856225
## x8 1.0000000
V <- diag(1/sqrt(1),8,8)
V
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
## [1,] 1 0 0 0 0 0 0 0
## [2,] 0 1 0 0 0 0 0 0
## [3,] 0 0 1 0 0 0 0 0
## [4,] 0 0 0 1 0 0 0 0
## [5,] 0 0 0 0 1 0 0 0
## [6,] 0 0 0 0 0 1 0 0
## [7,] 0 0 0 0 0 0 1 0
## [8,] 0 0 0 0 0 0 0 1
rho <- V %*% cov_matrix %*% V
rho
## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 1.0000000 0.62378740 0.74684256 -0.27400191 0.17266148 0.3677884
## [2,] 0.6237874 1.00000000 0.37221030 0.03200511 0.22559562 0.4585452
## [3,] 0.7468426 0.37221030 1.00000000 -0.09890932 0.23055167 0.4249885
## [4,] -0.2740019 0.03200511 -0.09890932 1.00000000 0.06600543 0.2747883
## [5,] 0.1726615 0.22559562 0.23055167 0.06600543 1.00000000 0.3719925
## [6,] 0.3677884 0.45854522 0.42498847 0.27478833 0.37199252 1.0000000
## [7,] 0.6401392 0.63654185 0.41032628 0.13739205 0.24847241 0.3589229
## [8,] 0.9235412 0.56821282 0.78555799 -0.13180932 0.23840152 0.3562927
## [,7] [,8]
## [1,] 0.6401392 0.9235412
## [2,] 0.6365419 0.5682128
## [3,] 0.4103263 0.7855580
## [4,] 0.1373920 -0.1318093
## [5,] 0.2484724 0.2384015
## [6,] 0.3589229 0.3562927
## [7,] 1.0000000 0.7856225
## [8,] 0.7856225 1.0000000
rho <- V %*% cov_matrix %*% V
rho
## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 1.0000000 0.62378740 0.74684256 -0.27400191 0.17266148 0.3677884
## [2,] 0.6237874 1.00000000 0.37221030 0.03200511 0.22559562 0.4585452
## [3,] 0.7468426 0.37221030 1.00000000 -0.09890932 0.23055167 0.4249885
## [4,] -0.2740019 0.03200511 -0.09890932 1.00000000 0.06600543 0.2747883
## [5,] 0.1726615 0.22559562 0.23055167 0.06600543 1.00000000 0.3719925
## [6,] 0.3677884 0.45854522 0.42498847 0.27478833 0.37199252 1.0000000
## [7,] 0.6401392 0.63654185 0.41032628 0.13739205 0.24847241 0.3589229
## [8,] 0.9235412 0.56821282 0.78555799 -0.13180932 0.23840152 0.3562927
## [,7] [,8]
## [1,] 0.6401392 0.9235412
## [2,] 0.6365419 0.5682128
## [3,] 0.4103263 0.7855580
## [4,] 0.1373920 -0.1318093
## [5,] 0.2484724 0.2384015
## [6,] 0.3589229 0.3562927
## [7,] 1.0000000 0.7856225
## [8,] 0.7856225 1.0000000
# Eigenvalue dan eigenvector dari matriks kovarians
eig <- eigen(rho)
eig
## eigen() decomposition
## $values
## [1] 4.00726889 1.39921592 0.89012475 0.68621051 0.56847478 0.29617318 0.12840160
## [8] 0.02413036
##
## $vectors
## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] -0.45254508 -0.2768110 0.03056820 0.06049255 0.03354325 -0.03316507
## [2,] -0.37421933 0.1136218 0.23526858 -0.43465262 0.50777387 -0.55803809
## [3,] -0.39213694 -0.1502248 -0.17317530 0.58977488 -0.16586616 -0.35815625
## [4,] 0.02141932 0.7089425 0.40961262 0.24406187 -0.35898924 -0.28273984
## [5,] -0.19002047 0.3573634 -0.77391745 -0.36545542 -0.28570938 -0.12602997
## [6,] -0.29259807 0.4618165 -0.16778134 0.34857485 0.56774305 0.47468556
## [7,] -0.40081944 0.1005054 0.33585810 -0.37617035 -0.31516789 0.47452254
## [8,] -0.46749870 -0.1849711 0.07773437 0.05874455 -0.28524176 0.11355296
## [,7] [,8]
## [1,] 0.696793653 0.47564523
## [2,] -0.146426957 -0.10997317
## [3,] -0.501335135 0.19675524
## [4,] 0.245600524 0.02140869
## [5,] 0.073911989 0.02648260
## [6,] 0.007545115 -0.06116677
## [7,] -0.383871370 0.32105759
## [8,] 0.168831505 -0.78420398
# PCA menggunakan fungsi bawaan R
pca_result <- prcomp(data_scaled, center = TRUE, scale. = TRUE)
pca_result
## Standard deviations (1, .., p=8):
## [1] 2.0018164 1.1828846 0.9434642 0.8283782 0.7539727 0.5442180 0.3583317
## [8] 0.1553395
##
## Rotation (n x k) = (8 x 8):
## PC1 PC2 PC3 PC4 PC5 PC6
## x1 -0.45254508 -0.2768110 0.03056820 0.06049255 0.03354325 -0.03316507
## x2 -0.37421933 0.1136218 0.23526858 -0.43465262 0.50777387 -0.55803809
## x3 -0.39213694 -0.1502248 -0.17317530 0.58977488 -0.16586616 -0.35815625
## x4 0.02141932 0.7089425 0.40961262 0.24406187 -0.35898924 -0.28273984
## x5 -0.19002047 0.3573634 -0.77391745 -0.36545542 -0.28570938 -0.12602997
## x6 -0.29259807 0.4618165 -0.16778134 0.34857485 0.56774305 0.47468556
## x7 -0.40081944 0.1005054 0.33585810 -0.37617035 -0.31516789 0.47452254
## x8 -0.46749870 -0.1849711 0.07773437 0.05874455 -0.28524176 0.11355296
## PC7 PC8
## x1 -0.696793653 0.47564523
## x2 0.146426957 -0.10997317
## x3 0.501335135 0.19675524
## x4 -0.245600524 0.02140869
## x5 -0.073911989 0.02648260
## x6 -0.007545115 -0.06116677
## x7 0.383871370 0.32105759
## x8 -0.168831505 -0.78420398
#Metode 1
#Mencari total varains
proporsi <- eig$values /sum(eig$values)
print(proporsi)
## [1] 0.500908612 0.174901990 0.111265594 0.085776314 0.071059347 0.037021647
## [7] 0.016050200 0.003016295
#Mencari proporsi kumulatif
prop_kumulatif <- cumsum(proporsi)
prop_kumulatif
## [1] 0.5009086 0.6758106 0.7870762 0.8728525 0.9439119 0.9809335 0.9969837
## [8] 1.0000000
#Metode 2
# Nilai Eigen
print(eig$values)
## [1] 4.00726889 1.39921592 0.89012475 0.68621051 0.56847478 0.29617318 0.12840160
## [8] 0.02413036
#Metode 3
#Menggunakan Scree Plot
screeplot(pca_result,type="lines",main = "Scree Plot")
#Penciri Komponen Utama
#PC1 Pendidikan dan Kesejahteraan (RLS, Melek Huruf, HLS, Angka Harapan Hidup, IPM)
#PC2 Tekanan Ekonomi(Kemiskinan, Pengangguran)
#PC3 Pendapatan (Rata-rata Gaji Bersih)
#Skor komponen
pca_result$x
## PC1 PC2 PC3 PC4 PC5 PC6
## [1,] 1.30642485 -0.8492008 0.551633731 0.42017808 1.78655191 -0.32763744
## [2,] 0.69288260 0.5522198 -1.277397357 -0.10700224 0.26031941 0.43251272
## [3,] 1.93755554 -0.3941002 -0.808328093 0.97413120 0.04156527 -0.49807066
## [4,] 0.49377269 -0.6288788 0.626507634 -0.03057150 0.28722052 0.12728665
## [5,] 0.88279630 2.1513441 0.544100242 -0.73868978 0.91123889 0.59395794
## [6,] -0.51943691 -0.5480909 0.648986729 -0.60844727 0.07107825 -0.66798145
## [7,] -0.79264242 1.0287197 -1.865469309 -0.90636110 -0.41151181 -0.62597343
## [8,] -1.53245361 1.3682115 -0.008853727 0.13219022 0.15401018 0.22053352
## [9,] 1.37058814 1.2823154 0.519963302 1.62117185 -1.23796358 0.25226805
## [10,] -0.55351609 0.2530872 1.831919340 -0.39756639 -0.68022282 -0.51598946
## [11,] -0.05189729 2.8652593 0.963334318 0.53487597 -0.45636606 -0.86735199
## [12,] 2.63434450 -0.7836166 0.089894386 0.25915416 0.32632816 0.02130184
## [13,] 2.89262091 -1.3606677 -0.205755326 0.45564126 -0.69124947 0.16179433
## [14,] 0.29512602 0.6353994 0.613282561 -0.11550552 0.58361499 0.96147193
## [15,] 0.10946418 1.0060936 -1.791659926 -1.25324615 -0.63870123 0.26009777
## [16,] 2.16400593 -1.3168218 -0.513680141 0.04257065 -1.04570857 0.74822933
## [17,] 0.07981503 -0.9564659 0.907148124 -1.57105112 -0.41205971 -0.54243996
## [18,] -0.15653928 -0.8949257 0.840361908 0.23277182 -0.82331219 0.40448916
## [19,] -5.86502756 -1.0411297 -0.818087007 1.42493793 -0.46736401 -0.24409056
## [20,] -1.59406376 -1.5524982 0.219778309 -1.44864107 -0.18281737 -0.03218402
## [21,] -2.47039869 -0.7293011 0.242103080 0.62890449 0.82351689 0.10193295
## [22,] -3.08283025 0.1406165 -0.028117942 -0.02232891 0.67358831 0.89182488
## [23,] 1.75940914 -0.2275692 -1.281664839 0.47288342 1.12824407 -0.85598211
## PC7 PC8
## [1,] -0.34691719 0.24237285
## [2,] 0.32137957 -0.08019906
## [3,] -0.11542018 0.05758506
## [4,] -0.18340211 0.37013485
## [5,] -0.08929075 -0.31021487
## [6,] 0.09390474 -0.19909116
## [7,] -0.34778796 0.04801920
## [8,] -0.37984411 0.12956371
## [9,] -0.64034671 -0.06548317
## [10,] 0.74738214 0.14120746
## [11,] 0.10055349 0.04033653
## [12,] -0.29027609 -0.09231398
## [13,] 0.08167340 -0.04968147
## [14,] 0.28596931 0.06379231
## [15,] 0.23957557 0.20889093
## [16,] 0.05478926 -0.05858266
## [17,] -0.40219076 -0.19180248
## [18,] 0.55276826 0.02093624
## [19,] 0.01925742 -0.06992564
## [20,] -0.40011714 0.05134807
## [21,] -0.01919479 -0.16291500
## [22,] 0.06313400 0.01098098
## [23,] 0.65440064 -0.10495871
pca_scores <- as.matrix(data_scaled) %*% eig$vectors
pca_scores
## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 1.30642485 -0.8492008 0.551633731 0.42017808 1.78655191 -0.32763744
## [2,] 0.69288260 0.5522198 -1.277397357 -0.10700224 0.26031941 0.43251272
## [3,] 1.93755554 -0.3941002 -0.808328093 0.97413120 0.04156527 -0.49807066
## [4,] 0.49377269 -0.6288788 0.626507634 -0.03057150 0.28722052 0.12728665
## [5,] 0.88279630 2.1513441 0.544100242 -0.73868978 0.91123889 0.59395794
## [6,] -0.51943691 -0.5480909 0.648986729 -0.60844727 0.07107825 -0.66798145
## [7,] -0.79264242 1.0287197 -1.865469309 -0.90636110 -0.41151181 -0.62597343
## [8,] -1.53245361 1.3682115 -0.008853727 0.13219022 0.15401018 0.22053352
## [9,] 1.37058814 1.2823154 0.519963302 1.62117185 -1.23796358 0.25226805
## [10,] -0.55351609 0.2530872 1.831919340 -0.39756639 -0.68022282 -0.51598946
## [11,] -0.05189729 2.8652593 0.963334318 0.53487597 -0.45636606 -0.86735199
## [12,] 2.63434450 -0.7836166 0.089894386 0.25915416 0.32632816 0.02130184
## [13,] 2.89262091 -1.3606677 -0.205755326 0.45564126 -0.69124947 0.16179433
## [14,] 0.29512602 0.6353994 0.613282561 -0.11550552 0.58361499 0.96147193
## [15,] 0.10946418 1.0060936 -1.791659926 -1.25324615 -0.63870123 0.26009777
## [16,] 2.16400593 -1.3168218 -0.513680141 0.04257065 -1.04570857 0.74822933
## [17,] 0.07981503 -0.9564659 0.907148124 -1.57105112 -0.41205971 -0.54243996
## [18,] -0.15653928 -0.8949257 0.840361908 0.23277182 -0.82331219 0.40448916
## [19,] -5.86502756 -1.0411297 -0.818087007 1.42493793 -0.46736401 -0.24409056
## [20,] -1.59406376 -1.5524982 0.219778309 -1.44864107 -0.18281737 -0.03218402
## [21,] -2.47039869 -0.7293011 0.242103080 0.62890449 0.82351689 0.10193295
## [22,] -3.08283025 0.1406165 -0.028117942 -0.02232891 0.67358831 0.89182488
## [23,] 1.75940914 -0.2275692 -1.281664839 0.47288342 1.12824407 -0.85598211
## [,7] [,8]
## [1,] 0.34691719 0.24237285
## [2,] -0.32137957 -0.08019906
## [3,] 0.11542018 0.05758506
## [4,] 0.18340211 0.37013485
## [5,] 0.08929075 -0.31021487
## [6,] -0.09390474 -0.19909116
## [7,] 0.34778796 0.04801920
## [8,] 0.37984411 0.12956371
## [9,] 0.64034671 -0.06548317
## [10,] -0.74738214 0.14120746
## [11,] -0.10055349 0.04033653
## [12,] 0.29027609 -0.09231398
## [13,] -0.08167340 -0.04968147
## [14,] -0.28596931 0.06379231
## [15,] -0.23957557 0.20889093
## [16,] -0.05478926 -0.05858266
## [17,] 0.40219076 -0.19180248
## [18,] -0.55276826 0.02093624
## [19,] -0.01925742 -0.06992564
## [20,] 0.40011714 0.05134807
## [21,] 0.01919479 -0.16291500
## [22,] -0.06313400 0.01098098
## [23,] -0.65440064 -0.10495871