library(readxl)
kesehatan <- read_excel("C:/Users/62852/OneDrive/Data PCA (Kesehatan).xlsx", 
    sheet = "Sheet1")
kesehatan
#uji mutikolinearitas
VIF <- function(x){
  VIF <- diag(solve(cor(x)))
  result <- ifelse(VIF>10, "Multicolinearity","Non Multicolinearity")
  data <- data.frame(VIF, result)
  return(data)
}

VIF(kesehatan)
#standarisasi data
data.scale <- scale(kesehatan)
data.scale
##                X1         X2            X3          X4         X5          X6
##  [1,]  0.05861673 -0.1066100 -0.0459447987  0.05482531 -0.2767192 -0.95542147
##  [2,]  0.21876600 -0.1739427 -0.2046857311  0.44110401  0.1270598 -1.02250728
##  [3,]  0.47551325 -0.3647185 -0.4758096244  0.18860532 -1.1756801  0.49580243
##  [4,]  0.55685891 -0.5891606 -0.5685255671 -0.29690094  0.4193477 -0.45523757
##  [5,]  0.38908348 -0.3759406 -0.3859032556  0.81054947 -0.2003829 -0.44833168
##  [6,]  0.41958810 -0.3983848 -0.4154037829  1.17202129 -0.2887723 -0.25891292
##  [7,]  0.01031774 -0.3534964 -0.0009916144  0.09026372 -0.1722590  0.14360193
##  [8,]  0.55685891 -0.2076090 -0.5685255671  0.98951346 -0.1009448  0.03902700
##  [9,]  0.41958810 -0.1402763 -0.4196181439 -1.51775428  1.2821492  0.88845173
## [10,]  0.85936309 -0.7687144 -0.9028648760 -2.06616372  0.9416490  0.26494832
## [11,]  1.34489501 -1.8235924 -1.3144674704 -1.01009901  1.3283528 -0.08231939
## [12,]  0.82885847 -0.2637195 -0.8677452007  0.19480704 -0.8452241  0.14162882
## [13,]  1.08306366 -0.3086080 -0.9787233746  1.65309774  0.3440158  0.66647662
## [14,]  1.22287652 -1.7113714 -1.2414185458  2.26618229  1.7220876  0.68818086
## [15,]  0.83902667 -0.2973858 -0.8775787098  1.42363402  0.1170156  0.16727928
## [16,]  0.79326974 -0.9370460 -0.8298159514 -0.22956796  0.2194670  0.06862368
## [17,]  0.86953130 -1.4083745 -0.9098888110  0.34364838  1.5262246  1.18540509
## [18,] -0.71162501  0.5218280  0.6887588085  0.94255756  0.3088609 -0.33586429
## [19,] -0.86160608  1.1839323  0.8334518707 -0.83556482 -1.0159765 -2.29220487
## [20,]  0.32553218  0.3983848 -0.3184734790  1.09317082 -0.4022724 -0.47003591
## [21,]  0.26960704 -0.1178321 -0.2510437025 -0.84885423 -0.7538214  0.01534965
## [22,]  0.36366296  0.1514984 -0.3535931543  0.04950955  0.1360997  0.89141139
## [23,]  0.68904561 -0.3759406 -0.5938117334 -1.86593668  0.9396401 -0.08231939
## [24,]  0.43484042 -0.1851648 -0.4336660140 -1.03313398  0.2285068  0.92298119
## [25,]  0.36366296  0.2188311 -0.3521883673 -0.18969974  0.5700115  0.59643115
## [26,] -1.14885795  0.6003827  1.1214332081 -0.20564703 -0.5228035  0.42082417
## [27,]  0.22893421 -0.2076090 -0.2159240272  0.71309383  0.9185472  1.08970915
## [28,] -0.51334496  0.1739427  0.4991125619  0.50755104  0.2576352  0.81939281
## [29,] -1.39289493  0.6228270  1.3672709352 -0.38106717 -0.4153300  0.76315911
## [30,] -1.35222210  0.7126038  1.3307464729 -0.51839102 -0.2757148  0.18306417
## [31,] -1.43610982  0.5667164  1.4164384806 -0.59458361 -0.4776044  0.14458849
## [32,] -1.27596054  0.4993838  1.2464592522  0.61741012 -0.3841928  0.28171978
## [33,] -2.39446340  1.4869292  2.4335042772 -0.98617808 -0.1109890 -0.40788288
## [34,] -2.53427626  3.9782370  2.5894356355 -0.97200271 -3.9679832 -4.06701915
## attr(,"scaled:center")
##        X1        X2        X3        X4        X5        X6 
##  72.61971 210.50000  19.73706  36.34118  79.81500  77.66441 
## attr(,"scaled:scale")
##        X1        X2        X3        X4        X5        X6 
##  1.966915 89.109823  7.118517 11.287187  9.955939 10.136272
#matriks korelasi rho
cov.matriks <- cov(data.scale)

