Nama : Iksan Nur Afiah
Nim : 4112322009
Prodi : Statistika Terapan dan Komputasi

UAS Metode Multivariat

Package

Pustaka yang akan digunakan adalah:

  1. Factoextra: Pustaka ini menyediakan fungsi-fungsi untuk mengekstrak dan memvisualisasikan hasil analisis data multivariat.
  2. GridExtra: Digunakan untuk menyusun beberapa plot berbasis grid pada satu halaman, serta untuk menggambar tabel.
  3. CarData dan Car: Pustaka pendukung yang berisi kumpulan data dan alat untuk regresi terapan.
  4. Corrplot: Memungkinkan pembuatan visualisasi matriks korelasi yang informatif.
  5. Ggplot2: Digunakan untuk manipulasi data dan pembuatan visualisasi grafik.
  6. Ggfortify: Menyediakan alat untuk visualisasi data dari hasil analisis statistik.
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")

Import Data

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)

Explanatory Data Analysis

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

a. Analisis PCA

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.

b. Scatter Plot 2 Komponen Pertama

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.

c. Hubungan Hasil PCA dengan Cabang Lomba dan Atlet

1. Hubungan Hasil PCA dengan Cabang Lomba

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.

2. Hubungan Hasil PCA dengan Atlet

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.

d. Ringkasan Hasil

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.

e. Urutan Atlet yang Memiliki Performa Terbaik

# 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)