1 Import Library

library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   4.0.0     ✔ tibble    3.2.1
## ✔ lubridate 1.9.4     ✔ tidyr     1.3.1
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(lubridate)
library(caret)
## Loading required package: lattice
## 
## Attaching package: 'caret'
## 
## The following object is masked from 'package:purrr':
## 
##     lift
library(factoextra)
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library(cluster)
library(clusterCrit)
library(readxl)
library(fpc)
library(tidyr)
library(e1071)
## 
## Attaching package: 'e1071'
## 
## The following object is masked from 'package:ggplot2':
## 
##     element
library(purrr)
library(broom)
library(ggplot2)
library(dplyr)
library(clusterSim)
## Loading required package: MASS
## 
## Attaching package: 'MASS'
## 
## The following object is masked from 'package:dplyr':
## 
##     select

2 Import Data

#import data dari csv
data_jabar <- read.csv("C:/Semester 5/TPG/TPG Mandiri.csv", header = TRUE, sep = ";")
data_jabar

2.1 Eksplorasi Data

2.1.1 Melihat Struktur Data

summary(data_jabar)
##     KabKot              Tahun         Bulan              Produk         
##  Length:2484        Min.   :2022   Length:2484        Length:2484       
##  Class :character   1st Qu.:2022   Class :character   Class :character  
##  Mode  :character   Median :2023   Mode  :character   Mode  :character  
##                     Mean   :2023                                        
##                     3rd Qu.:2024                                        
##                     Max.   :2025                                        
##      Harga         Kategori            KodeBPS         KodeProv 
##  Min.   : 9000   Length:2484        Min.   :32.01   Min.   :32  
##  1st Qu.:11500   Class :character   1st Qu.:32.07   1st Qu.:32  
##  Median :12900   Mode  :character   Median :32.14   Median :32  
##  Mean   :12790                      Mean   :32.31   Mean   :32  
##  3rd Qu.:14097                      3rd Qu.:32.73   3rd Qu.:32  
##  Max.   :17192                      Max.   :32.79   Max.   :32  
##    NamaProv        
##  Length:2484       
##  Class :character  
##  Mode  :character  
##                    
##                    
## 
str(data_jabar)
## 'data.frame':    2484 obs. of  9 variables:
##  $ KabKot  : chr  "Kab. Bandung" "Kab. Bandung" "Kab. Bandung" "Kab. Bandung" ...
##  $ Tahun   : int  2022 2022 2022 2022 2022 2022 2022 2022 2022 2022 ...
##  $ Bulan   : chr  "Januari" "Januari" "Februari" "Februari" ...
##  $ Produk  : chr  "Beras Premium" "Beras Medium" "Beras Premium" "Beras Medium" ...
##  $ Harga   : int  12000 10700 11852 10574 12000 10966 12000 11000 12000 10927 ...
##  $ Kategori: chr  "Beras" "Beras" "Beras" "Beras" ...
##  $ KodeBPS : num  32 32 32 32 32 ...
##  $ KodeProv: int  32 32 32 32 32 32 32 32 32 32 ...
##  $ NamaProv: chr  "Jawa Barat" "Jawa Barat" "Jawa Barat" "Jawa Barat" ...
data_jabar$Harga <- as.numeric(data_jabar$Harga)
summary(data_jabar$Harga)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    9000   11500   12900   12790   14097   17192

Pada summary data diatas, tidak ditemukan adanya missing value (NA) pada variabel Harga.

data_clean <- na.omit(data_jabar)
data_clean
length(data_clean$KabKot)
## [1] 2484

2.1.2 Preprocessing Data

data_clean$Harga <- as.numeric(data_clean$Harga)
# Konversi variabel kategorikal menjadi faktor
data_clean$Produk <- as.factor(data_clean$Produk)
data_clean$Bulan <- as.factor(data_clean$Bulan)
data_clean$Kategori <- as.factor(data_clean$Kategori)
data_clean$KabKot <- as.factor(data_clean$KabKot)
data_clean$NamaProv <- as.factor(data_clean$NamaProv)
# Standarisasi data 
# Normalisasi data Harga, Beras Premium dan Beras Medium
data_scaled <- scale(data_clean[, c("Harga")])
head(data_scaled)
##            [,1]
## [1,] -0.4657142
## [2,] -1.2322192
## [3,] -0.5529779
## [4,] -1.3065112
## [5,] -0.4657142
## [6,] -1.0753805

