LBB Wine Clustering
Michael Deng
September 14, 2021
# clear-up the environment
rm(list = ls())
# chunk options
knitr::opts_chunk$set(
message = FALSE,
warning = FALSE,
fig.align = "center",
comment = "#>"
)
options(scipen = 123)1 Introduction
Selamat pagi/siang/malam kepada para pembaca report LBB ini. Dalam report ini, kita akan mengelompokan (Clustering) pada dataset Wine dengan metode Unsupervised Learning yang dimana kita tidak memiliki target variable dan kita akan mencari pola yang ada dalam data sehingga kita bisa mengelompokan jenis Wine dari pola data yang kita dapat. Data diperoleh dari kaggle.
# Import Library
kita akan memasukan terlebih dahulu packages yang akan kita pakai.
library(dplyr)
library(FactoMineR)
library(GGally)
library(purrr)
library(mvoutlier)
library(factoextra)2 Read and Cleansing Data
pada bagian ini kita akan melihat dataset yang kita dapat dan membersihkan data jika dalam data terdapat missing value atau outlier.
wine <- read.csv("data input/winequality-white.csv")
glimpse(wine)#> Rows: 4,898
#> Columns: 12
#> $ fixed.acidity <dbl> 7.0, 6.3, 8.1, 7.2, 7.2, 8.1, 6.2, 7.0, 6.3, 8.1,~
#> $ volatile.acidity <dbl> 0.27, 0.30, 0.28, 0.23, 0.23, 0.28, 0.32, 0.27, 0~
#> $ citric.acid <dbl> 0.36, 0.34, 0.40, 0.32, 0.32, 0.40, 0.16, 0.36, 0~
#> $ residual.sugar <dbl> 20.70, 1.60, 6.90, 8.50, 8.50, 6.90, 7.00, 20.70,~
#> $ chlorides <dbl> 0.045, 0.049, 0.050, 0.058, 0.058, 0.050, 0.045, ~
#> $ free.sulfur.dioxide <dbl> 45, 14, 30, 47, 47, 30, 30, 45, 14, 28, 11, 17, 1~
#> $ total.sulfur.dioxide <dbl> 170, 132, 97, 186, 186, 97, 136, 170, 132, 129, 6~
#> $ density <dbl> 1.0010, 0.9940, 0.9951, 0.9956, 0.9956, 0.9951, 0~
#> $ pH <dbl> 3.00, 3.30, 3.26, 3.19, 3.19, 3.26, 3.18, 3.00, 3~
#> $ sulphates <dbl> 0.45, 0.49, 0.44, 0.40, 0.40, 0.44, 0.47, 0.45, 0~
#> $ alcohol <dbl> 8.8, 9.5, 10.1, 9.9, 9.9, 10.1, 9.6, 8.8, 9.5, 11~
#> $ quality <int> 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5, 7, 5, 7, 6~Dengan function glimpse, kita melihat kalau semua tipe data dalam dataset wine sudah dalam bentuk numeric tapi kita akan menghapus kolom quality karena kolom quality lebih cocok sebagai tipe kategori. kita hanya butuh kolom int/num karena analisis PCA menggunakan nilai variance.
wine <- wine %>%
select(-quality)selanjutnya kita ingin melihat apakah ada missing value (NA) dalam data.
anyNA(wine)#> [1] FALSEcolSums(is.na(wine))#> fixed.acidity volatile.acidity citric.acid
#> 0 0 0
#> residual.sugar chlorides free.sulfur.dioxide
#> 0 0 0
#> total.sulfur.dioxide density pH
#> 0 0 0
#> sulphates alcohol
#> 0 0kita tidak mendapati adanya missing value. dengan tidak adanya missing value, kita sudah bisa membuat model unsupervised learning.
boxplot(wine)
pada tahap ini kita melihat adanya data outlier tapi kita tidak akan melakukan cleansing outlier sekarang.
3 PCA
PCA adalah rangkuman informasi (variance) dari variabel-variabel awal menggunakan dimensi-dimensi baru yang disebut principal component (PC)
sebelum membuat PCA, kita ingin terlebih dahulu melihat range pada data apakah sudah hampir sama atau tidak. kita bisa melihat range data dengan function summary()
summary(wine)#> fixed.acidity volatile.acidity citric.acid residual.sugar
#> Min. : 3.800 Min. :0.0800 Min. :0.0000 Min. : 0.600
#> 1st Qu.: 6.300 1st Qu.:0.2100 1st Qu.:0.2700 1st Qu.: 1.700
#> Median : 6.800 Median :0.2600 Median :0.3200 Median : 5.200
#> Mean : 6.855 Mean :0.2782 Mean :0.3342 Mean : 6.391
#> 3rd Qu.: 7.300 3rd Qu.:0.3200 3rd Qu.:0.3900 3rd Qu.: 9.900
#> Max. :14.200 Max. :1.1000 Max. :1.6600 Max. :65.800
#> chlorides free.sulfur.dioxide total.sulfur.dioxide density
#> Min. :0.00900 Min. : 2.00 Min. : 9.0 Min. :0.9871
#> 1st Qu.:0.03600 1st Qu.: 23.00 1st Qu.:108.0 1st Qu.:0.9917
#> Median :0.04300 Median : 34.00 Median :134.0 Median :0.9937
#> Mean :0.04577 Mean : 35.31 Mean :138.4 Mean :0.9940
#> 3rd Qu.:0.05000 3rd Qu.: 46.00 3rd Qu.:167.0 3rd Qu.:0.9961
#> Max. :0.34600 Max. :289.00 Max. :440.0 Max. :1.0390
#> pH sulphates alcohol
#> Min. :2.720 Min. :0.2200 Min. : 8.00
#> 1st Qu.:3.090 1st Qu.:0.4100 1st Qu.: 9.50
#> Median :3.180 Median :0.4700 Median :10.40
#> Mean :3.188 Mean :0.4898 Mean :10.51
#> 3rd Qu.:3.280 3rd Qu.:0.5500 3rd Qu.:11.40
#> Max. :3.820 Max. :1.0800 Max. :14.20apakah perlu untuk discaling? perlu.
wine_pca <- PCA(X = wine,
scale.unit = T, #scaling dengan parameter ini
graph = F,
ncp = 5)
head(wine_pca$ind$coord)#> Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
#> 1 3.6769435 -0.54523329 -0.930421883 -1.1353743 -0.2928548
#> 2 -0.6445878 0.43076995 -0.356330699 0.9991166 -0.7140777
#> 3 0.1552905 -1.18979993 -0.017531523 0.2702195 -0.3677059
#> 4 1.4553741 0.09968018 -0.001956385 -0.4230225 -0.4699806
#> 5 1.4553741 0.09968018 -0.001956385 -0.4230225 -0.4699806
#> 6 0.1552905 -1.18979993 -0.017531523 0.2702195 -0.3677059model PCA sudah terbentuk. sekarang kita akan menghapus outlier terluar yang ada dalam model PCA
plot.PCA(x = wine_pca,
axes = c(1,2),
choix = "ind",
invisible = "quali",
select = "contrib5",
habillage = 6)
dalam plot diatas, kita bisa melihat 5 outlier terluar yaitu 1654, 1664, 2335, 2782 dan 4746. tapi kita hanya akan menghapus outlier 2782 dan 4746 karena outlier lainnya masih berdekatan dengan data lainnya.
plot.PCA(x = wine_pca,
axes = c(1,2),
choix = "var")
plot diatas menunjukan korelasi variable awal dengan tiap pc. Untuk lebih jelas dan objektif, kontribusi/korelasi tiap variable ke tiap PC dapat dilihat menggunakan dimdesc(). Semakin tinggi nilai korelasi, semakin banyak informasi yang dirangkum pada PC tersebut.
dim <- dimdesc(res = wine_pca)# variable yang berkontribusi untuk PC1
as.data.frame(dim$Dim.1$quanti)# coba mandiri: variable yang berkontribusi untuk PC2
as.data.frame(dim$Dim.2$quanti)outlier <- c(2782, 4746)Sekarang kita dapat membuang observasi outlier dari data awal dan menyimpannya ke objek wine_normal untuk digunakan pada clustering.
wine_normal <- wine[-outlier,]sekarang kita ingin melihat berapa jumlah PC yang akan diambil. kita akan mengambil PC yang mempertahankan 80% total informasi
wine_pca$eig#> eigenvalue percentage of variance cumulative percentage of variance
#> comp 1 3.22225389 29.293217 29.29322
#> comp 2 1.57523993 14.320363 43.61358
#> comp 3 1.22167134 11.106103 54.71968
#> comp 4 1.01852235 9.259294 63.97898
#> comp 5 0.97333458 8.848496 72.82747
#> comp 6 0.93874151 8.534014 81.36149
#> comp 7 0.72659802 6.605437 87.96692
#> comp 8 0.59935848 5.448713 93.41564
#> comp 9 0.41414367 3.764942 97.18058
#> comp 10 0.28948714 2.631701 99.81228
#> comp 11 0.02064909 0.187719 100.00000untuk melihat total persen data dalam model PCA. kita perlu melihat bagian cumulative percentage of variance karena kita ingin mengambil PC dengan 80% total Informasi maka kita akan mengambil PC 1 sampai 6 dimana total yang didapat adalah 81.3%
4 Clustering
Kita sudah membuat model PCA dan mendapat informasi berapa PC yang akan kita pakai.
selanjutnya kita akan melakukan proses clustering yang mengelompokan data menjadi kategori.
data yang akan digunakan adalah wine_normal yang sudah kita buang data outlier terluarnya.
head(wine_normal)untuk data wine_normal belum discaling. maka kita akan melakukan scaling pada data wine_normal dengan function scale()
wine_scale <- scale(wine_normal)4.1 Pemilihan K optimum
RNGkind(sample.kind = "Rounding")
kmeansTunning <- function(data, maxK) {
withinall <- NULL
total_k <- NULL
for (i in 2:maxK) {
set.seed(101)
temp <- kmeans(data,i)$tot.withinss
withinall <- append(withinall, temp)
total_k <- append(total_k,i)
}
plot(x = total_k, y = withinall, type = "o", xlab = "Number of Cluster", ylab = "Total within")
}
# kmeansTunning(your_data, maxK = 10)
kmeansTunning(wine_scale, maxK = 10)
untuk memilih k yang optimum, kita dapat melihat kelandaian (steep) garis dalam plot. jika garis sudah tidak terlalu landai maka disanalah k optimum yang akan kita plih. disini kita akan memilih K optimum = 6.
RNGkind(sample.kind = "Rounding")
set.seed(101)
wine_kmeans <- kmeans(wine_scale, centers = 6)disini kita sudah membuat model kmeans dengan k yang kita pilih yaitu 6.
4.2 Cluster profile
sekarang kita akan mengelompokan data sesuai dengan pola
# kembalikan hasil cluster ke data awal
wine_normal$cluster <- wine_kmeans$cluster
# profiling
wine_normal %>%
group_by(cluster) %>%
summarise_all(mean)dan kita sudah mendapat pola dari data. sekarang kita bisa melihat wine apa saja yang termasuk pada setiap cluster dengan cara
#for reference
#wine_normal %>% filter (cluster == 3) cluster bisa diganti dengan cluster yang diinginkan.5 Summary
dengan data wine quality selection yang kita peroleh dari kaggle. 1. kita bisa mendapatkan 6 kategori yang memiliki ciri khas tersendiri. 2. kita juga mendapatkan PC sebanyak 6 yang berisikan 81,3% dari total data. 3. kita bisa membuat model kmeans clustering dengan data set ini.
report ini adalah sebuah contoh pemakaian unsupervised learning. walaupun pada awal data terasa acak tapi dengan metode ini, kita bisa mendapatkan pola dan mengolompokan Wine menjadi 6 kategori.
dengan ini saya mengakhir report LBB yang saya buat. semoga report ini membawa manfaat kepada yang lain. Terima kasih