v <- diag(1/sqrt(1),6,6)

rho <- v %*% cov.matriks %*% v
rho
##            [,1]       [,2]       [,3]        [,4]        [,5]       [,6]
## [1,]  1.0000000 -0.8564577 -0.9993964  0.25146435  0.61796151  0.4406343
## [2,] -0.8564577  1.0000000  0.8628764 -0.23421838 -0.81140752 -0.6528429
## [3,] -0.9993964  0.8628764  1.0000000 -0.25533988 -0.62121396 -0.4481563
## [4,]  0.2514644 -0.2342184 -0.2553399  1.00000000  0.09846204  0.1812984
## [5,]  0.6179615 -0.8114075 -0.6212140  0.09846204  1.00000000  0.7134019
## [6,]  0.4406343 -0.6528429 -0.4481563  0.18129837  0.71340194  1.0000000
#eigen dan vaktor eigen dari matriks kovarian
eigen <- eigen(rho)
eigen
## eigen() decomposition
## $values
## [1] 3.9118317111 0.9665954578 0.7825498812 0.2456048486 0.0929239857
## [6] 0.0004941156
## 
## $vectors
##            [,1]        [,2]        [,3]       [,4]        [,5]         [,6]
## [1,]  0.4605081 -0.11167626  0.42792723  0.1833547 -0.26593957  0.698567257
## [2,] -0.4853985 -0.05891995 -0.04701148  0.1351988 -0.86015807 -0.023579597
## [3,] -0.4625137  0.11204178 -0.41905107 -0.1869173  0.22724872  0.715083119
## [4,]  0.1564325 -0.90661579 -0.36662981 -0.1356468 -0.02750318  0.001663797
## [5,]  0.4260940  0.30469208 -0.27816442 -0.7205410 -0.35911565 -0.009372340
## [6,]  0.3638329  0.23814709 -0.65366011  0.6128498 -0.08967599  0.003648942

Interpretasi: Berdasarkan kriteria kaiser, komponen utama yang dipertahankan adalah yang memiliki nilai eigen lebih besar atau sama dengan 1. Dari hasil di atas, terlihat bahwa hanya komponen pertama dan kedua yang memenuhi kriteria ini, dengan nilai masing-masing 3,92 dan 0,97 (mendekati 1). Ini berarti dua komponen utama ini cukup untuk menjelaskan sebagian besar varians dalam data, dan komponen lainnya dengan nilai eigen lebih kecil dari 1 dapat diabaikan karena kontribusinya yang relatif kecil.

#proporsi total varian
proporsi <- eigen$values / sum(eigen$values)

#proporsi kumulatif
prop.kum <- cumsum(proporsi) 
prop.kum
## [1] 0.6519720 0.8130712 0.9434962 0.9844303 0.9999176 1.0000000

Interpretasi: Dari hasil proporsi kumulatif varian, kita dapat melihat bahwa dua komponen utama pertama mampu menjelaskan sekitar 81,3% dari total varian data. Ini berarti jika kita ingin mempertahankan sekitar 80% informasi dari data asli, kita dapat menggunakan dua komponen utama pertama.