3 K-Means Clustering

library(factoextra)
library(dplyr)
library(tidyr)
library(scales)
## Warning: package 'scales' was built under R version 4.4.3
## 
## Attaching package: 'scales'
## The following object is masked from 'package:purrr':
## 
##     discard
## The following object is masked from 'package:readr':
## 
##     col_factor
library(RColorBrewer)

3.1 Elbow Method

fviz_nbclust(data_scaled, kmeans, method = "wss") +
  labs(title = "Elbow Method for Optimal k")
## Warning: The `size` argument of `element_line()` is deprecated as of ggplot2 3.4.0.
## ℹ Please use the `linewidth` argument instead.
## ℹ The deprecated feature was likely used in the ggpubr package.
##   Please report the issue at <https://github.com/kassambara/ggpubr/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## Warning: The `size` argument of `element_rect()` is deprecated as of ggplot2 3.4.0.
## ℹ Please use the `linewidth` argument instead.
## ℹ The deprecated feature was likely used in the ggpubr package.
##   Please report the issue at <https://github.com/kassambara/ggpubr/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## ℹ The deprecated feature was likely used in the ggpubr package.
##   Please report the issue at <https://github.com/kassambara/ggpubr/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

3.2 Silhouette Method

fviz_nbclust(data_scaled, kmeans, method = "silhouette") +
  labs(title = "Silhouette Method for Optimal k")

Berdasarkan kedua metode tersebut, k = 3 adalah jumlah cluster optimal yang dapat digunakan. Metode Elbow menunjukkan penurunan yang tajam pada k = 2, dan metode Silhouette menunjukkan nilai kualitas cluster yang sangat baik pada k = 3. Oleh karena itu, kita dapat melanjutkan analisis clustering dengan memilih k = 3 sebagai jumlah cluster optimal untuk K-Means Clustering atau metode clustering lainnya.

set.seed(123)  # Untuk reprodusibilitas
kmeans_result <- kmeans(data_scaled, centers = 3, nstart = 25)
table(kmeans_result$cluster)
## 
##    1    2    3 
##  803  672 1009
data_clean$KMeans_Cluster <- kmeans_result$cluster

3.3 Evaluasi Hasil K-Means Clustering

3.3.1 Silhouette Score

Silhouette Score mengukur seberapa baik titik data berada dalam cluster yang benar. Nilai Silhouette Score yang lebih tinggi menunjukkan pemisahan cluster yang lebih baik.

# Evaluasi K-Means Clustering menggunakan Silhouette Score
silhouette_values_kmeans <- silhouette(kmeans_result$cluster, dist(data_scaled))
avg_silhouette_kmeans <- mean(silhouette_values_kmeans[, 3])
cat("Average Silhouette Score (K-Means):", avg_silhouette_kmeans, "\n")
## Average Silhouette Score (K-Means): 0.5859955

Nilai 0.585988 menunjukkan bahwa cluster yang dihasilkan oleh K-Means memiliki pemisahan yang cukup baik, namun dengan nilai Silhouette yang belum mendekati 0.7, yang mengindikasikan bahwa sebagian besar titik data berada dalam cluster yang belum sesuai.

3.3.2 Plot Silhouette

# Plot Silhouette dengan ukuran lebih besar dan detail
plot(silhouette_values_kmeans, main = "Silhouette Plot for K-Means Clustering", col = 2:5, border = NA, cex.axis = 0.8)

3.3.3 Dunn Index

dunn_index_kmeans <- intCriteria(
  as.matrix(data_scaled),             
  as.integer(kmeans_result$cluster),   
  c("Dunn")
)$dunn
cat("Dunn Index (K-Means):", dunn_index_kmeans, "\n")
## Dunn Index (K-Means): 0.002871913

3.3.4 Calinski-Harabasz Index

Calinski-Harabasz Index mengukur kualitas clustering berdasarkan pemisahan antar cluster dan variasi dalam cluster. Semakin tinggi nilai Calinski-Harabasz, semakin baik kualitas cluster tersebut.

