No. 5 UAS metode multivariat Ilham Akbar (4112322005)
# Load required libraries
library(dplyr)
## Warning: package 'dplyr' was built under R version 4.3.3
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(FactoMineR)
## Warning: package 'FactoMineR' was built under R version 4.3.3
library(factoextra)
## Warning: package 'factoextra' was built under R version 4.3.3
## Loading required package: ggplot2
## Warning: package 'ggplot2' was built under R version 4.3.3
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library(readr)
## Warning: package 'readr' was built under R version 4.3.3
library(ggplot2)
Langkah pertama adalah dengan menginstall beberapa fungsi yang diperlukan dalam analisis, lalu memanggil fungsi tersebut pada “library”.
# Load the dataset
data <- read_csv("C:/Koeleeah !!/Semester 5/Metode Multivariat/UAS/decathlon-3.csv")
## Rows: 41 Columns: 14
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): Athlets, Competition
## dbl (12): 100m, Long.jump, Shot.put, High.jump, 400m, 110m.hurdle, Discus, P...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
Kemudian melakukan penginputan dataset sesuai dengan format dataset, pada analisis ini dataset yang digunakan adalah “decathlon-3 PCA.xlsx” yang memiliki format file berupa xlxs, maka diperlukan fungsi “read_excel” untuk mengenali dan menginput dataset tersebut.
str(data)
## spc_tbl_ [41 × 14] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ Athlets : chr [1:41] "SEBRLE" "CLAY" "KARPOV" "BERNARD" ...
## $ 100m : num [1:41] 11 10.8 11 11 11.3 ...
## $ Long.jump : num [1:41] 7.58 7.4 7.3 7.23 7.09 7.6 7.3 7.31 6.81 7.56 ...
## $ Shot.put : num [1:41] 14.8 14.3 14.8 14.2 15.2 ...
## $ High.jump : num [1:41] 2.07 1.86 2.04 1.92 2.1 1.98 2.01 2.13 1.95 1.86 ...
## $ 400m : num [1:41] 49.8 49.4 48.4 48.9 50.4 ...
## $ 110m.hurdle: num [1:41] 14.7 14.1 14.1 15 15.3 ...
## $ Discus : num [1:41] 43.8 50.7 49 40.9 46.3 ...
## $ Pole.vault : num [1:41] 5.02 4.92 4.92 5.32 4.72 4.92 4.42 4.42 4.92 4.82 ...
## $ Javeline : num [1:41] 63.2 60.1 50.3 62.8 63.4 ...
## $ 1500m : num [1:41] 292 302 300 280 276 ...
## $ Rank : num [1:41] 1 2 3 4 5 6 7 8 9 10 ...
## $ Points : num [1:41] 8217 8122 8099 8067 8036 ...
## $ Competition: chr [1:41] "Decastar" "Decastar" "Decastar" "Decastar" ...
## - attr(*, "spec")=
## .. cols(
## .. Athlets = col_character(),
## .. `100m` = col_double(),
## .. Long.jump = col_double(),
## .. Shot.put = col_double(),
## .. High.jump = col_double(),
## .. `400m` = col_double(),
## .. `110m.hurdle` = col_double(),
## .. Discus = col_double(),
## .. Pole.vault = col_double(),
## .. Javeline = col_double(),
## .. `1500m` = col_double(),
## .. Rank = col_double(),
## .. Points = col_double(),
## .. Competition = col_character()
## .. )
## - attr(*, "problems")=<externalptr>
data_numeric <- data[, c("100m", "Long.jump", "Shot.put", "High.jump",
"400m", "110m.hurdle", "Discus", "Pole.vault",
"Javeline", "1500m")]
Langkah selanjutnya adalah menggunakan fungsi “str(data)” digunakan untuk memeriksa struktur dataset dan memastikan variabel numerik yang relevan dapat diidentifikasi. Lalu, dilakukan pemilihan variabel numerik dengan data menggunakan [, c(…)] agar data yang digunakan sesuai dengan kebutuhan analisis PCA, yaitu menghitung matriks kovarian atau korelasi dari variabel yang relevan.
library(FactoMineR)
pca_result <- PCA(data_numeric, graph = FALSE)
summary(pca_result)
##
## Call:
## PCA(X = data_numeric, graph = FALSE)
##
##
## Eigenvalues
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7
## Variance 3.272 1.737 1.405 1.057 0.685 0.599 0.451
## % of var. 32.719 17.371 14.049 10.569 6.848 5.993 4.512
## Cumulative % of var. 32.719 50.090 64.140 74.708 81.556 87.548 92.061
## Dim.8 Dim.9 Dim.10
## Variance 0.397 0.215 0.182
## % of var. 3.969 2.148 1.822
## Cumulative % of var. 96.030 98.178 100.000
##
## Individuals (the 10 first)
## Dist Dim.1 ctr cos2 Dim.2 ctr cos2 Dim.3
## 1 | 2.369 | 0.792 0.467 0.112 | 0.772 0.836 0.106 | 0.827
## 2 | 3.507 | 1.235 1.137 0.124 | 0.575 0.464 0.027 | 2.141
## 3 | 3.396 | 1.358 1.375 0.160 | 0.484 0.329 0.020 | 1.956
## 4 | 2.763 | -0.610 0.277 0.049 | -0.875 1.074 0.100 | 0.890
## 5 | 3.018 | -0.586 0.256 0.038 | 2.131 6.376 0.499 | -1.225
## 6 | 2.428 | 0.357 0.095 0.022 | -1.685 3.986 0.482 | 0.767
## 7 | 2.563 | 0.272 0.055 0.011 | -1.094 1.680 0.182 | -1.283
## 8 | 2.561 | 0.588 0.257 0.053 | 0.231 0.075 0.008 | -0.418
## 9 | 3.742 | -1.995 2.968 0.284 | 0.561 0.442 0.022 | -0.730
## 10 | 2.794 | -1.546 1.782 0.306 | 0.488 0.335 0.031 | 0.841
## ctr cos2
## 1 1.187 0.122 |
## 2 7.960 0.373 |
## 3 6.644 0.332 |
## 4 1.375 0.104 |
## 5 2.606 0.165 |
## 6 1.020 0.100 |
## 7 2.857 0.250 |
## 8 0.303 0.027 |
## 9 0.925 0.038 |
## 10 1.227 0.091 |
##
## Variables
## Dim.1 ctr cos2 Dim.2 ctr cos2 Dim.3 ctr
## 100m | -0.775 18.344 0.600 | 0.187 2.016 0.035 | -0.184 2.420
## Long.jump | 0.742 16.822 0.550 | -0.345 6.869 0.119 | 0.182 2.363
## Shot.put | 0.623 11.844 0.388 | 0.598 20.607 0.358 | -0.023 0.039
## High.jump | 0.572 9.998 0.327 | 0.350 7.064 0.123 | -0.260 4.794
## 400m | -0.680 14.116 0.462 | 0.569 18.666 0.324 | 0.131 1.230
## 110m.hurdle | -0.746 17.020 0.557 | 0.229 3.013 0.052 | -0.093 0.611
## Discus | 0.552 9.328 0.305 | 0.606 21.162 0.368 | 0.043 0.131
## Pole.vault | 0.050 0.077 0.003 | -0.180 1.873 0.033 | 0.692 34.061
## Javeline | 0.277 2.347 0.077 | 0.317 5.784 0.100 | -0.390 10.807
## 1500m | -0.058 0.103 0.003 | 0.474 12.946 0.225 | 0.782 43.543
## cos2
## 100m 0.034 |
## Long.jump 0.033 |
## Shot.put 0.001 |
## High.jump 0.067 |
## 400m 0.017 |
## 110m.hurdle 0.009 |
## Discus 0.002 |
## Pole.vault 0.479 |
## Javeline 0.152 |
## 1500m 0.612 |
Selanjutnya menggunakan fungsi PCA dari paket “FactoMineR” untuk melakukan analisis komponen utama (PCA) pada dataset numerik tanpa menampilkan grafik otomatis. Objek hasil analisis disimpan dalam “pca_result”, yang kemudian diringkas dengan fungsi summary untuk menampilkan informasi tentang eigenvalues, proporsi variansi yang dijelaskan oleh setiap komponen utama, serta kontribusi variabel terhadap komponen tersebut. Langkah ini bertujuan untuk memahami struktur data dalam ruang dimensi yang lebih rendah.
install.packages("factoextra")
## Warning: package 'factoextra' is in use and will not be installed
library(factoextra)
# (a) Tentukan berapa banyak komponen utama yang dihasilkan untuk menjelaskan variasi data. Jelaskan interpretasiny!
fviz_eig(pca_result, addlabels = TRUE, ylim = c(0, 100))
selanjutnya melakukan visualisasi pertama yaitu memvisualisasikan kontribusi masing-masing komponen utama terhadap variasi data, menggunakan Kode “fviz_eig(pca_result, addlabels = TRUE, ylim = c(0, 100))” untuk visualisasi hasil analisis PCA, khususnya untuk melihat kontribusi setiap komponen utama terhadap variasi data. Fungsi ini menghasilkan grafik scree plot yang menunjukkan eigenvalue atau proporsi varians yang dijelaskan oleh masing-masing komponen utama. Parameter addlabels = TRUE menambahkan label pada grafik untuk memudahkan identifikasi nilai eigenvalue setiap komponen. Parameter ylim = c(0, 100) mengatur batasan sumbu y dari 0 hingga 100 untuk mempermudah interpretasi. Analisis ini membantu dalam menentukan jumlah komponen utama yang perlu dipertahankan untuk menjelaskan sebagian besar variasi dalam data.
Visualisasi ini penting untuk menentukan berapa banyak komponen utama yang perlu dipertahankan, berdasarkan berapa banyak variasi data yang dapat dijelaskan oleh setiap komponen. Dengan melihat grafik scree plot yang dihasilkan, kita dapat memilih jumlah komponen utama yang sesuai, yang mencakup proporsi variasi data yang signifikan, sambil mengurangi dimensi data untuk analisis lebih lanjut. Ini adalah langkah kunci dalam memastikan bahwa model PCA tetap efisien dan representatif terhadap data asli.
# (b)
fviz_pca_ind(pca_result,
geom.ind = "point",
col.ind = data$Competition, # Differentiate by competition
palette = "jco",
addEllipses = TRUE, # Add confidence ellipses
legend.title = "Competition") +
labs(title = "PCA: Scatter Plot on PC1 and PC2",
x = "PC1",
y = "PC2")
Visualisai kedua yaitu distribusi data dalam ruang dua dimensi berdasarkan dua komponen utama pertama (PC1 dan PC2). Kode “fviz_pca_ind(pca_result, geom.ind =”point”, col.ind = data\(Competition, palette = "jco", addEllipses = TRUE, legend.title = "Competition")" digunakan untuk memvisualisasikan hasil PCA dalam bentuk scatter plot, dengan proyeksi data pada dua komponen utama pertama (PC1 dan PC2). Titik-titik pada plot mewakili individu atau sampel, dan warna titik membedakan berdasarkan kategori kompetisi yang ada dalam data (data\)Competition). Parameter addEllipses = TRUE menambahkan ellips yang menunjukkan distribusi sampel berdasarkan kategori, dengan tingkat kepercayaan tertentu.
Penjelasan: Plot ini menunjukkan distribusi atlet berdasarkan dua komponen utama (PC1 dan PC2) dari analisis PCA, dengan kelompok “Decastar” dan “OlympicG” yang memiliki pola distribusi berbeda namun ada tumpang tindih antar grup. Oval di sekitar titik menggambarkan penyebaran data masing-masing kelompok, dan PC1 menjelaskan proporsi variasi terbesar (32.7%), sedangkan PC2 menjelaskan 17.4%.
Plot ini membantu dalam mengidentifikasi pola, klaster, atau perbedaan antar grup dalam ruang dua dimensi berdasarkan komponen utama yang paling signifikan. Dengan scatter plot ini, kita dapat melihat sejauh mana data tersebar, serta mengidentifikasi pola atau klaster yang muncul berdasarkan kategori tertentu, seperti “Competition”. Penambahan ellips juga membantu untuk menilai sebaran dan kekompakan data dalam setiap kelompok, sehingga memberikan wawasan lebih lanjut tentang struktur data setelah dilakukan reduksi dimensi dengan PCA.
# (c) Variable contributions to PCs
fviz_pca_var(pca_result, col.var = "contrib",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE) +
labs(title = "PCA: Variable Contributions")
visualisasi ketiga yaitu distribusi sampel pada komponen utama (PC1 dan PC2). Kode fviz_pca_var “(pca_result, col.var =”contrib”, gradient.cols = c(“#00AFBB”, “#E7B800”, “#FC4E07”), repel = TRUE)” digunakan untuk memvisualisasikan kontribusi masing-masing variabel terhadap komponen utama (PCs). Grafik ini menunjukkan seberapa besar pengaruh setiap variabel dalam membentuk PC1 dan PC2, dengan warna yang menggambarkan tingkat kontribusi variabel, dari rendah ke tinggi. Parameter repel = TRUE menghindari tumpang tindih label variabel untuk meningkatkan keterbacaan.
Penjelasan: Plot kedua menggambarkan kontribusi variabel terhadap dua komponen utama. Variabel seperti “100m” dan “Discus” memiliki kontribusi besar terhadap Dim1, ditunjukkan oleh panjang anak panah dan intensitas warna. Hubungan variabel dengan Dim1 dan Dim2 menunjukkan bagaimana karakteristik fisik dan teknik memengaruhi performa atlet. - Kelompok 1: Titik-titik di kiri bawah (PC1 negatif, PC2 negatif), seperti Lorenzo, Nool, dan Drews, membentuk klaster terpisah. - Kelompok 2: Titik-titik di kanan atas (PC1 positif, PC2 positif), seperti Sebrie, Clay, dan Macey, yang tampaknya memiliki karakteristik serupa. - Kelompok 3: Titik-titik tersebar di tengah (PC1 dan PC2 sekitar nol), seperti McMullen, Pogorelov, dan Zsivoczky, mungkin merupakan kelompok campuran dengan variabilitas sedang.
Visualisasi ini bertujuan untuk mengevaluasi kontribusi masing-masing variabel dalam membentuk komponen utama yang telah terpilih. Dengan melihat kontribusi variabel, kita dapat memahami variabel mana yang paling berpengaruh dalam variasi data yang dijelaskan oleh PCA. Ini membantu dalam menginterpretasi hasil PCA secara lebih mendalam, dengan mengetahui faktor-faktor utama yang mendorong perbedaan yang tercermin dalam komponen utama, serta memberikan wawasan untuk analisis lebih lanjut atau pengambilan keputusan berbasis data.
# (d) Identify the principal component most related to each variable
var_contrib <- pca_result$var$contrib
print(var_contrib) # Contributions of variables to PCs
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## 100m 18.34376957 2.016090 2.42049891 0.13532858 13.336184
## Long.jump 16.82246707 6.868559 2.36319121 0.98030118 0.196456
## Shot.put 11.84353954 20.606785 0.03890276 3.43711486 1.804174
## High.jump 9.99788710 7.063694 4.79362526 1.73967752 45.053306
## 400m 14.11622887 18.666374 1.23027094 0.08124195 1.122971
## 110m.hurdle 17.02011495 3.013382 0.61083225 8.00327927 3.943110
## Discus 9.32848615 21.162245 0.13131711 6.38020830 1.604724
## Pole.vault 0.07745541 1.872547 34.06090024 28.78266727 15.899147
## Javeline 2.34696326 5.784369 10.80714169 48.00480246 13.596270
## 1500m 0.10308808 12.945954 43.54331962 2.45537861 3.443657
# Identify which PC is most relevant for each variable
apply(var_contrib, 1, function(x) names(which.max(x)))
## 100m Long.jump Shot.put High.jump 400m 110m.hurdle
## "Dim.1" "Dim.1" "Dim.2" "Dim.5" "Dim.2" "Dim.1"
## Discus Pole.vault Javeline 1500m
## "Dim.2" "Dim.3" "Dim.4" "Dim.3"
selanjutnya mengekstrak kontribusi masing-masing varibel terhadap komponen utama.Kode “var_contrib <- pca_result\(var\)contrib” digunakan untuk mengekstrak kontribusi variabel terhadap komponen utama dalam analisis PCA. Dengan “print(var_contrib)”, kita dapat melihat kontribusi numerik dari setiap variabel untuk setiap komponen utama. Kemudian, kode “apply(var_contrib, 1, function(x) names(which.max(x)))” digunakan untuk mengidentifikasi komponen utama yang paling relevan atau berkontribusi terbesar untuk setiap variabel. Fungsi ini mencari komponen utama dengan kontribusi tertinggi untuk setiap variabel, sehingga memberikan pemahaman tentang komponen utama mana yang paling mencerminkan informasi dari masing-masing variabel dalam data.
Penjelasan: Output tersebut menunjukkan kontribusi variabel terhadap masing-masing komponen utama (Dim.1 hingga Dim.5) serta identifikasi dimensi yang paling berhubungan dengan setiap variabel. Variabel seperti “100m”, “Long.jump”, dan “110m.hurdle” memiliki kontribusi tertinggi pada Dim.1, menunjukkan bahwa komponen utama pertama merepresentasikan variasi yang terkait dengan performa kecepatan dan loncatan. “Shot.put”, “400m”, dan “Discus” lebih terkait dengan Dim.2, mencerminkan dimensi kekuatan dan ketahanan. Dim.3 mendominasi variabel seperti “Pole.vault” dan “1500m”, menunjukkan hubungan dengan aktivitas yang membutuhkan teknik dan stamina. Dim.4 dan Dim.5 masing-masing terkait dengan “Javeline” dan “High.jump,” mengindikasikan dimensi spesifik terkait keterampilan. Interpretasi ini membantu memahami struktur data dan hubungan antar variabel melalui dimensi utama PCA.
Kode ini penting untuk memahami hubungan antara variabel asli dan komponen utama yang terbentuk setelah reduksi dimensi dan bertujuan untuk mengidentifikasi komponen utama yang paling berhubungan dengan setiap variabel dalam data. Dengan mengetahui komponen utama yang memiliki kontribusi terbesar terhadap setiap variabel, kita dapat memahami bagaimana setiap variabel berperan dalam membentuk struktur data yang dihasilkan oleh PCA. Langkah ini melanjutkan analisis dengan memberikan wawasan lebih dalam mengenai relevansi variabel terhadap komponen utama, yang membantu dalam interpretasi model PCA dan pemilihan variabel untuk analisis selanjutnya.
# (e) Rank athletes by PC1 (representing overall performance)
athlete_scores <- data.frame(Athletes = data$Athlets, PC1 = pca_result$ind$coord[,1])
athlete_ranking <- athlete_scores[order(-athlete_scores$PC1), ]
print(athlete_ranking)
## Athletes PC1
## 16 Karpov 4.619987275
## 14 Sebrle 4.038448501
## 15 Clay 3.919365157
## 17 Macey 2.233460566
## 18 Warners 2.168396445
## 22 Bernard 1.906334368
## 3 KARPOV 1.358214936
## 2 CLAY 1.234990563
## 19 Zsivoczky 0.925132183
## 20 Hernu 0.889037852
## 27 Smith 0.870310570
## 1 SEBRLE 0.791627717
## 8 McMULLEN 0.587516189
## 24 Pogorelov 0.539677028
## 29 Ojaniemi 0.380113999
## 6 WARNERS 0.356889530
## 28 Averyanov 0.349155138
## 21 Nool 0.295305667
## 7 ZSIVOCZKY 0.271774781
## 25 Schoenbeck 0.114430985
## 23 Schwarzl 0.081078659
## 26 Barras 0.002145203
## 32 Drews -0.248684024
## 35 Gomez -0.289889208
## 31 Qi -0.434466691
## 30 Smirnov -0.484514213
## 5 YURKOV -0.585968338
## 4 BERNARD -0.609515083
## 34 Terek -0.681953059
## 39 Korkizoglou -0.957829813
## 33 Parkhomenko -1.069429104
## 11 BARRAS -1.341652727
## 36 Turi -1.541813056
## 10 HERNU -1.546076462
## 38 Karlivans -1.994368727
## 9 MARTINEAU -1.995359298
## 12 NOOL -2.344973806
## 37 Lorenzo -2.408509980
## 40 Uldal -2.562259591
## 41 Casarsa -2.857088268
## 13 BOURGUIGNON -3.979041865
# Visualize ranking of athletes
ggplot(athlete_ranking, aes(x = reorder(Athletes, PC1), y = PC1)) +
geom_bar(stat = "identity", fill = "skyblue") +
coord_flip() +
labs(title = "Athlete Ranking by PC1",
x = "Athletes",
y = "PC1 (Performance Score)") +
theme_minimal()
Visusalisasi terakhir pada analisis ini yaitu identifikasi komponen utama yang paling relevan (dalam konteks ranking). Kode “athlete_scores <- data.frame(Athletes = data\(Athlets, PC1 = pca_result\)ind\(coord[,1])" digunakan untuk membuat data frame yang menyimpan skor performa setiap atlet berdasarkan nilai PC1 (komponen utama pertama). Kemudian, "athlete_ranking <- athlete_scores[order(-athlete_scores\)PC1), ]” mengurutkan atlet berdasarkan skor PC1 secara menurun, sehingga atlet dengan performa terbaik berada di urutan teratas. Kode berikutnya, “ggplot(athlete_ranking, aes(x = reorder(Athletes, PC1), y = PC1))”, digunakan untuk memvisualisasikan peringkat atlet berdasarkan skor PC1 dalam bentuk bar plot, dengan sumbu y menunjukkan nilai PC1 yang mencerminkan performa.
Penjelasan: Tabel dan visualisasi menunjukkan nilai PC1 untuk masing-masing atlet, di mana nilai tinggi pada PC1, seperti yang dimiliki Karpov dan Sebrle, menunjukkan dominasi mereka dalam variabel yang berkorelasi positif dengan Dim1, seperti kecepatan dan kekuatan. Data ini membantu mengidentifikasi atlet berdasarkan performa mereka dalam dimensi utama PCA
Tabel ini membantu dalam mengidentifikasi atlet dengan performa terbaik berdasarkan komponen utama yang menggabungkan berbagai variabel kinerja dengan cara mengurutkan atlet berdasarkan nilai PC1 yang lebih tinggi, kita dapat melihat atlet mana yang memiliki performa terbaik dalam dimensi utama yang dihasilkan oleh PCA. Serta, visualisasi dengan ggplot membantu untuk menyajikan peringkat ini secara lebih jelas, memudahkan analisis dan interpretasi hasil PCA dalam konteks performa atlet, serta mendukung keputusan berbasis data terkait atlet terbaik.