#PCA
pca.result <- prcomp(data.scale, center = TRUE, scale. = TRUE)
pca.result
## Standard deviations (1, .., p=6):
## [1] 1.97783511 0.98315587 0.88461849 0.49558536 0.30483436 0.02222871
## 
## Rotation (n x k) = (6 x 6):
##           PC1         PC2         PC3        PC4         PC5          PC6
## X1 -0.4605081  0.11167626 -0.42792723 -0.1833547 -0.26593957 -0.698567257
## X2  0.4853985  0.05891995  0.04701148 -0.1351988 -0.86015807  0.023579597
## X3  0.4625137 -0.11204178  0.41905107  0.1869173  0.22724872 -0.715083119
## X4 -0.1564325  0.90661579  0.36662981  0.1356468 -0.02750318 -0.001663797
## X5 -0.4260940 -0.30469208  0.27816442  0.7205410 -0.35911565  0.009372340
## X6 -0.3638329 -0.23814709  0.65366011 -0.6128498 -0.08967599 -0.003648942
#Ringkasan hasil PCA
summary(pca.result)
## Importance of components:
##                          PC1    PC2    PC3     PC4     PC5     PC6
## Standard deviation     1.978 0.9832 0.8846 0.49559 0.30483 0.02223
## Proportion of Variance 0.652 0.1611 0.1304 0.04093 0.01549 0.00008
## Cumulative Proportion  0.652 0.8131 0.9435 0.98443 0.99992 1.00000

Dari 6 variabel yang telah dianalisis, berdasarkan nilai eigen yang besar dari 1 dan proporsi kumulatif 80%, maka terbentuklah 2 komponen utama, yaitu PC1 (Angka Harapan Hidup, Angka Kematian Ibu, Angka Kematian Bayi, Akses pada Layanan Sanitasi Dasar, Akses pada Fasilitas Kesehatan Dasar) dan PC2 (Akses pada Layanan Air Minum). Dari 6 variabel yang ada maka diperoleh 2 variabel hasil reduksi yaitu Kesehatan dan Kesejahteraan Masyarakat (Label komponen PC1) dan Akses Terhadap Air Bersih (Label Komponen PC2).

#Scree Plot
screeplot(pca.result, type = "lines", main = "Scree Plot")

Interpretasi: Berdasarkan scree plot di atas, diperoleh hasil bahwa komponen yang dapat di ambil adalah 2. Hal ini terlihat adanya siku yang jelas setelah komponen kedua, yang mengindikasikan bahwa komponen pertama dan kedua menangkap sebagian besar varians dalam data. Penurunan varians setelah komponen kedua menjadi lebih landai, menunjukkan bahwa komponen-komponen selanjutnya hanya memberikan tambahan informasi yang sedikit. Oleh karena itu, mempertahankan komponen utama 1 dan 2 sudah cukup untuk merepresentasikan data dengan baik tanpa kehilangan banyak informasi penting.