calinski_harabasz_kmeans <- cluster.stats(dist(data_scaled), kmeans_result$cluster)$ch
cat("Calinski-Harabasz Index (K-Means):", calinski_harabasz_kmeans, "\n")
## Calinski-Harabasz Index (K-Means): 7875.805

3.4 Visualisasi hasil K-Means Clustering

library(ggplot2)
ggplot(data_clean, aes(x = Harga, y = as.factor(KMeans_Cluster), color = Produk)) +
  geom_point() +
  labs(title = "K-Means Clustering dengan Jenis Beras", x = "Harga", y = "Cluster")

Plot K-Means Clustering dengan Jenis Beras menunjukkan bahwa clustering berhasil memisahkan produk berdasarkan harga. Beras Premium terkelompok di Cluster 1 dan Cluster 3, dengan harga lebih tinggi dibandingkan Beras Medium, yang lebih dominan di Cluster 2 dan sebagian di Cluster 3. Cluster 2 berisi produk dengan harga lebih rendah, baik untuk Beras Premium maupun Beras Medium, sementara Cluster 3 dan Cluster 1 menunjukkan produk dengan harga yang lebih tinggi, dengan Beras Premium lebih banyak berada di Cluster 1. Hasil clustering ini memperlihatkan pola harga yang jelas antara kedua jenis beras. Namun hasil clustering masih kurang optimal karena beberapa produk dari kedua jenis beras masih tercampur dalam cluster yang sama.

4 Fuzzy C-Means Clustering

# Melakukan clustering Fuzzy C-Means (misalnya 4 cluster)
fcm_model <- cmeans(data_scaled, centers = 3, iter.max = 1000, m = 2)

# Menambahkan hasil clustering Fuzzy C-Means ke dalam data
data_clean$FCM_Cluster <- apply(fcm_model$membership, 1, which.max)
table(data_clean$FCM_Cluster)
## 
##    1    2    3 
##  672  793 1019

4.1 Evaluasi Hasil Fuzzy C-Means Clustering

4.1.1 Silhouette Score

silhouette_values_fcm <- silhouette(data_clean$FCM_Cluster, dist(data_scaled))
avg_silhouette_fcm <- mean(silhouette_values_fcm[, 3])
cat("Average Silhouette Score (Fuzzy C-Means):", avg_silhouette_fcm, "\n")
## Average Silhouette Score (Fuzzy C-Means): 0.5855099

Nilai 0.5855099 menunjukkan bahwa cluster yang dihasilkan oleh K-Means memiliki pemisahan yang cukup baik, namun dengan nilai Silhouette yang belum mendekati 0.7, yang mengindikasikan bahwa sebagian besar titik data berada dalam cluster yang belum sesuai.

4.1.2 Plot Silhouette

plot(silhouette_values_fcm, main = "Silhouette Plot for Fuzzy C-Means Clustering", col = 2:5, border = NA, cex.axis = 0.8)

4.1.3 Dunn Index

Dunn Index mengukur pemisahan antar cluster dan kepadatan cluster. Semakin tinggi nilai Dunn Index, semakin baik pemisahan antar cluster dan semakin padat cluster tersebut.

dunn_index_fcm <- intCriteria(
  as.matrix(data_scaled),  
  as.integer(fcm_model$cluster), 
  c("Dunn")  
)$dunn

cat("Dunn Index (Fuzzy C-Means):", dunn_index_fcm, "\n")
## Dunn Index (Fuzzy C-Means): 0.002620087

4.1.4 Calinski-Harabasz Index

calinski_harabasz_fcm <- cluster.stats(dist(data_scaled), fcm_model$cluster)$ch
cat("Calinski-Harabasz Index (Fuzzy C-Means):", calinski_harabasz_fcm, "\n")
## Calinski-Harabasz Index (Fuzzy C-Means): 7869.202

4.2 Visualisasi Hasil Fuzzy C-Means Clustering

