Analisis Biplot

      Biplot diperkenalkan pertama kali oleh Gabriel (1971) sehingga sering disebut sebagai Gabriel’s biplot. Menurut Sartono dkk, Biplot adalah salah satu upaya menggambarkan data-data yang ada pada tabel ringkasan dalam grafik berdimensi dua. Informasi yang diberikan oleh biplot mencakup objek dan peubah dalam satu gambar. Sedangkan menurut Jollife dan Rawlings, Biplot adalah teknik statistika deskriptif yang dapat disajikan secara visual guna menyajikan secara simultan \(n\) objek pengamatan dan \(p\) peubah dalam ruang bidang datar, sehingga ciri-ciri peubah dan objek pengamatan serta posisi relatif antar objek pengamatan dengan peubah dapat dianalisis.
Berikut adalah informasi yang dapat disimpulkan dari analisis Biplot:
  1. Kedekatan antar objek yang diamati
    Dua objek yang memiliki karakteristik sama akan digambarkan sebagai dua titik dengan posisi yang berdekatan.
  2. Keberagaman Peubah
    Variabel yang mempunyai nilai keragaman yang kecil digambarkan sebagai vektor pendek sedangkan variabel dengan nilai keragaman yang besar digambarkan sebagai vektor yang panjang.
  3. Korelasi antar Peubah
    Korelasi positif : dua buah garis dengan arah yang sama atau membentuk sudut sempit
    Korelasi negatif : dua garis dengan arah yang berlawanan atau membentuk sudut lebar (tumpul)
    Tidak ada korelasi : dua garis dengan sudut yang mendekati 90 derajat (siku-siku)
  4. Nilai Peubah pada suatu Objek
    Objek yang terletak searah dengan arah vektor variabel dikatakan bahwa objek tersebut mempunyai nilai di atas ratarata. Namun jika objek terletak berlawanan dengan arah dari vektor variabel tersebut, maka objek tersebut memiliki nilai di bawah rata-rata. Sedangkan objek yang hampir berada ditengahtengah berarti objek tersebut memiliki nilai dekat dengan rata-rata
      Biplot adalah upaya membuat gambar di ruang berdimensi banyak menjadi gambar di ruang berdimensi dua. Pereduksian dimensi ini mengakibatkan menurunnya informasi yang terkandung dalam biplot. Biplot yang mampu memberikan informasi sebesar 70% dari seluruh informasi dianggap cukup.
      Biplot merupakan teknik statistika deskriptif dimensi ganda yang mendasarkan pada penguraian nilai singular (PNS) atau Singular Value Decomposition (SVD). Misalkan suatu matriks data \(X\) berukuran \(n×p\) yang berisi \(n\) pengamatan dan \(p\) peubah yang dikoreksi terhadap nilai rata-ratanya dan berpangkat \(r\) dengan \(r \le min\) { \(n,p\) }, dapat dituliskan menjadi \[X = ULA^t\]

Keterangan :

    Kolom matriks \(A\) adalah vektor ciri yang berpadanan dengan akar ciri \(\lambda\) dari matriks \(X^tX\) atau \(XX^t\). Lajur-lajur matriks \(U\) dapat dihitung melalui: \[U_i=\frac{1}{\sqrt\lambda_i}Xa_i\]

dengan \(\lambda_i\) adalah akar ciri ke-\(i\) dari matriks \(X^tX\) dan \(a_i\) adalah lajur ke-\(i\) matriks \(A\). Matriks \(U,L\) dan \(A\) dituliskan persamaan berikut \[X_{n \times r} = U_{n \times r} L_{r \times r}A^t_{r \times p} \] \[U=\bigg\{ \frac{1}{\sqrt{\lambda_1}}Xa_1, \frac{1}{\sqrt{\lambda_2}}Xa_2, \dots, \frac{1}{\sqrt{\lambda_r}}Xa_r \bigg\}\] \[L=\begin{bmatrix} \sqrt{\lambda_1} & 0 & \dots & 0 \\ 0 & \sqrt{\lambda_2} & \dots & 0 \\ \vdots & \vdots & \ddots & \vdots \\ 0 & 0 & \dots & \sqrt{\lambda_n} \\ \end{bmatrix}\] \[A=(a_1,a_2,\dots,a_r)\] Penjabaran persamaan diatas dapat dituliskan dalam persamaan berikut \[X=UL^\alpha L^{1-\alpha} A^t=GH^t\] sehingga \(G=UL^\alpha\) serta \(H^t=L^{1-\alpha}A^t\) Himpunan data awal mengandung \(n\) observasi dan \(p\) variabel direduksi menjadi himpunan data yang terdiri dari \(n\) observasi dan \(m\) unsur pertama. Jika \(m=2\) disebut biplot, sehingga matrik \(G\) dan \(H\) disusun oleh 2 unsur pertama matriks tersebut. \[G=\begin{bmatrix} g_{11} & g_{12} \\ \vdots & \vdots \\ g_{i1} & g_{i2} \\ \vdots & \vdots \\ g_{n1} & g_{n2} \\ \end{bmatrix} \text{, dan } H=\begin{bmatrix} h_{11} & h_{12} \\ \vdots & \vdots \\ h_{i1} & h_{i2} \\ \vdots & \vdots \\ h_{n1} & h_{n2} \\ \end{bmatrix} \] Matriks \(G\) adalah titik-titik koordinat dari \(n\) objek dan matriks \(H\) adalah titik-titik koordinat dari \(p\) variabel.

