1 データ

アヤメ(iris)の3品種( SetosaVersicolorVirginica )の萼(がく)と花弁それぞの長さと幅のデータ

変数 内容
Sepal.Length 萼片(がくへん)の長さ(cm)
Sepal.Width 萼片(がくへん)の幅(cm)
Petal.Length 花弁の長さ(cm)
Petal.Width 花弁の幅(cm)
萼片(sepal)と花弁(petal)
萼片(sepal)と花弁(petal)

写真出典: Data analysis with the tidyverse

n <- 50
ii <- sample(1:nrow(iris), n)
d <- iris[ii, ]
group <- d[, 5]
rownames(d) <- paste(d$Species, 1:nrow(d))

library(DT)
datatable(d, options = list(pageLength = 5))

1.1 グラフ

# カラーパレット
COL <- c(rgb(255,   0,   0,  105, max = 255), # 赤
         rgb(  0,   0, 255,  105, max = 255), # 青
         rgb(  0, 155,   0,  105, max = 255), # 緑
         rgb(100, 100, 100,   55, max = 255)) # 灰

RGB_Color

2 相関分析

pairs(d[, -5], pch = 15 + as.numeric(d$Species), col = COL[group], 
      lower.panel = NULL, oma = c(3, 3, 5, 3), main = 'Iris Data')

par(xpd = T)
legend('bottomleft', col = COL[1:3], pch = 16:18, legend = unique(d$Species))

3 階層的クラスター分析

library(cluster)
library(factoextra)

# AGNES
hc.a <- agnes(d)
fviz_dend(as.hclust(hc.a), k = 3, horiz = T, rect = T, rect_fill = T,
 color_labels_by_k = F, rect_border = 'jco', k_colors = 'jco', cex = 0.4)

gr <- cutree(hc.a, k = 3) # クラスター数kのときのグループ番号
head(gr)
## [1] 1 2 1 2 2 2
# DIANA
hc.d <- diana(d)
fviz_dend(as.hclust(hc.d), k = 3, horiz = T, rect = T, rect_fill = T,
 color_labels_by_k = F, rect_border = 'jco', k_colors = 'jco', cex = 0.4)

3.0.1 インタラクティブグラフ

library(plotly)
library(ggplot2)
library(cluster)
library(ggdendro)
hc.a |> as.dendrogram() |> ggdendrogram(rotate = T) |> ggplotly() # AGNES
hc.d |> as.dendrogram() |> ggdendrogram(rotate = T) |> ggplotly() # DIANA

4 クラスター連結(cluster linkage)の性能評価

4.1 【性能評価指標】凝集係数(agglomerative coefficient)

凝集係数とは,クラスター階層構造の評価指標で1に近づくほどよい構造を持つ。 この係数はサンプルサイズが増えると大きくなるので, サイズの大きく異なるデータセット間での比較には使用できない。

\[AC=\frac{1}{N}\sum_{i=1}^N\left(1-\frac{d_i^{(first)}}{d_i^{(final)}}\right), \quad 0\le AC \le 1\] ここで,\(d_i^{(first)}\)は観測値\(i\)が最初にマージされた群への距離, \(d_i^{(final)}\)は,最後に1つの群にマージされたときの距離。 クラスター階層構造の良さを, \(d_i^{(first)}\)が小さい(所属する群で近隣が近い→ 群がコンパクト), かつ\(d_i^{(final)}\)が大きい(他の群と遠い)という数式で表現している。

METHOD <- c('single', 'complete', 'average',
            'weighted', 'ward', 'gaverage', 'flexible')

ac <- rep(NA, 7)
for (i in 1:6) ac[i] <- agnes(d, method = METHOD[i])$ac
ac[7] <- agnes(d, method = METHOD[7], par.method = 0.5)$ac
names(ac) <- METHOD

barplot(ac, ylim = c(0.8, 1.0), xpd = F)
abline(h = seq(0, 1, 0.05), lty = 3)

Ward法が最も良い結果となった。

5 クラスター数(\(k\))の最適化

5.1 Elbow法

クラスタ数ごとの群内分散合計を計算する。 グラフのプロットが折れ曲がる点(肘:elbow)が最適なクラスタ数となる。

fviz_nbclust(d[, -5], FUNcluster = hcut, method = 'wss')

wss: Total within-cluster sum of squares

5.2 Gap Stat法

クラスター数ごとに,群内分散合計と一様乱数で生成された分散との差 を検定する統計量を計算する。
差(gap)の統計値が最も大きいクラスタ数が最適値となる。

fviz_nbclust(d[, -5], FUNcluster = hcut, method = 'gap_stat')

5.3 Average Silhouette法

平均シルエット幅(Average silhouette width)が最も大きいクラスタ数が最適値となる。
シルエット法については 【S-Analysis】シルエット分析 を参照のこと。

fviz_nbclust(d[, -5], FUNcluster = hcut, method = 'silhouette')

6 Python

import matplotlib.pyplot as plt
from scipy.cluster.hierarchy import dendrogram , linkage

d0 = r.d

d0.head()
##              Sepal.Length  Sepal.Width  Petal.Length  Petal.Width    Species
## virginica 1           6.3          2.7           4.9          1.8  virginica
## setosa 2              4.4          2.9           1.4          0.2     setosa
## virginica 3           6.2          3.4           5.4          2.3  virginica
## setosa 4              4.9          3.0           1.4          0.2     setosa
## setosa 5              5.0          3.6           1.4          0.2     setosa
d = d0.iloc[:, :4]

d.head()
##              Sepal.Length  Sepal.Width  Petal.Length  Petal.Width
## virginica 1           6.3          2.7           4.9          1.8
## setosa 2              4.4          2.9           1.4          0.2
## virginica 3           6.2          3.4           5.4          2.3
## setosa 4              4.9          3.0           1.4          0.2
## setosa 5              5.0          3.6           1.4          0.2
dendro = dendrogram(linkage(d, method = 'ward'), labels = d.index, orientation = 'left', leaf_font_size = 6)

plt.title('デンドログラム')
plt.ylabel('ユークリッド距離')
plt.show()

7 演習課題

ショッピングモールの顧客データをクラスタリングせよ。 このデータ・セットには顧客番号,性別,年齢,年収,支出スコアの情報が記録されている。

7.1 データ

d <- read.csv('https://stats.dip.jp/01_ds/data/Mall_Customers.csv')
colnames(d) <- c('id', 'gender', 'age', 'income', 'score')
datatable(d, options = list(pageLength = 5))

7.2 グラフ

matplot(x = d$income, y = d$score, pch = 16, type = 'p', col = "red")
grid()

7.2.1 グループ別色分けグラフ

#NGROUPS <- 4 # グループ数
#COL <- rainbow(NGROUPS) # カラーパレット
#gr <- cutree(hc.a, k = NGROUPS) # クラスター数kのときのグループ番号
#
#a <- vector('list', NGROUPS)
#for (i in 1:NGROUPS) a[[i]] <- d[gr == i, ]
#
#matplot(x = d$income, y = d$score, pch = 16, type = 'n', col = COL[1])
#for  (i in 1:NGROUPS)
#{
#  matpoints(x = a[[i]]$income,
#            y = a[[i]]$score, pch = 16, type = 'p', col = COL[i])
#}
#grid()