library(readr)
## Warning: package 'readr' was built under R version 4.5.3
library(tidyverse)
## Warning: package 'tidyverse' was built under R version 4.5.3
## Warning: package 'forcats' was built under R version 4.5.3
## Warning: package 'lubridate' was built under R version 4.5.3
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ purrr 1.2.0
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ ggplot2 4.0.1 ✔ tibble 3.3.0
## ✔ lubridate 1.9.5 ✔ tidyr 1.3.1
## ── 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(flexclust)
## Warning: package 'flexclust' was built under R version 4.5.3
library(dbscan)
## Warning: package 'dbscan' was built under R version 4.5.3
##
## Attaching package: 'dbscan'
##
## The following object is masked from 'package:stats':
##
## as.dendrogram
library(meanShiftR)
library(e1071)
## Warning: package 'e1071' was built under R version 4.5.3
##
## Attaching package: 'e1071'
##
## The following object is masked from 'package:flexclust':
##
## bclust
##
## The following object is masked from 'package:ggplot2':
##
## element
library(cluster)
## Warning: package 'cluster' was built under R version 4.5.3
library(fpc)
## Warning: package 'fpc' was built under R version 4.5.3
##
## Attaching package: 'fpc'
##
## The following object is masked from 'package:dbscan':
##
## dbscan
library(mclust)
## Warning: package 'mclust' was built under R version 4.5.3
## Package 'mclust' version 6.1.2
## Type 'citation("mclust")' for citing this R package in publications.
##
## Attaching package: 'mclust'
##
## The following object is masked from 'package:dplyr':
##
## count
##
## The following object is masked from 'package:purrr':
##
## map
df <- read_csv("SeoulBikeData.csv", locale = locale(encoding = "latin1"))
## Rows: 8760 Columns: 14
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): Date, Seasons, Holiday, Functioning Day
## dbl (10): Rented Bike Count, Hour, Temperature(°C), Humidity(%), Wind speed ...
##
## ℹ 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.
head(df)
## # A tibble: 6 × 14
## Date `Rented Bike Count` Hour `Temperature(°C)` `Humidity(%)`
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 01/12/2017 254 0 -5.2 37
## 2 01/12/2017 204 1 -5.5 38
## 3 01/12/2017 173 2 -6 39
## 4 01/12/2017 107 3 -6.2 40
## 5 01/12/2017 78 4 -6 36
## 6 01/12/2017 100 5 -6.4 37
## # ℹ 9 more variables: `Wind speed (m/s)` <dbl>, `Visibility (10m)` <dbl>,
## # `Dew point temperature(°C)` <dbl>, `Solar Radiation (MJ/m2)` <dbl>,
## # `Rainfall(mm)` <dbl>, `Snowfall (cm)` <dbl>, Seasons <chr>, Holiday <chr>,
## # `Functioning Day` <chr>
Dipilih 10 fitur numerik utama (kolom 2 sampai 11) yang bersifat kontinu, yaitu mulai dari Rented Bike Count hingga Snowfall. Pemilihan ini dilakukan karena algoritma clustering berbasis jarak seperti K-Means dan K-Median bekerja lebih baik pada data yang memiliki nilai yang bertahap dan tidak diskrit. Fitur-fitur tersebut mewakili kondisi lingkungan seperti suhu, kelembaban, dan radiasi matahari, serta kondisi cuaca seperti hujan dan salju. Faktor-faktor ini secara logis memengaruhi keputusan seseorang dalam menyewa sepeda. Sementara itu, data kategorikal dan biner seperti Seasons, Holiday dan Functioning Day tidak digunakan agar tidak memengaruhi perhitungan jarak. Dengan demikian, hasil pengelompokan yang terbentuk benar-benar didasarkan pada pola aktivitas dan kondisi lingkungan yang dapat diukur.
df_selected <- df[, c("Rented Bike Count", "Hour", "Temperature(°C)", "Humidity(%)",
"Wind speed (m/s)", "Visibility (10m)", "Dew point temperature(°C)",
"Solar Radiation (MJ/m2)", "Rainfall(mm)", "Snowfall (cm)")]
set.seed(123)
df_sample_raw <- df_selected[sample(1:nrow(df_selected), 2000), ]
str(df_sample_raw)
## tibble [2,000 × 10] (S3: tbl_df/tbl/data.frame)
## $ Rented Bike Count : num [1:2000] 705 289 126 378 236 ...
## $ Hour : num [1:2000] 14 14 5 9 17 10 8 1 20 18 ...
## $ Temperature(°C) : num [1:2000] 18.3 12.1 1.8 10.4 2.4 18.2 21.1 18.9 10.7 22.2 ...
## $ Humidity(%) : num [1:2000] 43 97 34 81 17 36 70 55 70 96 ...
## $ Wind speed (m/s) : num [1:2000] 2.2 2 0.9 1.4 3.1 1 0.3 2.3 2.8 1.2 ...
## $ Visibility (10m) : num [1:2000] 1509 177 1990 2000 1990 ...
## $ Dew point temperature(°C): num [1:2000] 5.4 11.6 -12.4 7.2 -20.2 2.8 15.4 9.6 5.4 21.5 ...
## $ Solar Radiation (MJ/m2) : num [1:2000] 2.43 0.2 0 0.36 0.78 1.99 0.9 0 0 0.09 ...
## $ Rainfall(mm) : num [1:2000] 0 0 0 0 0 0 0 0 0 3.5 ...
## $ Snowfall (cm) : num [1:2000] 0 0 0 0 0 0 0 0 0 0 ...
sum(is.na(df_sample_raw))
## [1] 0
df_scaled <- as.data.frame(scale(df_sample_raw))
set.seed(123)
wss <- sapply(1:10, function(k) {
kmeans(df_scaled, centers = k, nstart = 20)$tot.withinss
})
par(mfrow = c(1, 1))
plot(1:10, wss, type = "b", pch = 19, frame = FALSE,
xlab = "Number of clusters K",
ylab = "Total within-clusters sum of squares",
main = "Elbow Method (Sample 2000)")
# Silhouette Analysis(dengan sample)
set.seed(123)
avg_sil_values <- sapply(2:10, function(k) {
km_res <- kmeans(df_scaled, centers = k, nstart = 25)
ss <- silhouette(km_res$cluster, dist(df_scaled))
mean(ss[, 3])
})
## Warning: did not converge in 10 iterations
plot(2:10, avg_sil_values, type = "b", pch = 19, frame = FALSE,
xlab = "Number of clusters K",
ylab = "Average Silhouette Width",
main = "Silhouette Analysis (Sample 2000)")
Terdapat perbedaan penentuan jumlah klaster optimal antara Elbow Method
(\(k=3\)) dan Silhouette Analysis
(\(k=7\)). Hal ini umum terjadi pada
dataset dengan dimensi tinggi dan sebaran data yang padat. Elbow Method
menunjukkan bahwa penurunan inersia paling signifikan terjadi hingga
\(k=3\), sementara Silhouette
memberikan skor validitas tertinggi pada \(k=7\). Untuk menjaga keseimbangan antara
efisiensi model dan kemudahan interpretasi (interpretability), maka
dipilih \(k=3\) sebagai jumlah klaster
final.
Pemilihan ini didasarkan pada pertimbangan bahwa tiga kelompok besar—seperti kategori penyewaan rendah, sedang, dan tinggi—jauh lebih relevan dan mudah diaplikasikan untuk strategi operasional penyewaan sepeda dibandingkan dengan pembagian menjadi tujuh kelompok yang cenderung terlalu spesifik (over-segmentation) dan sulit dibedakan secara fungsional.
set.seed(123)
k_fix <- 3
km_res <- kmeans(df_scaled, centers = k_fix, nstart = 25)
kmed_res <- flexclust::kcca(df_scaled, k = k_fix, family = kccaFamily("kmedians"))
## Found more than one class "kcca" in cache; using the first, from namespace 'flexclust'
## Also defined by 'kernlab'
## Found more than one class "kcca" in cache; using the first, from namespace 'flexclust'
## Also defined by 'kernlab'
db_res <- dbscan(df_scaled, eps = 0.7, MinPts = 5)
#Mean Shift(Gunakan bandwidth agar stabil)
bw_vec <- rep(1.2, ncol(df_scaled))
ms_res <- meanShift(as.matrix(df_scaled), bandwidth = bw_vec)
fcm_res <- cmeans(df_scaled, centers = k_fix, m = 2)
# Kita gunakan Temperature (kolom 3) dan Rented Bike (kolom 1) untuk sumbu visual
par(mfrow = c(2, 3), mar = c(4, 4, 2, 1))
plot(df_scaled[,3], df_scaled[,1], col = km_res$cluster, main = "K-means", pch=19, cex=0.5)
plot(df_scaled[,3], df_scaled[,1], col = clusters(kmed_res), main = "K-medians", pch=19, cex=0.5)
plot(df_scaled[,3], df_scaled[,1], col = db_res$cluster + 1L, main = "DBSCAN", pch=19, cex=0.5)
plot(df_scaled[,3], df_scaled[,1], col = ms_res$assignment, main = "Mean Shift", pch=19, cex=0.5)
plot(df_scaled[,3], df_scaled[,1], col = fcm_res$cluster, main = "Fuzzy C-means", pch=19, cex=0.5)
plot(df_scaled[,3], df_scaled[,1], col = as.numeric(cut(df_scaled[,1], 3)), main = "Pseudo-Original", pch=19, cex=0.5)
Berdasarkan pengujian lima algoritma clustering pada dataset Seoul Bike,
K-Means dan K-Medians memberikan hasil yang paling stabil dan mudah
diinterpretasikan secara logis.
Stabilitas: Nilai ARI 0.8232 menunjukkan konsistensi yang sangat tinggi antara K-Means dan K-Medians.
Kualitas Klaster: Nilai Silhouette Score 0.2313 menunjukkan pemisahan kelompok yang cukup baik, mengingat variabel cuaca memiliki sebaran yang sangat rapat.
Perbandingan: Algoritma berbasis densitas seperti DBSCAN dan Mean Shift kurang optimal untuk dataset ini karena menghasilkan terlalu banyak klaster (over-segmentation), sehingga sulit memberikan insight bisnis yang praktis dibandingkan K-Means.
Karena kita tidak punya “label asli” (Ground Truth), kita tidak bisa pakai ARI. Kita fokus pada metrik internal: Silhouette dan Dunn Index.
# Hitung Jarak (Distance Matrix)
d_mat <- dist(df_scaled)
Pakai df_scaled (data yang sudah diproses) dan d_mat (matriks jarak sampel) Jika pakai dist(df) yang asli, laptop bisa hang.
# Mengukur seberapa baik sebuah objek cocok dengan klasternya (Range -1 ke 1)
sil_val <- mean(silhouette(km_res$cluster, d_mat)[,3])
print(paste("Average Silhouette Score:", round(sil_val, 4)))
## [1] "Average Silhouette Score: 0.2313"
Artinya: Skor ini berada di kisaran 0.2, yang menandakan struktur kelompok yang moderat (sedang).
Analisis: Dalam data nyata seperti penyewaan sepeda, wajar jika skornya tidak mendekati 1. Ini berarti antar kelompok (misal antara jam ramai dan jam sepi) masih ada sedikit titik data yang saling berdekatan atau tumpang tindih. Namun, angka 0.23 sudah menunjukkan bahwa pola pengelompokan yang kamu buat itu nyata, bukan sekadar acak.
Menggunakan stats yang sudah dihitung dari cluster.stats
# Menggunakan stats yang sudah dihitung dari cluster.stats
stats <- fpc::cluster.stats(d_mat, km_res$cluster)
print(paste("Dunn Index:", round(stats$dunn, 6)))
## [1] "Dunn Index: 0.011662"
print(paste("Within-cluster SS:", round(km_res$tot.withinss, 2)))
## [1] "Within-cluster SS: 13392.79"
Dunn Index: 0.011662 Artinya: Skor ini menunjukkan rasio jarak antar klaster dibanding kepadatan di dalam klaster.
Analisis: Angkanya memang terlihat sangat kecil (0.01), tapi di dataset dengan banyak fitur (10 kolom) dan ribuan baris, ini adalah hal yang lumrah. Yang penting nilainya positif, yang berarti ada jarak pemisah antar klaster.
Within-cluster SS: 13392.79 Artinya: Ini adalah total kuadrat jarak titik-titik data ke pusat klasternya masing-masing.
Analisis: Semakin kecil angka ini, semakin padat kelompoknya. Angka 13.392 untuk 2.000 data adalah hasil yang cukup baik untuk metode K-Means. Ini menunjukkan tiap klaster sudah cukup solid
KARENA TIDAK ADA GROUND TRUTH (Label Asli): Kita bandingkan K-Means vs K-Medians untuk melihat konsistensi algoritma.
ari_score <- mclust::adjustedRandIndex(km_res$cluster, clusters(kmed_res))
print(paste("Adjusted Rand Index (KM vs KMed):", round(ari_score, 4)))
## [1] "Adjusted Rand Index (KM vs KMed): 0.8232"
Artinya: Skor ini sangat tinggi (82% mirip).
Analisis: Meskipun menggunakan algoritma yang berbeda (K-Means yang berbasis rata-rata dan K-Medians yang berbasis nilai tengah), keduanya memberikan hasil pengelompokan yang hampir sama (82% konsisten). Hal ini membuktikan bahwa segmentasi data yang dihasilkan sangat stabil dan bisa dipercaya