Nama : Iksan Nur Afiah
Nim : 4112322009
Prodi : Statistika Terapan dan Komputasi
Pustaka yang akan digunakan adalah:
library("ggplot2")
## Warning: package 'ggplot2' was built under R version 4.3.3
library("ggfortify")
## Warning: package 'ggfortify' was built under R version 4.3.3
library("gridExtra")
## Warning: package 'gridExtra' was built under R version 4.3.3
library("carData")
## Warning: package 'carData' was built under R version 4.3.3
library("car")
## Warning: package 'car' was built under R version 4.3.3
library("factoextra")
## Warning: package 'factoextra' was built under R version 4.3.3
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library("corrplot")
## Warning: package 'corrplot' was built under R version 4.3.3
## corrplot 0.94 loaded
library("corrplot")
Kumpulan data decathlon3 berisi informasi tentang performa atlet dalam dua ajang olahraga, yaitu Desctar dan OlympicG. Dataset ini mencakup 41 individu (atlet) yang dijelaskan oleh 14 variabel. Untuk keperluan analisis lebih lanjut, kita akan memilih variabel aktif (kolom 1 hingga 10) dari dataset decathlon3 dan membuat dataset baru bernama data.active. Dataset data.active ini terdiri dari 41 observasi dengan 10 variabel, yang akan digunakan untuk analisis komponen utama.
data <- read.csv(file = "decathlon-3.csv", header = TRUE)
data.active <- data[, 2:11]
head(data.active)
summary(data.active)
## X100m Long.jump Shot.put High.jump X400m
## Min. :10.44 Min. :6.61 Min. :12.68 Min. :1.850 Min. :46.81
## 1st Qu.:10.85 1st Qu.:7.03 1st Qu.:13.88 1st Qu.:1.920 1st Qu.:48.93
## Median :10.98 Median :7.30 Median :14.57 Median :1.950 Median :49.40
## Mean :11.00 Mean :7.26 Mean :14.48 Mean :1.977 Mean :49.62
## 3rd Qu.:11.14 3rd Qu.:7.48 3rd Qu.:14.97 3rd Qu.:2.040 3rd Qu.:50.30
## Max. :11.64 Max. :7.96 Max. :16.36 Max. :2.150 Max. :53.20
## X110m.hurdle Discus Pole.vault Javeline
## Min. :13.97 Min. :37.92 Min. :4.200 Min. :50.31
## 1st Qu.:14.21 1st Qu.:41.90 1st Qu.:4.500 1st Qu.:55.27
## Median :14.48 Median :44.41 Median :4.800 Median :58.36
## Mean :14.61 Mean :44.33 Mean :4.762 Mean :58.32
## 3rd Qu.:14.98 3rd Qu.:46.07 3rd Qu.:4.920 3rd Qu.:60.89
## Max. :15.67 Max. :51.65 Max. :5.400 Max. :70.52
## X1500m
## Min. :262.1
## 1st Qu.:271.0
## Median :278.1
## Mean :279.0
## 3rd Qu.:285.1
## Max. :317.0
Langkah pertama dalam analisis ini difokuskan pada perhitungan PCA menggunakan fungsi prcomp(). Perintah ini memungkinkan pemusatan data di sekitar 0 dengan menggeser variabel-variabelnya serta penskalaan ulang varians menjadi 1 unit. Proses standarisasi data ini penting karena variabel yang digunakan diukur dalam skala yang berbeda. Selain itu, nilai eigen diekstraksi menggunakan fungsi get_eigenvalue(). Nilai eigen ini mengukur jumlah variasi yang dijelaskan oleh setiap komponen utama (PC). Evaluasi nilai eigen ini dilakukan untuk menentukan berapa banyak komponen utama yang akan dipertimbangkan dalam analisis.
res.pca <- prcomp(data.active, scale = TRUE)
print(res.pca)
## Standard deviations (1, .., p=10):
## [1] 1.8088409 1.3180027 1.1852918 1.0280323 0.8275104 0.7741245 0.6717405
## [8] 0.6299814 0.4634812 0.4268811
##
## Rotation (n x k) = (10 x 10):
## PC1 PC2 PC3 PC4 PC5
## X100m -0.42829627 0.1419891 -0.15557953 0.03678703 0.36518741
## Long.jump 0.41015201 -0.2620794 0.15372674 -0.09901016 0.04432336
## Shot.put 0.34414444 0.4539470 -0.01972378 -0.18539458 0.13431954
## High.jump 0.31619436 0.2657761 -0.21894349 0.13189684 0.67121760
## X400m -0.37571570 0.4320460 0.11091758 -0.02850297 -0.10597034
## X110m.hurdle -0.41255442 0.1735910 -0.07815576 -0.28290068 0.19857266
## Discus 0.30542571 0.4600244 0.03623770 0.25259074 -0.12667770
## Pole.vault 0.02783081 -0.1368411 0.58361717 -0.53649480 0.39873734
## Javeline 0.15319802 0.2405071 -0.32874217 -0.69285498 -0.36873120
## X1500m -0.03210733 0.3598049 0.65987362 0.15669648 -0.18557094
## PC6 PC7 PC8 PC9 PC10
## X100m -0.29607739 -0.38177608 0.46160211 -0.10475771 0.42428269
## Long.jump 0.30612478 -0.62769317 -0.02101165 -0.48266910 0.08104448
## Shot.put -0.30547299 0.30972542 -0.31393005 -0.42729075 0.39028424
## High.jump 0.46777116 0.09145002 0.12509166 0.24366054 -0.10642724
## X400m 0.33252178 0.12442114 0.21339819 -0.55212939 -0.41399532
## X110m.hurdle 0.09963776 -0.35733030 -0.71111429 0.15013429 -0.09086448
## Discus -0.44937288 -0.42988982 0.03838986 0.15480715 -0.44916580
## Pole.vault -0.26166458 0.09796019 0.17803824 0.08297769 -0.27645138
## Javeline 0.16320268 -0.10674519 0.29614206 0.24732691 0.08777340
## X1500m 0.29826888 -0.08362898 0.01371744 0.30773397 0.42923132
summary(res.pca)
## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 1.8088 1.3180 1.1853 1.0280 0.82751 0.77412 0.67174
## Proportion of Variance 0.3272 0.1737 0.1405 0.1057 0.06848 0.05993 0.04512
## Cumulative Proportion 0.3272 0.5009 0.6414 0.7471 0.81556 0.87548 0.92061
## PC8 PC9 PC10
## Standard deviation 0.62998 0.46348 0.42688
## Proportion of Variance 0.03969 0.02148 0.01822
## Cumulative Proportion 0.96030 0.98178 1.00000
eig.val<-get_eigenvalue(res.pca)
eig.val
fviz_eig(res.pca, col.var="blue")
Berdasarkan pentingnya komponen, dapat dilihat bahwa dua komponen utama (PC) pertama memiliki nilai tertinggi dalam proporsi varians. Hal ini juga didukung oleh nilai eigen yang lebih besar pada PC pertama dan lebih kecil pada PC berikutnya, yang menunjukkan bahwa PC pertama mencerminkan arah dengan variasi terbesar dalam data. Total varians yang dijelaskan oleh semua nilai eigen adalah 10. Dalam hal ini, pada diagram sebar, nilai eigen pertama menjelaskan 32,71% variasi dan yang kedua 17,37%. Dengan demikian, empat nilai eigen pertama secara keseluruhan menjelaskan 50,09% variasi, yang memberikan indikator yang cukup baik untuk analisis lebih lanjut.
Hasil PCA dapat dievaluasi baik berdasarkan variabel (disiplin olahraga) maupun individu (atlet). Pertama, saya akan mengekstrak hasil untuk variabel. Untuk tujuan ini, fungsi get_pca_var() digunakan untuk menghasilkan daftar matriks yang mencakup semua hasil untuk variabel aktif, seperti koordinat, korelasi antara variabel dan sumbu, kosinus kuadrat, serta kontribusi masing-masing variabel.
var <- get_pca_var(res.pca)
var
## Principal Component Analysis Results for variables
## ===================================================
## Name Description
## 1 "$coord" "Coordinates for the variables"
## 2 "$cor" "Correlations between variables and dimensions"
## 3 "$cos2" "Cos2 for the variables"
## 4 "$contrib" "contributions of the variables"
head(var$cos2)
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## X100m 0.6001908 0.03502213 0.0340059930 0.0014302206 0.091322660
## Long.jump 0.5504152 0.11931587 0.0332008675 0.0103603165 0.001345279
## Shot.put 0.3875094 0.35796686 0.0005465513 0.0363251605 0.012354505
## High.jump 0.3271214 0.12270561 0.0673464410 0.0183857880 0.308513117
## X400m 0.4618697 0.32425938 0.0172842817 0.0008586058 0.007689811
## X110m.hurdle 0.5568821 0.05234639 0.0085816841 0.0845826853 0.027001375
## Dim.6 Dim.7 Dim.8 Dim.9 Dim.10
## X100m 0.052532985 0.065768884 0.0845650782 0.002357417 0.032803826
## Long.jump 0.056158895 0.177786116 0.0001752168 0.050045300 0.001196908
## Shot.put 0.055920005 0.043286926 0.0391130112 0.039220335 0.027757216
## High.jump 0.131125895 0.003773728 0.0062102948 0.012753657 0.002064046
## X400m 0.066261577 0.006985401 0.0180732785 0.065485634 0.031232355
## X110m.hurdle 0.005949349 0.057615948 0.2006939528 0.004841992 0.001504535
corrplot(var$cos2, is.corr=FALSE)
fviz_cos2(res.pca, choice = "var", axes = 1:2)
Selain itu, kualitas representasi variabel dapat ditampilkan pada peta faktor, di mana nilai cos2 ditunjukkan dengan warna gradien yang berbeda. Variabel dengan nilai cos2 rendah akan diberi warna “darkorchid4”, nilai cos2 sedang diwarnai “gold”, dan nilai cos2 tinggi akan berwarna “darkorange”. Variabel yang memiliki korelasi positif akan dikelompokkan bersama, sementara variabel yang berkorelasi negatif akan diposisikan di sisi berlawanan dari titik asal plot. Jarak antara variabel dan titik asal menunjukkan seberapa baik kualitas representasi variabel pada peta faktor. Variabel yang berada jauh dari titik asal berarti terwakili dengan baik dalam peta faktor tersebut.
fviz_pca_var(res.pca,
col.var = "cos2", # Color by the quality of representation
gradient.cols = c("darkorchid4", "gold", "darkorange"),
repel = TRUE
)
X400m, Shot.put, dan Discuss memiliki nilai cos2 yang sangat tinggi, yang menunjukkan bahwa variabel-variabel tersebut terwakili dengan baik pada komponen utama. Dalam hal ini, variabel-variabel ini diposisikan dekat dengan keliling lingkaran korelasi. Sementara itu, Pole.vault memiliki nilai cos2 terendah, yang menandakan bahwa variabel ini tidak terwakili dengan sempurna oleh komponen utama. Variabel ini terletak dekat dengan pusat lingkaran, yang menunjukkan bahwa variabel tersebut kurang berkontribusi pada komponen pertama.
Contrib adalah kontribusi variabel. Fungsi fviz_contrib() digunakan untuk menggambar diagram batang kontribusi variabel untuk dimensi yang paling signifikan, yaitu PC1 dan PC2.
# Kontribusi variabel terhadap PC1
a<-fviz_contrib(res.pca, choice = "var", axes = 1)
# Kontribusi variabel terhadap PC2
b<-fviz_contrib(res.pca, choice = "var", axes = 2)
grid.arrange(a,b, ncol=2, top='Kontribusi variabel terhadap dua PC pertama')
Garis putus-putus merah pada grafik di atas menunjukkan kontribusi rata-rata yang diharapkan. Untuk setiap komponen, variabel yang kontribusinya melebihi batas ini dianggap signifikan dalam memberikan kontribusi terhadap komponen tersebut. Terlihat bahwa variabel Shot.put dan X400m memberikan kontribusi terbesar pada kedua dimensi.
Hasil untuk individu (atlet) akan diekstraksi menggunakan fungsi get_pca_ind(). Sama seperti untuk variabel, fungsi ini menghasilkan daftar matriks yang berisi semua hasil untuk individu, termasuk koordinat, korelasi antara individu dan sumbu, kosinus kuadrat, serta kontribusi. Untuk individu, analisis akan difokuskan pada nilai cos2 dan contributions of individuals terhadap dua komponen utama pertama (PC1 dan PC2).
ind <- get_pca_ind(res.pca)
ind
## Principal Component Analysis Results for individuals
## ===================================================
## Name Description
## 1 "$coord" "Coordinates for the individuals"
## 2 "$cos2" "Cos2 for the individuals"
## 3 "$contrib" "contributions of the individuals"
fviz_pca_ind(res.pca,
col.ind = "cos2", # Color by the quality of representation
gradient.cols = c("darkorchid4", "gold", "darkorange"),
repel = TRUE
)
# Total contribution on PC1 and PC2
fviz_contrib(res.pca, choice = "ind", axes = 1:4)
Berdasarkan posisi garis putus-putus merah yang menunjukkan kontribusi
rata-rata, individu-individu seperti Casarsa, Karpov, dan Serble
memberikan kontribusi terbesar pada kedua dimensi.
Ringkasan analisis PCA untuk variabel (disiplin olahraga) dan individu (atlet) ditampilkan dalam plot korelasi (plot otomatis) dari paket ggfortify, yang mengacu pada dimensi 1 dan 2.
autoplot(res.pca, loadings=TRUE, loadings.colour='darkorchid4', loadings.label=TRUE, loadings.label.size=3)
Berdasarkan hasil terebut dapat terlihhat bahwa komponen utama 1 merupakan komponen utama yang paling berkaitan dengan performa atlet di cabang tertentu.
# Total contribution on PC1 and PC2
fviz_contrib(res.pca, choice = "ind", axes = 1:4)
Berdasarkan hasil analisis urutan atlet yang memiliki perfroma
terbaik.
1. Casarsa (41)
2. Karpov (16)
3. Sebrle (14)
4. Clay (15)
5. BOURGUIGNON (13)
6. Korkizoglou (39)
7. NOOL (12)
8. Drews (32)
9. Lorenzo (37)
10. Macey (17)
11. KARPOV (3)
12. Nool (21)
13. Parkhomenko (33)
14. Warners (18)
15. YURKOV (5)
16. BERNARD (4)
17. Uldal (40)
18. CLAY (2)
19. Bernard (22)
20. Smith (27)
21. Karlivans (38)
22. Terek (34)
23. ZSIVOCZKY (7)
24. MARTINEAU (9)
25. Zsivoczky (19)
26. WARNERS (6)
27. HERNU (10)
28. SEBRLE (1)
29. Gomez (35)
30. Smirnov (30)
31. Pogorelov (24)
32. Barras (26)
33. McMULLEN (8)
34. Turi (36)
35. Schwarzl (23)
36. Averyanov (28)
37. BARRAS (11)
38. Hernu (20)
39. Qi (31)
40. Schoenbeck (25)
41. Ojaniemi (29)