Praktikum 13 STA582

Clustering Analysis

Secara natural keberadaan kelompok (gerombol) selalu ada, yang ditunjukkan oleh pola data. Semakin besar ukuran data, maka akan semakin sulit menemukan pola yang ada pada data. Analisis gerombol (clustering analysis) bertujuan untuk mengelompokkan objek berdasarkan kemiripan karakteristik yang dimiliki. Objek dalam satu cluster memiliki karakteristik yang mirip, sementara objek yang berbeda gerombol memiliki karakteristik yang berbeda. Kemiripan antar objek dapat dihitung menggunakan jarak, semakin mirip karakteristiknya maka jaraknya semakin dekat. Beberapa konsep jarak yang dapat digunakan antara lain Euclidean, Manhattan, Mahalanobis.

Prosedur Clustering Analysis

Secara umum prosedur clustering dibagi menjadi 2, Hierarchical dan Non Heirarchical.

Hierarchical Clustering

Pada hierarchical clustering tidak membutuhkan jumlah cluster sebagai nilai input, tetapi membutuhkan kondisi pemberhentian algoritma. Algoritma hierarchical clustering:

  • n objek dianggak sebagai n cluster
  • susun matriks jarak antar cluster
  • dua objek dengan jarak terdekat digabungkan menjadi satu cluster
  • ulangi langkah 2 dan 3 sampai terbentuk 1 cluster

Metode penentuan jarak antar gerombol ada beberapa macam, yaitu: Pautan Tunggal, Pautan Lengkap, Pautan Rataan, Pautan Centroid, Pautan Median. Contoh Hierarchical clustering adalah Agglomerative, Divisive. Berikut ilustrasi untuk hierarchical clustering. Data yang digunakan dalam ilustrasi ini adalah data buatan (dummy data).

library(readxl)
library(cluster)
library(factoextra)
library(plotly)
library(dplyr)
Nama<-c('Andi','Benny','Budi','Ika','Maya','Ana')
Mat<-c(8.1,5.6,5.2,6.7,8.2,5.7)
Fis<-c(8.3,6.3,5.8,6.8,8.2,6.4)
Bio <- c(7.6,6.1,5.7,5.6,7.4,5.9)
Sej <- c(6.2,7.3,7,7.4,6.4,7.1)
Kew <- c(5.8,7.4,6.8,5.3,5.7,7.2)
Sos <- c(5.4,7.6,7.2,5.4,5.5,7.3)
Sen <- c(6.0,6.0,5.7,7.9,6.1,5.8)
Ujian <- data.frame(Nama,Mat,Fis,Bio,Sej,Kew,Sos,Sen)
(jarak1<-dist(Ujian[,-1]))
          1         2         3         4         5
2 4.5945620                                        
3 4.8207883 1.1269428                              
4 3.6755952 3.8183766 3.7080992                    
5 0.3605551 4.4922155 4.7191101 3.4438351          
6 4.3220366 0.5196152 0.9165151 3.6013886 4.2201896

Secara default metode penghitungan jarak pada fungsi dist adalah Euclidean. Untuk mengubah metode penghitungan jarak, menggunakan argumen method diikuti nama metode yang ingin digunakan.

dist(Ujian[,-1],method="manhattan")
     1    2    3    4    5
2 10.9                    
3 11.2  2.9               
4  8.5  8.4  8.5          
5  0.9 10.6 10.9  8.0     
6 10.4  1.3  2.0  7.9 10.1

Untuk melakukan hierarchical clustering Agglomerative menggunakan fungsi hclust. Pada fungsi hclust secara default jenis tautan yang digunakan adalah Tautan Lengkap (Complete Linkage), untuk mengganti jenis tautan menggunakan argumen method

#Pautan Lengkap
clustering1<-hclust(jarak1)
plot(clustering1, hang=-1)
rect.hclust(clustering1,k=3)

cutree(clustering1,3)
[1] 1 2 2 3 1 2
#Pautan Tunggal
clustering2 <- hclust(jarak1,method="single")
plot(clustering2,hang=-1)
rect.hclust(clustering2,k=3)

cutree(clustering2,3)
[1] 1 2 2 3 1 2
#Pautan Rata Rataan
clustering3 <- hclust(jarak1,method="average")
plot(clustering3,hang=-1)
rect.hclust(clustering3,k=3)

cutree(clustering3,3)
[1] 1 2 2 3 1 2

Non-Hierarchical Clustering

