基于距离的点聚类优化：仅拆分超4点集群的循环改进需求

Hey, 我看了你的代码和需求，核心问题是现在的循环每次都从头跑所有点的聚类，不管集群大小，导致已经符合要求的小集群被反复处理。咱们调整一下逻辑，改成只针对需要拆分的大集群单独迭代，这样既高效又符合你的预期。

问题核心分析 #

现有代码的循环逻辑是：每次都用所有原始点重新计算距离矩阵、重新聚类，这就导致那些已经只有2个点的cluster 2也跟着被重新拆分，完全没必要。正确的思路应该是：

• 先初始聚类得到所有集群
• 只挑出点数>4的集群，对它们单独用减半后的距离再细分
• 把拆分后的新集群和原本达标的小集群合并
• 重复这个过程，直到没有大集群需要处理

修改后的代码实现 #

library(sf)
library(dplyr)

# 加载可复现数据
points <- structure(list(LATITUDE = c(32.70132, 34.74251, 32.55205, 32.64144, 34.92803, 32.38016, 32.42127, 32.9095, 33.58092, 32.51617, 33.5726, 33.83251, 34.65639, 34.27694, 33.73851, 33.95132, 31.35445, 34.05263, 33.37959, 30.50248, 32.31561, 32.66919, 31.75039, 33.56986, 33.27091, 33.93598, 32.30964, 31.09773, 32.26711, 33.54263, 34.72014, 34.78548, 30.65705, 31.25939, 31.27647, 30.54322, 31.22416, 33.38549, 33.18338, 31.16811, 32.38368, 32.36253, 31.14464), LONGITUDE = c(-85.52518, -86.88351, -87.34777, -85.3543, -87.81506, -86.2979, -87.0869, -85.75888, -86.27647, -86.21179, -86.65275, -87.2696, -85.72738, -87.71489, -86.48934, -86.29693, -88.22943, -87.55328, -85.31454, -87.79342, -86.88108, -86.26669, -88.04425, -86.44631, -87.74383, -87.72403, -86.28067, -85.4449, -87.62541, -86.56251, -86.48971, -85.59656, -88.24491, -86.60828, -86.18112, -88.22778, -85.63784, -86.03297, -87.55456, -85.37719, -86.38047, -86.21579, -86.86606 ) ), .Names = c("LATITUDE", "LONGITUDE"), class = "data.frame", row.names = c(NA, -43L))

# 初始设置
points_sf <- points %>% st_as_sf(coords = c('LATITUDE', 'LONGITUDE')) %>% st_set_crs(4326)
current_distance <- 80000  # 初始距离80000米
clusters_list <- list()

# 第一步：初始聚类得到所有集群
dmatrix <- st_distance(points_sf) %>% unclass()
clustering <- hclust(as.dist(dmatrix > current_distance), method = "single")
cluster_ids <- cutree(clustering, h=0.5)

# 把初始集群存入列表，每个元素是一个集群的sf对象
for (g in unique(cluster_ids)) {
  clusters_list[[as.character(g)]] <- points_sf[cluster_ids == g, ]
}

# 迭代处理大集群
repeat {
  # 筛选出点数>4的集群
  large_clusters <- Filter(function(x) nrow(x) > 4, clusters_list)
  
  if (length(large_clusters) == 0) {
    break  # 没有大集群了，退出循环
  }
  
  # 距离减半
  current_distance <- current_distance * 0.5
  
  # 处理每个大集群：拆分后替换原集群
  for (cluster_name in names(large_clusters)) {
    cluster_points <- large_clusters[[cluster_name]]
    # 对当前大集群单独计算距离矩阵和聚类
    dmatrix_sub <- st_distance(cluster_points) %>% unclass()
    clustering_sub <- hclust(as.dist(dmatrix_sub > current_distance), method = "single")
    sub_cluster_ids <- cutree(clustering_sub, h=0.5)
    
    # 移除原来的大集群
    clusters_list[[cluster_name]] <- NULL
    
    # 把拆分后的小集群加入列表，用新的命名避免冲突
    for (sub_g in unique(sub_cluster_ids)) {
      new_cluster_name <- paste0(cluster_name, "_", sub_g)
      clusters_list[[new_cluster_name]] <- cluster_points[sub_cluster_ids == sub_g, ]
    }
  }
}

# 把所有集群合并成最终的Data输出
Data <- bind_rows(clusters_list, .id = "cluster") %>%
  # 提取坐标列（因为sf对象的geom是几何列，需要转成LATITUDE和LONGITUDE）
  mutate(
    LATITUDE = st_coordinates(geometry)[,2],
    LONGITUDE = st_coordinates(geometry)[,1]
  ) %>%
  select(cluster, LATITUDE, LONGITUDE) %>%
  st_drop_geometry()  # 去掉sf几何列，变回普通数据框

# 查看结果
print(Data)

# 验证所有集群点数都≤4
Data %>% group_by(cluster) %>% tally() %>% filter(n>4)

关键改动说明 #

• 维护集群列表：用clusters_list保存所有当前的集群，已经达标的小集群会一直留在列表里，不会被重复处理
• 针对性处理大集群：每次循环只筛选出点数>4的集群，对它们单独进行细分，其他集群完全不动
• 动态更新距离：只有当需要拆分大集群时，才把距离减半，符合你“仅对超4点集群重复计算”的需求
• 结果合并：最后把所有集群合并成你需要的Data格式，同时保留原始的经纬度列

这样修改后，就不会再出现小集群被反复计算的问题，而且迭代次数会更合理，算力也更高效。

内容的提问来源于stack exchange，提问作者Alan20