アヤメ(iris)の3品種( Setosa, Versicolor, Virginica )の萼(がく)と花弁それぞの長さと幅のデータ
変数 | 内容 |
---|---|
Sepal.Length | 萼片(がくへん)の長さ(cm) |
Sepal.Width | 萼片(がくへん)の幅(cm) |
Petal.Length | 花弁の長さ(cm) |
Petal.Width | 花弁の幅(cm) |
写真出典: 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))
# カラーパレット
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)) # 灰
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))
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)
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
凝集係数とは,クラスター階層構造の評価指標で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法が最も良い結果となった。
クラスタ数ごとの群内分散合計を計算する。 グラフのプロットが折れ曲がる点(肘:elbow)が最適なクラスタ数となる。
fviz_nbclust(d[, -5], FUNcluster = hcut, method = 'wss')
wss: Total within-cluster sum of squares
クラスター数ごとに,群内分散合計と一様乱数で生成された分散との差
を検定する統計量を計算する。
差(gap)の統計値が最も大きいクラスタ数が最適値となる。
fviz_nbclust(d[, -5], FUNcluster = hcut, method = 'gap_stat')
平均シルエット幅(Average silhouette
width)が最も大きいクラスタ数が最適値となる。
シルエット法については 【S-Analysis】シルエット分析
を参照のこと。
fviz_nbclust(d[, -5], FUNcluster = hcut, method = 'silhouette')
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()
ショッピングモールの顧客データをクラスタリングせよ。 このデータ・セットには顧客番号,性別,年齢,年収,支出スコアの情報が記録されている。
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))
matplot(x = d$income, y = d$score, pch = 16, type = 'p', col = "red")
grid()
#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()