Đề xuất bởi J.MacQueen:
Some Methods for Classification and analysis of multivariate observations - J. MacQueen (1967).
Link: https://www.cs.cmu.edu/~bhiksha/courses/mlsp.fall2010/class14/macqueen.pdf
Ý tưởng chính của Cluster Analysis: Chia dữ liệu vào các cluster và các item tương tự được nhóm vào cùng một cluster, mục đích khám phá hơn là tiên lượng/ tiên đoán (discovery rather than prediction)
Lợi ích của phân tích cụm rất nhiều, ví dụ như: Phân nhóm khách hàng vào các nhóm (quan tâm vấn đề lịch sử mua hàng số tiền, số lần, giới tính, độ tuổi, trung bình giữa các hóa đơn, …), phân loại các mẫu thời tiết khác nhau cho một vùng, nhóm các bài viết/ tin tức vào các chủ đề, khám phá các điểm nóng tội phạm, …
Trong bài viết này mình chủ yếu thực hành các bước phân tích cụm sử dụng thuật toán K-Means và các phương pháp để tìm K ‘nhóm’ tối ưu, tuy nói K tối ưu nhưng trong thực tế việc tìm K rất khó và luôn mang ý nghĩa chủ quan, vì vậy việc tìm K luôn được cân nhắc bằng cách chọn thủ công theo ý quyết định của người muốn phân bao nhiêu nhóm.
Data lấy từ Kaggle có tên Real estate price prediction. Link data: https://www.kaggle.com/quantbruce/real-estate-price-prediction?select=Real+estate.csv
Để tiến hành thực hiện đầu tiên cần Tải các thư viện cần thiết để tiến hành phân tích cụm
library(tidyverse)
library(dplyr)
library(factoextra)
library(NbClust)
library(cluster)
library(skimr)
library(table1)
library(explore)
library(ggplot2)
library(psych)
library(broom)
library(DataExplorer)df <- read.csv("C:/Users/KH/Google Drive/Data Sample/Real estate.csv")skim(df)| Name | df |
| Number of rows | 414 |
| Number of columns | 8 |
| _______________________ | |
| Column type frequency: | |
| numeric | 8 |
| ________________________ | |
| Group variables | None |
Data summary
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| No | 0 | 1 | 207.50 | 119.66 | 1.00 | 104.25 | 207.50 | 310.75 | 414.00 | ▇▇▇▇▇ |
| X1.transaction.date | 0 | 1 | 2013.15 | 0.28 | 2012.67 | 2012.92 | 2013.17 | 2013.42 | 2013.58 | ▆▅▅▃▇ |
| X2.house.age | 0 | 1 | 17.71 | 11.39 | 0.00 | 9.03 | 16.10 | 28.15 | 43.80 | ▆▇▃▅▂ |
| X3.distance.to.the.nearest.MRT.station | 0 | 1 | 1083.89 | 1262.11 | 23.38 | 289.32 | 492.23 | 1454.28 | 6488.02 | ▇▂▁▁▁ |
| X4.number.of.convenience.stores | 0 | 1 | 4.09 | 2.95 | 0.00 | 1.00 | 4.00 | 6.00 | 10.00 | ▇▅▆▃▂ |
| X5.latitude | 0 | 1 | 24.97 | 0.01 | 24.93 | 24.96 | 24.97 | 24.98 | 25.01 | ▁▅▇▂▁ |
| X6.longitude | 0 | 1 | 121.53 | 0.02 | 121.47 | 121.53 | 121.54 | 121.54 | 121.57 | ▁▁▂▇▁ |
| Y.house.price.of.unit.area | 0 | 1 | 37.98 | 13.61 | 7.60 | 27.70 | 38.45 | 46.60 | 117.50 | ▅▇▂▁▁ |
Để làm gọn tên các biến số mình dùng hàm rename trong package ‘dplyr’, quy ước chung: No: Loại bỏ, X1: Transaction Date, X2: House Age, X3: Distance to the nearest MRT Station, X4: Number of Convenience Stores, X5: Latitude, X6: Longitude, Y: House Price of Unit Area
df <- df[-c(1, 9)]
df <- rename(df,
X1 = X1.transaction.date,
X2 = X2.house.age,
X3 = X3.distance.to.the.nearest.MRT.station,
X4 = X4.number.of.convenience.stores,
X5 = X5.latitude,
X6 = X6.longitude,
Y = Y.house.price.of.unit.area)
head(df)## X1 X2 X3 X4 X5 X6 Y
## 1 2012.917 32.0 84.87882 10 24.98298 121.5402 37.9
## 2 2012.917 19.5 306.59470 9 24.98034 121.5395 42.2
## 3 2013.583 13.3 561.98450 5 24.98746 121.5439 47.3
## 4 2013.500 13.3 561.98450 5 24.98746 121.5439 54.8
## 5 2012.833 5.0 390.56840 5 24.97937 121.5425 43.1
## 6 2012.667 7.1 2175.03000 3 24.96305 121.5125 32.1summary(df)## X1 X2 X3 X4
## Min. :2013 Min. : 0.000 Min. : 23.38 Min. : 0.000
## 1st Qu.:2013 1st Qu.: 9.025 1st Qu.: 289.32 1st Qu.: 1.000
## Median :2013 Median :16.100 Median : 492.23 Median : 4.000
## Mean :2013 Mean :17.713 Mean :1083.89 Mean : 4.094
## 3rd Qu.:2013 3rd Qu.:28.150 3rd Qu.:1454.28 3rd Qu.: 6.000
## Max. :2014 Max. :43.800 Max. :6488.02 Max. :10.000
## X5 X6 Y
## Min. :24.93 Min. :121.5 Min. : 7.60
## 1st Qu.:24.96 1st Qu.:121.5 1st Qu.: 27.70
## Median :24.97 Median :121.5 Median : 38.45
## Mean :24.97 Mean :121.5 Mean : 37.98
## 3rd Qu.:24.98 3rd Qu.:121.5 3rd Qu.: 46.60
## Max. :25.01 Max. :121.6 Max. :117.50geometric.mean(df$Y) #Khảo sát bằng trung bình nhân ## [1] 35.3994Khảo sát phân bố dữ liệu của đơn giá bán
df %>% explore(Y,
color="#333333",
title = "Distribution of House price of unit area",
auto_scale = TRUE)
Khảo sát toàn bộ phân bố dữ liệu của các biến qua histogram
plot_histogram(df)
Khảo sát giá bán trung bình của BĐS theo phân nhóm các tiện ích, ở đây trung bình về đơn giá bán có xu hướng tăng theo nhóm tiện ích, càng nhiều tiện ích giá trị cộng hưởng cho giá bán càng tăng cao.
group_mean_X4 <- aggregate(df$Y,
list(df$X4),
mean)
colnames(group_mean_X4) <- c("Number of convenience stores", "Mean of Y")
group_mean_X4 %>%
ggplot(aes(x = `Number of convenience stores`, y = `Mean of Y`)) +
geom_line(color="#333333") +
ggtitle("Number of convenience stores via Mean of Y") +
theme_minimal()
Biểu đồ dưới đây cho thấy mối quan hệ giữa đơn giá giao dịch và khoảng cách các BĐS giao dịch này xa/ gần MRT station. Khoảng cách càng xa MRT station giá càng có xu hướng thấp hơn.
df %>% ggplot(aes(X3, Y)) +
geom_point(color="#333333") +
ggtitle("House price of unit area via distance to the nearest MRT station ") +
theme_minimal()
Khảo sát tương quan giữa các biến
plot_correlation(df)
Đầu tiên,tính chỉ số Hopkins xem xét về khả năng phân nhóm của dữ liệu, cũng như vẽ ma trận khoảng cách (matrix distance), chỉ số hopskin có giá trị trong khoảng [-1,1], chỉ số càng hướng về 1 biểu thị khả năng tập dữ liệu có khả năng phân nhóm.
set.seed(123)
df_ct <- get_clust_tendency(df,
n=50,
graph=T)
df_ct$hopkins## [1] 0.9372092print(df_ct$plot)
Chọn K sử dụng Elbow Method và đối chiếu với Gap Statistic Method:
#Elbow method
fviz_nbclust(df,
kmeans, # Sử dụng thuật toán K-Means
method='wss') +
labs(subtitle = "Elbow method")
#Gap Statistic method
fviz_nbclust(df,
kmeans,
nstart = 35,
method = 'gap_stat',
nboot = 50) +
labs(subtitle = "Gap statistic method")
Ta thử tiến hành phân tích cluster qua K-Means Alg với center = 3, tức là chọn k = 3 cụm.
df_clust <- kmeans(df,
centers = 3,
nstart = 35)
summary(df_clust)## Length Class Mode
## cluster 414 -none- numeric
## centers 21 -none- numeric
## totss 1 -none- numeric
## withinss 3 -none- numeric
## tot.withinss 1 -none- numeric
## betweenss 1 -none- numeric
## size 3 -none- numeric
## iter 1 -none- numeric
## ifault 1 -none- numericfviz_cluster(df_clust,
df,
palette = c("#2E9FDF", "#00AFBB", "#E7B800"),
geom = "point",
ellipse.type = "convex",
ggtheme = theme_bw())
tidy(df_clust) #Trích xuất nội dung các tham số trong df_clust thành dataframe, hàm tidy trong package broom ## # A tibble: 3 x 10
## X1 X2 X3 X4 X5 X6 Y size withinss cluster
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int> <dbl> <fct>
## 1 2013. 19.5 4296. 0.220 24.9 122. 20.2 41 24403788. 1
## 2 2013. 18.3 386. 5.32 25.0 122. 44.3 280 14322405. 2
## 3 2013. 15.2 1768. 2.10 25.0 122. 26.7 93 16392660. 3Khả năng của hàm augment() trong package broom cho phép ta chồng 1 dataframe lên dataframe gốc, từ đó ta có thể tạo các vụ khác 1 cách dễ dàng trên dataframe đã có
augment(df_clust, df) %>%
ggplot(aes(X3,
Y,
color =.cluster)) +
geom_point(alpha = 2) +
ggtitle("Clustering: House price of unit area via distance to the nearest MRT station") +
theme_minimal()
library(plotly)##
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layoutplot <- augment(df_clust, df) %>%
ggplot(aes(X3,
Y,
color =.cluster)) +
geom_point(alpha = 3) +
ggtitle("Clustering: House price of unit area via distance to the nearest MRT station")
ggplotly(plot)
Ước tính chỉ số Silhouette S_i có giá trị từ - 1 đến 1
sil = silhouette(df_clust$cluster, dist(df))
fviz_silhouette(sil)## cluster size ave.sil.width
## 1 1 41 0.68
## 2 2 280 0.80
## 3 3 93 0.61