Metode Non-Hierarchical clustering membutuhkan input berupa jumlah cluster yang diinginkan. Algoritma Non-hierarchical clustering:

  • tentukan banyaknya cluster, k
  • tentukan centroid (titik pusat) dari masing-masing cluster
  • hitung jarak setiap objek terhadap centroid masing-masing cluster
  • kelompokkan objek ke cluster yang paling dekat
  • update centroid setiap cluster berdasarkan rata-rata (K-Means) atau median (K-Medoid) objek yang berada dalam cluster tersebut
  • Ulangi langkah 3-5 sampai centroid tidak berubah

Untuk mencari jumlah cluster yang optimal dapat menggunakan kriteria koefisien silhoutte, WSS plot (Elbow Rule), atau plot Komponen Utama 1 dan Komponen Utama 2. Berikut ilustrasi untuk Non-hierarchical clustering K-Means menggunakan fungsi kmeans dan K-Medoid menggunakan fungsi pam dari package cluster.

#K-Means
clustering4 <- kmeans(Ujian[,-1],3)
clustering4
K-means clustering with 3 clusters of sizes 2, 3, 1

Cluster means:
   Mat      Fis Bio      Sej      Kew      Sos      Sen
1 8.15 8.250000 7.5 6.300000 5.750000 5.450000 6.050000
2 5.50 6.166667 5.9 7.133333 7.133333 7.366667 5.833333
3 6.70 6.800000 5.6 7.400000 5.300000 5.400000 7.900000

Clustering vector:
[1] 1 2 2 3 1 2

Within cluster sum of squares by cluster:
[1] 0.0650000 0.7933333 0.0000000
 (between_SS / total_SS =  97.3 %)

Available components:

[1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
[6] "betweenss"    "size"         "iter"         "ifault"      
fviz_cluster(clustering4,Ujian[,-1])

#K-Medoid
clustering5 <- pam(Ujian[,-1],3)
clustering5
Medoids:
     ID Mat Fis Bio Sej Kew Sos Sen
[1,]  5 8.2 8.2 7.4 6.4 5.7 5.5 6.1
[2,]  6 5.7 6.4 5.9 7.1 7.2 7.3 5.8
[3,]  4 6.7 6.8 5.6 7.4 5.3 5.4 7.9
Clustering vector:
[1] 1 2 2 3 1 2
Objective function:
    build      swap 
0.2994476 0.2994476 

Available components:
 [1] "medoids"    "id.med"     "clustering" "objective"  "isolation" 
 [6] "clusinfo"   "silinfo"    "diss"       "call"       "data"      
fviz_cluster(clustering5,Ujian[,-1])

Penerapan Clustering

Data

Data yang digunakan memuat waktu lari atlet dari 55 negara pada jarak pendek (100m, 200m, 400m), jarak menengah (800m, 1500m), dan jarak jauh (5000m, 10000m, dan marathon). Satuan yang digunakan adalah detik untuk jarak pendek, dan menit untuk jarak menengah dan jarak jauh.

runningtime<-read_xlsx('Running Time.xlsx') #sesuaikan alamat direktori file
str(runningtime)
tibble[,9] [55 x 9] (S3: tbl_df/tbl/data.frame)
 $ country : chr [1:55] "argentin" "australi" "austria" "belgium" ...
 $ 100m(s) : num [1:55] 10.4 10.3 10.4 10.3 10.3 ...
 $ 200m(s) : num [1:55] 20.8 20.1 20.8 20.7 20.6 ...
 $ 400m(s) : num [1:55] 46.8 44.8 46.8 45 45.9 ...
 $ 800m    : num [1:55] 1.81 1.74 1.79 1.73 1.8 1.73 1.8 1.76 1.79 1.81 ...
 $ 1500m   : num [1:55] 3.7 3.57 3.6 3.6 3.75 3.66 3.85 3.63 3.71 3.73 ...
 $ 5000m   : num [1:55] 14 13.3 13.3 13.2 14.7 ...
 $ 10000m  : num [1:55] 29.4 27.7 27.7 27.4 30.6 ...
 $ Marathon: num [1:55] 138 128 136 130 147 ...
boxplot(runningtime[,-1])

Berdasarkan boxplot tampak bahwa data memiliki skala yang berbeda. Dalam clustering, di mana algoritma di dalamnya melakukan perhitungan jarak, sangat terpengaruh dengan skala data, data dengan skala yang besar akan mendominasi, sehingga perlu dilakukan penyeragaman/ standarisasi skala.

runningtime1 <- scale(runningtime[,-1])
jarak2 <- dist(runningtime1)
fviz_dist(jarak2,gradient=list(low="white",high="blue"))

Hierarchical Clustering

clustering6 <- hclust(jarak2,"complete")
fviz_dend(clustering6,k=3,rect=T,cex=0.5)

clustering7 <- hclust(jarak2,"ward.D")
clustering7$height[50:54]
[1]  8.033937  8.932357 16.234272 16.248164 53.603211
fviz_dend(clustering7,k=4,rect=T,cex=0.5)

Non-Hierarchical Clustering

K-Means

clustering8 <- kmeans(runningtime1,4)
fviz_cluster(clustering8,data=runningtime1)

Untuk menentukan jumlah cluster optimal, digunakan WSS plot.

wssplot<-function(data, nc=15, seed=1234){
  wss<-(nrow(data)-1)*sum(apply(data,2,var))
  for (i in 2:nc){
    set.seed(seed)
    wss[i] <-sum(kmeans(data, centers=i)$withinss)}
  plot(1:nc, wss, type="b", xlab="Number of Clusters",
       ylab="Within groups sum of squares",main="WSS Plot")}
wssplot(runningtime1)

berdasarkan WSS Plot, jumlah cluster yang optimal (sebelah kiri curam, sebelah kanan landai) adalah 3. Selanjutnya dilakukan clustering dengan jumlah cluster 3.

set.seed(10)
clustering9 <- kmeans(runningtime1,3)
fviz_cluster(clustering9,data=runningtime1)

K-Medoid

clustering10 <- pam(runningtime1,3)
clusplot(clustering10)

pca <- prcomp(runningtime1)
runningtimepca <- data.frame(runningtime1 %*% pca$rotation)
runningtimepca$cluster <- factor(clustering10$clustering)
plot_ly(x=~PC1,y=~PC2,z=~PC3,data=runningtimepca,color = ~cluster)

Profiling

runningtime2 <- cbind(runningtime,cluster=clustering9$cluster)
{ par(mfrow=c(2,4))
  boxplot(`100m(s)`~cluster,runningtime2)
  boxplot(`200m(s)`~cluster,runningtime2)
  boxplot(`400m(s)`~cluster,runningtime2)
  boxplot(`800m`~cluster,runningtime2)
  boxplot(`1500m`~cluster,runningtime2)
  boxplot(`5000m`~cluster,runningtime2)
  boxplot(`10000m`~cluster,runningtime2)
  boxplot(Marathon~cluster,runningtime2)
par(mfrow=c(1,1))}

Dari plot di atas dapat dilihat perbedaan waktu lari untuk setiap cluster. Dari semua jenis lari (jarak pendek, menengah dan jauh), cluster 1 merupakan cluster dengan waktu lari paling kecil (cepat), cluster 2 sedang dan cluster 3 memiliki waktu lari paling besar (lama).

clus1<-runningtime2%>%filter(cluster==1)
clus1
    country 100m(s) 200m(s) 400m(s) 800m 1500m 5000m 10000m Marathon cluster
1  australi   10.31   20.06   44.84 1.74  3.57 13.28  27.66   128.30       1
2   belgium   10.34   20.68   45.04 1.73  3.60 13.22  27.45   129.95       1
3    brazil   10.22   20.43   45.21 1.73  3.66 13.62  28.62   133.13       1
4    canada   10.17   20.22   45.68 1.76  3.63 13.55  28.09   130.15       1
5     czech   10.35   20.65   45.64 1.76  3.58 13.42  28.19   134.32       1
6   denmark   10.56   20.52   45.89 1.78  3.61 13.50  28.11   130.78       1
7   finland   10.43   20.69   45.49 1.74  3.61 13.27  27.52   130.87       1
8    france   10.11   20.38   45.28 1.73  3.57 13.34  27.97   132.30       1
9       gdr   10.12   20.33   44.87 1.73  3.56 13.17  27.42   129.92       1
10      frg   10.16   20.37   44.50 1.73  3.53 13.21  27.61   132.23       1
11     gbni   10.11   20.21   44.93 1.70  3.51 13.01  27.51   129.13       1
12  hungary   10.26   20.62   46.02 1.77  3.62 13.49  28.44   132.58       1
13    italy   10.01   19.72   45.26 1.73  3.60 13.23  27.52   131.08       1
14    japan   10.34   20.81   45.86 1.79  3.64 13.41  27.72   128.63       1
15    kenya   10.46   20.66   44.92 1.73  3.55 13.10  27.38   129.75       1
16 netherla   10.52   20.95   45.10 1.74  3.62 13.36  27.61   129.02       1
17       nz   10.51   20.88   46.10 1.74  3.54 13.21  27.70   128.98       1
18   poland   10.16   20.24   45.36 1.76  3.60 13.29  27.89   131.58       1
19  rumania   10.41   20.98   45.87 1.76  3.64 13.25  27.67   132.50       1
20    spain   10.42   20.77   45.98 1.76  3.55 13.31  27.73   131.57       1
21   sweden   10.25   20.61   45.63 1.77  3.61 13.29  27.94   130.63       1
22 switzerl   10.37   20.46   45.78 1.78  3.55 13.22  27.91   131.20       1
23      usa    9.93   19.75   43.86 1.73  3.53 13.20  27.43   128.22       1
24     ussr   10.07   20.00   44.60 1.75  3.59 13.20  27.53   130.55       1
clus2<-runningtime2%>%filter(cluster==2)
clus2
    country 100m(s) 200m(s) 400m(s) 800m 1500m 5000m 10000m Marathon cluster
1  argentin   10.39   20.81   46.84 1.81  3.70 14.04  29.36   137.72       2
2   austria   10.44   20.81   46.82 1.79  3.60 13.26  27.72   135.90       2
3   bermuda   10.28   20.58   45.91 1.80  3.75 14.68  30.55   146.62       2
4     burma   10.64   21.52   48.30 1.80  3.85 14.45  30.28   139.95       2
5     chile   10.34   20.80   46.20 1.79  3.71 13.61  29.30   134.03       2
6     china   10.51   21.04   47.30 1.81  3.73 13.90  29.13   133.53       2
7  columbia   10.43   21.05   46.10 1.82  3.74 13.49  27.88   131.35       2
8     costa   10.94   21.90   48.66 1.87  3.84 14.03  28.81   136.58       2
9    greece   10.22   20.71   46.56 1.78  3.64 14.59  28.45   134.60       2
10    india   10.60   21.42   45.73 1.76  3.73 13.77  28.81   131.98       2
11  ireland   10.61   20.96   46.30 1.79  3.56 13.32  27.81   132.35       2
12   israel   10.71   21.00   47.80 1.77  3.72 13.66  28.93   137.55       2
13    korea   10.34   20.89   46.90 1.79  3.77 13.96  29.23   136.25       2
14 dprkorea   10.91   21.94   47.30 1.85  3.77 14.13  29.67   130.87       2
15 luxembou   10.35   20.77   47.40 1.82  3.67 13.64  29.08   141.27       2
16   mexico   10.42   21.30   46.10 1.80  3.65 13.46  27.95   129.20       2
17   norway   10.55   21.16   46.71 1.76  3.62 13.34  27.69   131.48       2
18 portugal   10.53   21.17   46.70 1.79  3.62 13.13  27.38   128.65       2
19   taipei   10.59   21.29   46.80 1.79  3.77 14.07  30.07   139.27       2
20   turkey   10.71   21.43   47.60 1.79  3.67 13.56  28.58   131.50       2
clus3<-runningtime2%>%filter(cluster==3)
clus3
    country 100m(s) 200m(s) 400m(s) 800m 1500m 5000m 10000m Marathon cluster
1    cookis   12.18   23.20   52.94 2.02  4.24 16.70  35.38   164.70       3
2    domrep   10.14   20.65   46.80 1.82  3.82 14.91  31.45   154.12       3
3  guatemal   10.98   21.82   48.40 1.89  3.80 14.16  30.11   139.33       3
4  indonesi   10.59   21.49   47.80 1.84  3.92 14.73  30.79   148.83       3
5  malaysia   10.40   20.92   46.30 1.82  3.80 14.64  31.01   154.10       3
6  mauritiu   11.19   22.45   47.70 1.88  3.83 15.06  31.77   152.23       3
7       png   10.96   21.78   47.90 1.90  4.01 14.72  31.36   148.22       3
8  philippi   10.78   21.64   46.24 1.81  3.83 14.74  30.64   145.27       3
9  singapor   10.38   21.28   47.40 1.88  3.89 15.11  31.32   157.77       3
10 thailand   10.39   21.09   47.91 1.83  3.84 15.23  32.56   149.90       3
11   wsamoa   10.82   21.86   49.00 2.02  4.24 16.28  34.71   161.83       3
negara<-rbind(head(clus1$country,10),head(clus2$country,10),
              head(clus3$country,10))

library(ggrepel)
ggplot(runningtime2,aes(`800m`,`Marathon`,
                        color=factor(cluster)))+
  geom_point(shape=1, size=2, stroke= 1.5)+
  geom_text_repel(aes(label=country),
                  color='gray20',
            data = subset(runningtime2, country %in% negara))