#Skor Komponen
pca.result$x
##               PC1         PC2         PC3          PC4          PC5
##  [1,]  0.35695383  0.36696288 -0.73074257  0.388657228  0.249216770
##  [2,] -0.03096560  0.64182050 -0.65887382  0.723175349  0.078858496
##  [3,] -0.32502299  0.49606398 -0.35381733 -1.252209540  0.451686941
##  [4,] -0.77197273 -0.19736027 -0.79400942  0.412159654  0.127879039
##  [5,] -0.41843916  0.96721919 -0.39751044  0.147678812  0.222072158
##  [6,] -0.54482610  1.28214681 -0.19222653  0.008864948  0.231375482
##  [7,] -0.16976544  0.08055744  0.05759474 -0.154166951  0.347594238
##  [8,] -0.74614143  1.03222566 -0.12608006 -0.142729637 -0.093174686
##  [9,] -1.08753074 -1.89265519  0.01895059  0.037072900 -0.584652507
## [10,] -1.36087652 -2.07138988 -1.10462758  0.013454570 -0.077591991
## [11,] -2.49050364 -1.11088402 -1.26671679  0.624823389  0.470336639
## [12,] -0.63290759  0.57466893 -0.80183060 -0.947907943  0.094694910
## [13,] -1.74889786  1.44761341  0.24930142 -0.276136878 -0.473765332
## [14,] -3.30667348  1.54078502  0.63573585  0.901596257  0.122258739
## [15,] -1.27004542  1.38970117 -0.07693317 -0.102759025 -0.262937718
## [16,] -1.28651833 -0.16498956 -0.70951089 -0.088930375  0.327817146
## [17,] -2.64024751 -0.31970208  0.50578940  0.280750880  0.109565877
## [18,]  0.74271205  0.71451991  0.82962345  0.744906391 -0.209806885
## [19,]  2.75452913 -0.02193949 -1.31365237  0.713082805 -0.006443453
## [20,]  0.06757979  1.32110220 -0.27238467 -0.026584416 -0.345070900
## [21,]  0.15093957 -0.49226329 -0.73697989 -0.748137957  0.265284463
## [22,] -0.64753527 -0.11971338  0.34201713 -0.594774515 -0.437553965
## [23,] -0.85296945 -1.83705308 -1.03791481  0.287883562 -0.273557313
## [24,] -0.76226328 -1.13984492 -0.08841239 -0.676897316 -0.191335503
## [25,] -0.65434596 -0.39473527  0.18595197 -0.142633352 -0.617944315
## [26,]  1.44098512 -0.34593981  1.04404457 -0.323406029  0.199612028
## [27,] -1.20547758  0.14464373  1.03103763  0.036484117 -0.378572335
## [28,]  0.06438102  0.08351717  1.23035791 -0.083780240 -0.079636701
## [29,]  1.53505869 -0.67272571  1.44190009 -0.391899819  0.236601815
## [30,]  1.71606340 -0.68769329  1.02271404  0.019159825  0.145922317
## [31,]  1.83545622 -0.71365871  0.97841984 -0.061942998  0.391238575
## [32,]  1.37111505  0.35699717  1.39546628  0.033693195  0.288761078
## [33,]  3.29991539 -1.21558008  1.45526914  0.729095924  0.014357356
## [34,]  7.61823682  0.95758290 -1.76195074 -0.087642814 -0.343090462
##                 PC6
##  [1,] -0.0098056448
##  [2,] -0.0063689407
##  [3,] -0.0136762986
##  [4,]  0.0097328531
##  [5,] -0.0063033136
##  [6,] -0.0091677511
##  [7,] -0.0171224965
##  [8,]  0.0099094537
##  [9,]  0.0149437462
## [10,]  0.0384708914
## [11,] -0.0281149418
## [12,]  0.0265155162
## [13,] -0.0659592201
## [14,]  0.0029608952
## [15,]  0.0325305992
## [16,]  0.0193284168
## [17,]  0.0194181939
## [18,]  0.0194547034
## [19,]  0.0340513344
## [20,]  0.0058487241
## [21,] -0.0173087290
## [22,]  0.0003182208
## [23,] -0.0533729368
## [24,]  0.0024685231
## [25,]  0.0064424891
## [26,]  0.0087000707
## [27,] -0.0069714435
## [28,]  0.0043807765
## [29,]  0.0039611176
## [30,]  0.0074370709
## [31,] -0.0003036057
## [32,]  0.0061415457
## [33,] -0.0303139932
## [34,] -0.0082258265

Interpretasi: Setiap baris dalam tabel skor ini menggambarkan posisi suatu observasi dalam dimensi baru, sedangkan setiap kolom menunjukkan nilai skor untuk masing-masing komponen utama. PC1 dan PC2 memiliki kontribusi terbesar dalam menjelaskan varians data, sehingga kedua komponen ini sudah cukup untuk memahami pola utama dalam dataset. Nilai skor yang positif dan negatif mengindikasikan arah kecenderungan suatu observasi terhadap masing-masing komponen utama.