Langkah-langkah Analisis Biplot

  1. Cari matriks \(X'X\)
  2. Menghitung nilai eigen dari matriks pada tahap 1 \[l_i=\sqrt{\lambda_i}\] Cari matriks \(U, L, \text{dan} A\)
  3. Menghitung matriks \(G\) dan \(H\)
  4. Gambarkan biplot pada bidang 2 dimensi
  5. Menghitung ukuran kebaikan biplot dan kharakteristiknya
    Ukuran kebaikan biplot: \[\rho^2 = \frac{(\lambda_1 + \lambda_2)}{\sum_{k=1}\lambda_k}\] Korelasi antar variabel: \[r_{12}=\frac{S_{12}}{S_1S_2}\]

Program R

   Program R dapat digunakan untuk melakukan analisis biplot. berikut langkah-langkahnya:

1. Import dan Preprocessing Data

data yang digunakan adalah data dari beberapa statistik pemain bola berdasarkan Fifa 18

# Import Data
library(readxl)
library(tibble)
Fifa18 <- read_excel("D:/Praktikum/ADE/Fifa18.xlsx")
head(Fifa18)
## # A tibble: 6 x 13
##   Name    Acceleration `Ball control` Crossing Dribbling Finishing `GK reflexes`
##   <chr>          <dbl>          <dbl>    <dbl>     <dbl>     <dbl>         <dbl>
## 1 Ramos             75             84       66        61        60            11
## 2 Chiell~           68             57       58        58        33             3
## 3 Bonucci           62             75       44        69        39             4
## 4 Godin             62             76       55        53        42            15
## 5 Hummels           62             77       64        68        55             6
## 6 T. Sil~           70             80       60        68        38            10
## # ... with 6 more variables: Heading accuracy <dbl>, Interceptions <dbl>,
## #   Jumping <dbl>, Long passing <dbl>, Marking <dbl>, Preferred Positions <chr>
# Mengubah Kolom nama Menjadi Baris
Fifa18 <- data.frame(column_to_rownames(Fifa18, var = "Name"))

# Menghapus Kolom Preferred Position
Fifa18 <- Fifa18[,-12]


2. Melakukan Analisis Komponen Utama

#PCA
pca <- prcomp(Fifa18, scale = TRUE)


3. Menampilkan Summary PCA

sum_pca <- summary(pca)
sum_pca
## Importance of components:
##                           PC1    PC2     PC3     PC4     PC5     PC6     PC7
## Standard deviation     2.7085 1.6257 0.79294 0.45741 0.30465 0.20083 0.14399
## Proportion of Variance 0.6669 0.2403 0.05716 0.01902 0.00844 0.00367 0.00188
## Cumulative Proportion  0.6669 0.9072 0.96432 0.98334 0.99177 0.99544 0.99733
##                            PC8     PC9    PC10    PC11
## Standard deviation     0.11245 0.10035 0.06876 0.04435
## Proportion of Variance 0.00115 0.00092 0.00043 0.00018
## Cumulative Proportion  0.99848 0.99939 0.99982 1.00000


Membuat Plot

Mengelompokkan Tiap Pemain berdasarkan Posisi Bermain

# Create groups
pch.group <- c(rep(21, times=6), rep(21, times=6), rep(21, times=6))
col.group <- c(rep("skyblue2", times=6), rep("gold", times=6),  rep("red2", times=6))


Membuat Plot

# Plot Individuals
plot(pca$x[,1], pca$x[,2], xlim=c(-4, 4), ylim=c(-3, 3), xlab=paste("PCA 1 (", round(sum_pca$importance[2]*100, 1), "%)", sep = ""), ylab=paste("PCA 2 (", round(sum_pca$importance[5]*100, 1), "%)", sep = ""), pch=pch.group, col="black", bg=col.group, cex=2, las=1, asp=1)

# Add grid lines
abline(v=0, lty=2, col="grey50")
abline(h=0, lty=2, col="grey50")

# Add labels
text(pca$x[,1], pca$x[,2], labels=row.names(pca$x), pos=c(1,3,4,2), font=2)

# Get co-ordinates of variables (loadings), and multiply by 10
l.x <- pca$rotation[,1]*10
l.y <- pca$rotation[,2]*10

# Draw arrows
arrows(x0=0, x1=l.x, y0=0, y1=l.y, col="red", length=0.15, lwd=1.5)

# Label position
l.pos <- l.y # Create a vector of y axis coordinates
lo <- which(l.y < 0) # Get the variables on the bottom half of the plot
hi <- which(l.y > 0) # Get variables on the top half

# Replace values in the vector
l.pos <- replace(l.pos, lo, "1")
l.pos <- replace(l.pos, hi, "3")

# Variable labels
text(l.x, l.y, labels=row.names(pca$rotation), col="red", pos=l.pos)

# Add legend
legend("bottomright", legend=c("Center-Back", "Goalkeeper", "Striker"), col="black", pt.bg=c("skyblue2", "gold", "red2"), pch=c(21, 21, 21), pt.cex=1.5)

# Get individuals (observations) as a matrix
tab <- matrix(c(pca$x[,1], pca$x[,2]), ncol=2)

# Calculate correlations
c1 <- cor(tab[1:6,])
c2 <- cor(tab[7:12,])
c3 <- cor(tab[13:18,])

# Load package
library(ellipse)
## 
## Attaching package: 'ellipse'
## The following object is masked from 'package:graphics':
## 
##     pairs
# Plot ellipse
polygon(ellipse(c1*(max(abs(pca$rotation))*0.3), centre=colMeans(tab[1:6,]), level=0.95), col=adjustcolor("skyblue2", alpha.f=0.25), border="skyblue")
polygon(ellipse(c2*(max(abs(pca$rotation))*0.3), centre=colMeans(tab[7:12,]), level=0.95), col=adjustcolor("gold", alpha.f=0.1), border="gold2")
polygon(ellipse(c3*(max(abs(pca$rotation))*0.3), centre=colMeans(tab[13:18,]), level=0.95), col=adjustcolor("red", alpha.f=0.25), border="red")