# Visualisasi hasil clustering berdasarkan Harga dan Cluster
ggplot(data_clean, aes(x = Harga, y = as.factor(FCM_Cluster), color = Produk)) +
  geom_point() +
  labs(title = "Fuzzy C-Means Clustering dengan Harga dan Produk", x = "Harga", y = "Cluster") +
  scale_color_brewer(palette = "Set1") +  # Menambahkan palet warna
  theme_minimal()

Plot ini menunjukkan bahwa Fuzzy C-Means clustering dapat memisahkan produk berdasarkan harga, di mana Beras Premium lebih sering berada di cluster 3 dengan harga lebih tinggi dan Beras Medium lebih sering berada di cluster 1 dengan harga lebih rendah. Hal ini memberikan wawasan tentang bagaimana harga berperan dalam pemisahan produk yang berbeda, dan dapat digunakan untuk strategi pemasaran atau analisis harga lebih lanjut. Namun hasil clustering masih kurang optimal karena beberapa produk dari kedua jenis beras masih tercampur dalam cluster yang sama.

5 Perbandingan K-Means dan Fuzzy C-Means

comparison_table <- data.frame(
  Method = c("K-Means", "Fuzzy C-Means"),
  Dunn_Index = c(dunn_index_kmeans, dunn_index_fcm),
  Calinski_Harabasz_Index = c(calinski_harabasz_kmeans, calinski_harabasz_fcm),
  Silhouette_Score = c(avg_silhouette_kmeans, avg_silhouette_fcm)
)

# Menampilkan tabel perbandingan
print(comparison_table)
##          Method  Dunn_Index Calinski_Harabasz_Index Silhouette_Score
## 1       K-Means 0.002871913                7875.805        0.5859955
## 2 Fuzzy C-Means 0.002620087                7869.202        0.5855099

Berdasarkan perbandingan K-Means dan Fuzzy C-Means menggunakan Dunn Index, Calinski-Harabasz Index, dan Silhouette Score, keduanya menghasilkan hasil yang sangat mirip. Meskipun K-Means sedikit lebih unggul dalam hal Dunn Index dan Calinski-Harabasz Index, perbedaannya tidak signifikan, menunjukkan bahwa kedua metode memiliki pemisahan cluster dan kualitas clustering yang hampir sama. Silhouette Score untuk kedua metode juga hampir identik, menandakan pemisahan cluster yang baik di kedua model. Secara keseluruhan, K-Means sedikit lebih baik dalam pemisahan cluster dan kualitas clustering, namun perbedaan antara kedua metode ini sangat kecil.

6 Kesimpulan dan Saran

Kesimpulan

  1. K-Means lebih unggul sedikit dalam hal pemisahan dan kepadatan cluster (Dunn Index) serta kualitas cluster yang terbentuk (Calinski-Harabasz Index). Hal ini bisa menunjukkan bahwa K-Means lebih baik dalam menciptakan cluster yang terpisah dengan jelas di antara satu sama lain.

  2. Kedua metode menghasilkan kualitas clustering yang hampir sama, seperti yang terlihat dari nilai Silhouette Score yang sangat mirip. Ini berarti kedua metode hampir sama dalam hal keseragaman dan pemisahan antar cluster, meskipun K-Means sedikit lebih baik.

  3. Rekomendasi untuk penggunaan metode: - K-Means bisa lebih disarankan apabila menginginkan clustering dengan pemisahan yang lebih baik antar cluster dan varians yang lebih terstruktur. - Fuzzy C-Means bisa lebih sesuai jika ingin mempertahankan keanggotaan fuzzy atau fleksibilitas dalam pembagian data antara cluster. Ini sangat berguna ketika data memiliki ambiguitas atau tidak jelas dalam hal pembagian antar cluster.

Saran

  1. Analisis lebih mendalam terhadap cluster: Untuk memvalidasi hasil clustering, dapat dilakukan analisis lebih mendalam terhadap masing-masing cluster yang dihasilkan, termasuk perbandingan dengan variabel lain seperti tahun atau wilayah.

  2. Pertimbangkan faktor eksternal: Jika memungkinkan, dapat mempertimbangkan faktor eksternal yang dapat memengaruhi harga beras, seperti cuaca atau kebijakan ekonomi, untuk melihat apakah cluster yang terbentuk terkait dengan faktor-faktor tersebut.