> library(pacman)
> p_load(dplyr, dbscan, ggplot2)
k-means (K均值)和 分层聚类衡量行间、及行与中心点的距离。k-Means算法比较适用于簇为球型的,对于非球型的,一般需要基于密度的聚类,比如DBSCAN, OPTICS,利用单位空间的样本量,即密度。基于密度的聚类不偏向球形聚类,可以找到形状各异且复杂的聚类。
DBSCAN(Density-Based Spatial Clustering of Applications with Noise,具有噪声的基于密度的聚类方法)是一种很典型的密度聚类算法,和K-Means,BIRCH这些一般只适用于凸样本集的聚类相比,DBSCAN既可以适用于凸样本集,也可以适用于非凸样本集。通过将紧密相连的样本划为一类,这样就得到了一个聚类类别。通过将所有各组紧密相连的样本划为各个不同的类别,则得到最终的所有聚类类别结果。
r-邻域:给定点半径为r的区域。
核心点:如果一个点的r邻域内最少包含M个点,则该点称为核心点。
直接密度可达:对于核心点P而言,如果另一个点O在P的r邻域内,那么称O为P的直接密度可达点。
密度可达:对于P的直接密度可达点O的r邻域内,如果包含另一个点Q,那么称Q为P的密度可达点。
密度相连:如果Q和N都是核心点P的密度可达点,但是并不在一条直线路径上,那么称两者为密度相连。
1 密度聚类算法思想
1.指定r和M。
2.计算所有的样本点,如果点P的r邻域内有超过M个点,那么创建一个以P为核心点的新簇。
3.反复寻找这些核心点的直接密度可达点(之后可能是密度可达),将其加入到相应的簇,对于核心点发生密度相连的情况加以合并。
4.当没有新的点加入到任何簇中时,算法结束。
2 DBSCAN算法实例
dbscan包函数列表:
dbscan(), 实现DBSCAN算法
optics(), 实现OPTICS算法
hdbscan(), 实现带层次DBSCAN算法
sNNclust(), 实现共享聚类算法
jpclust(), Jarvis-Patrick聚类算法
lof(), 局部异常因子得分算法
extractFOSC(),集群优选框架,可以通过参数化来执行聚类。
frNN(), 找到固定半径最近的邻居
kNN(), 最近邻算法,找到最近的k个邻居
sNN(), 找到最近的共享邻居数量
pointdensity(), 计算每个数据点的局部密度
kNNdist(),计算最近的k个邻居的距离
kNNdistplot(),画图,最近距离
hullplot(), 画图,集群的凸壳
> data(banknote, package = "mclust")
> bn <- as_tibble(banknote)
> str(bn)
## tibble [200 × 7] (S3: tbl_df/tbl/data.frame)
## $ Status : Factor w/ 2 levels "counterfeit",..: 2 2 2 2 2 2 2 2 2 2 ...
## $ Length : num [1:200] 215 215 215 215 215 ...
## $ Left : num [1:200] 131 130 130 130 130 ...
## $ Right : num [1:200] 131 130 130 130 130 ...
## $ Bottom : num [1:200] 9 8.1 8.7 7.5 10.4 9 7.9 7.2 8.2 9.2 ...
## $ Top : num [1:200] 9.7 9.5 9.6 10.4 7.7 10.1 9.6 10.7 11 10 ...
## $ Diagonal: num [1:200] 141 142 142 142 142 ...
> DataExplorer::profile_missing(bn)
## # A tibble: 7 x 3
## feature num_missing pct_missing
##
## 1 Status 0 0
## 2 Length 0 0
## 3 Left 0 0
## 4 Right 0 0
## 5 Bottom 0 0
## 6 Top 0 0
## 7 Diagonal 0 0
去掉类别列,数据标准化:
> # 因为做聚类,所以去掉类别列
> bn <- bn[, -1] %>%
+ # 标准化
+ mutate(across(everything(), scale))
> str(bn)
## tibble [200 × 6] (S3: tbl_df/tbl/data.frame)
## $ Length : num [1:200, 1] -0.255 -0.786 -0.255 -0.255 0.276 ...
## ..- attr(*, "scaled:center")= num 215
## ..- attr(*, "scaled:scale")= num 0.377
## $ Left : num [1:200, 1] 2.43 -1.17 -1.17 -1.17 -1.44 ...
## ..- attr(*, "scaled:center")= num 130
## ..- attr(*, "scaled:scale")= num 0.361
## $ Right : num [1:200, 1] 2.83 -0.635 -0.635 -0.882 -0.635 ...
## ..- attr(*, "scaled:center")= num 130
## ..- attr(*, "scaled:scale")= num 0.404
## $ Bottom : num [1:200, 1] -0.289 -0.912 -0.497 -1.327 0.68 ...
## ..- attr(*, "scaled:center")= num 9.42
## ..- attr(*, "scaled:scale")= num 1.44
## $ Top : num [1:200, 1] -1.184 -1.433 -1.308 -0.312 -3.675 ...
## ..- attr(*, "scaled:center")= num 10.7
## ..- attr(*, "scaled:scale")= num 0.803
## $ Diagonal: num [1:200, 1] 0.448 1.056 1.49 1.316 1.143 ...
## ..- attr(*, "scaled:center")= num 140
## ..- attr(*, "scaled:scale")= num 1.15
使用kNN()函数,计算数据集中每个值最近的5个点。
> nn <- kNN(bn, k = 5)
> head(nn$dist)
## 1 2 3 4 5
## [1,] 2.3979290 2.6547499 2.7136683 2.7506359 2.7758450
## [2,] 0.8114257 0.9311021 0.9597960 1.0923877 1.1280840
## [3,] 0.6325241 0.8114257 0.8644072 0.9798160 1.1217324
## [4,] 0.7787735 0.8736941 0.8803796 0.8863102 0.9570431
## [5,] 1.9323265 1.9571331 2.0636176 2.1836362 2.2670993
## [6,] 1.6226807 1.6650844 1.6863721 1.8445092 1.8529403
行为每个点的索引,列为最近邻的5个点。
查找与第79号点(79行)距离最近的5个点:
> nn$dist[79, ]
## 1 2 3 4 5
## 0.8936911 0.9257298 1.0673777 1.1936619 1.2228467
画图:
> # 79号点使用红色,其他黑色
> cols <- ifelse(1:nrow(bn) %in% nn$id[79, ], "red", "black")
> # 近邻点使用蓝色
> cols[79] <- "blue"
>
> # 避免拥挤,只画3个特征
> plot(bn[, 1:3], pch = 19, col = cols)
三个特征两两组合的二维平面图中,可以看出红色点确实围绕在蓝色点周围,但同时,因为是二维平面,所以有些点被遮盖了。
选取两个列,画出最近邻前5连接路径:
> plot(nn, bn)
通过连接路径,可以看到最近邻的分组过程,能够连接在一起的就组成了一个聚类,没有连接在一起的就聚为了不同的类。
DBSACN算法函数语法:
eps:搜索半径,设置得非常小,则意味着没有点是核心样本,可能会导致所有点被标记为噪声;设置得非常大,可能会导致所有点形成单个簇。
minPts:成为聚类的最少的行数,要成为核心对象所需要的 ϵ-邻域的样本数阈值,默认为5。
weights, 数据点的权重,仅用于加权聚类。
borderPoints,边界点是否为噪声,默认为TRUE。
> dbscan(x, eps = 0.42, minPts = 5)
寻找最优的参数
方法一
eps,可以使用绘制k-距离曲线(k-distance graph)方法得到,在k-距离曲线图明显拐点位置为较好的参数。若参数设置过小,大部分数据不能聚类;若参数设置过大,多个簇和大部分对象会归并到同一个簇中。
minPts,通常让minPts≥dim+1,其中dim表示数据集聚类数据的维度。若该值选取过小,则稀疏簇中结果由于密度小于minPts,从而被认为是边界点;若该值过大,则密度较大的两个邻近簇可能被合并为同一簇。
本例中数据集为6维,所以选择k=6+1=7。
> kNNdistplot(bn, k = 7)
> abline(h = 2, col = "red", lty = 2)
kNNdistplot()会计算点矩阵中的k=7的最近邻的距离,然后按距离从小到大排序后,以图形进行展示。x轴为距离的序号,y轴为距离的值。图中黑色的线,从左到右y值越来越大。
通过绘制k-距离曲线,寻找eps,即明显拐点位置为对应较好的参数。本例中eps为2。
最后使用参数聚类:
> bn.dbscan <- dbscan(bn, eps = 2, minPts = 7)
> bn.dbscan
## DBSCAN clustering for 200 objects.
## Parameters: eps = 2, minPts = 7
## The clustering contains 1 cluster(s) and 4 noise points.
##
## 0 1
## 4 196
##
## Available fields: cluster, eps, minPts
从结果可知,整个数据集聚为了一个类,其中4个点为噪声点。但实际数据中只有两个类,所以说明eps或者minPts参数设置得过大。
方法二
使用参数网格寻找最优的参数。
> # 参数网格
> # eps从1.0到3.0,每次0.2增加
> # minPts从5到10
> # 一共11*6=66组
> grid.dbscan <- expand.grid(eps = seq(1.0, 3.0, 0.2),
+ MinPts = 5:10)
>
> dim(grid.dbscan)
## [1] 66 2
> head(grid.dbscan)
## eps MinPts
## 1 1.0 5
## 2 1.2 5
## 3 1.4 5
## 4 1.6 5
## 5 1.8 5
## 6 2.0 5
> # 训练模型
> # 将grid.dbscan中的每一行传给dbscan()函数,bn为dbscan的数据框
> bn.dbs <- purrr::pmap(.l = grid.dbscan, .f = dbscan, bn)
>
> # 返回所有模型结果保存在list中
> class(bn.dbs)
## [1] "list"
> # 查看其中一个模型的输出
> bn.dbs[[1]]
## DBSCAN clustering for 200 objects.
## Parameters: eps = 1, minPts = 5
## The clustering contains 3 cluster(s) and 81 noise points.
##
## 0 1 2 3
## 81 55 4 60
##
## Available fields: cluster, eps, minPts
> # 查看其中一个聚类的结果
> bn.dbs[[11]]$cluster
## [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [54] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [107] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [160] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
> bn.clust <- bn.dbs %>%
+ # 提取所有的聚类结果
+ purrr::map_dfc(~.$cluster) %>%
+ # 设置列名
+ setNames(paste0("cluster", 1:66))
> bn.clust[1:6, 1:8]
## # A tibble: 6 x 8
## cluster1 cluster2 cluster3 cluster4 cluster5 cluster6 cluster7 cluster8
##
## 1 0 0 0 0 0 0 0 1
## 2 1 1 1 1 1 1 1 1
## 3 1 1 1 1 1 1 1 1
## 4 1 1 1 1 1 1 1 1
## 5 0 0 0 0 0 1 1 1
## 6 0 0 0 0 1 1 1 1
超参数结果的可视化比较:(因为模型太多,一共66个,所以图形看不清,这里将不展示)
> bn.clust %>%
+ # 合并原数据框中的两列
+ bind_cols(right = bn$Right,
+ diagonal = bn$Diagonal) %>%
+ # 宽表变长表,只变换聚类结果列
+ tidyr::pivot_longer(names_to = "permutation",
+ values_to = "cluster", cols = c(1:66)) %>%
+ # 画图
+ ggplot(aes(right, diagonal, col = as.factor(cluster))) +
+ geom_point() +
+ facet_wrap(~ permutation) +
+ theme_bw() +
+ theme(legend.position = "none")
超参数结果的指标比较:
> p_load(clusterSim, purrr)
>
> # 计算分类效果函数
> msr_cluster <- function(data, clusters, dist_mat) {
+ # 计算戴维森堡丁指数,DB越小意味着类内距离越小,同时类间距离越大
+ list(db = index.DB(data, clusters)$DB,
+ # Calinski-Harabasz伪F统计量,CH越大代表着类自身越紧密,类与类之间越分散
+ G1 = index.G1(data, clusters),
+ # 聚类数量
+ clusters = length(unique(clusters)))
+ }
>
> # 十折交叉验证
> bn.boot <- map(1:10, ~ {
+ # 有放回抽样10次
+ sample_n(bn, size = nrow(bn), replace = T)
+ })
>
> class(bn.boot)
## [1] "list"
> length(bn.boot)
## [1] 10
> # 对每一次抽样进行聚类,并计算结果
> metric.bn <- map_df(bn.boot, function(boot) {
+ clust.out = pmap(grid.dbscan, dbscan, boot)
+
+ map_df(clust.out, function(permutation) {
+ clust = permutation$cluster %>%
+ as_tibble() %>%
+ bind_cols(boot) %>%
+ # 去掉噪声点
+ filter(value != 0)
+
+ d = dist(dplyr::select(clust, -value))
+
+ msr_cluster(data = clust,
+ clusters = clust$value,
+ dist_mat = d)
+ })
+ })
>
> str(metric.bn)
## tibble [660 × 3] (S3: tbl_df/tbl/data.frame)
## $ db : num [1:660] 0.628 0.793 0.926 NaN NaN ...
## $ G1 : num [1:660] 89.3 87.4 95.9 NaN NaN ...
## $ clusters: int [1:660] 5 4 3 1 1 1 1 1 1 1 ...
> summary(metric.bn)
## db G1 clusters
## Min. :0.4627 Min. : 10.7 Min. :1.000
## 1st Qu.:0.7133 1st Qu.:112.4 1st Qu.:1.000
## Median :0.8091 Median :138.5 Median :1.000
## Mean :0.8180 Mean :142.0 Mean :1.645
## 3rd Qu.:0.9527 3rd Qu.:165.3 3rd Qu.:2.000
## Max. :1.0715 Max. :270.0 Max. :8.000
## NA's :463 NA's :463
结果中有463个缺失值,最少的聚为了一个类,最多的聚为了8个类。
> metric.sum <- metric.bn %>%
+ # 增加三列
+ mutate(bootstrap = factor(rep(1:10, each = 66)),
+ eps = factor(rep(grid.dbscan$eps, times = 10)),
+ MinPts = factor(rep(grid.dbscan$MinPts, times = 10))) %>%
+ # 将Na转换为Inf(无穷大)
+ mutate(across(where(is.numeric), ~ na_if(., Inf))) %>%
+ # 去掉有缺失值的行
+ tidyr::drop_na()
> str(metric.sum)
## tibble [197 × 6] (S3: tbl_df/tbl/data.frame)
## $ db : num [1:197] 0.628 0.793 0.926 0.596 0.78 ...
## $ G1 : num [1:197] 89.3 87.4 95.9 114 114.2 ...
## $ clusters : int [1:197] 5 4 3 4 3 2 5 2 2 5 ...
## $ bootstrap: Factor w/ 10 levels "1","2","3","4",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ eps : Factor w/ 11 levels "1","1.2","1.4",..: 1 2 3 1 2 3 1 2 3 1 ...
## $ MinPts : Factor w/ 6 levels "5","6","7","8",..: 1 1 1 2 2 2 3 3 3 4 ...
此时只需要找到db最小同时G1最大(即db/G1最小)时的参数即可。
画图查看结果:
> metric.sum %>%
+ mutate(value = round(db / G1, 3)) %>%
+ dplyr::select(eps, MinPts, clusters, value) %>%
+ # 将clusters转换为因子型
+ transform(clusters = as.factor(.$clusters)) %>%
+ # 将1、2、3列宽变长
+ tidyr::pivot_longer(names_to = "metrics", values_to = "dbs", cols = 1:3) %>%
+ # 找出value值最小的行
+ filter(value == min(value)) %>%
+ ggplot(aes(dbs, value)) +
+ geom_point(size = 2, col = "blue") +
+ facet_wrap(~ metrics) +
+ theme_bw() +
+ labs(x = "")
最终选择的聚类数量为2,此时eps=1,MinPts=9或者10。
3 密度聚类的优缺点
优点:
(1)聚类速度快且能够有效处理噪声点和发现任意形状的空间聚类;
(2)与K-MEANS比较起来,不需要输入要划分的聚类个数;
(3)聚类簇的形状没有偏倚;
(4)可以在需要时输入过滤噪声的参数。
缺点:
(1)当数据量增大时,要求较大的内存,I/O消耗也很大;
(2)当空间聚类的密度不均匀、聚类间距差相差很大时,聚类质量较差,因为这种情况下参数MinPts和eps选取困难
(3)聚类效果依赖于距离公式选取,实际应用中常用欧式距离,对于高维数据,存在“维数灾难”。