基于真实数据的Bootstrapped hclust：R中多观测分类数据聚类问询

云原生阿岚

2026-8-14

问题描述

我有一份每个类别（country）对应多条观测的数据集，示例数据如下：

country PC1 PC2 PC3 PC4 PC5
BD  0.0960408090569664  0.373740208940467   -0.369920989335273  -1.02993010449105   -0.481901935725247
BD  -0.538617581045194  0.537010643603669   0.447050616992454   -1.3888975041278    -0.759524281163431
PK  -0.452943925236246  0.507244835779749   0.64679762176707    -1.38054973938184   -0.278384245105666
PK  -1.01487954986928   0.737191371806965   -0.202656866687033  -1.22663700666619   0.186305912881529
UK  -0.377594639422628  0.817593863033578   0.3739216019342 -1.73856626173224   1.12404906217336
UK  -0.636564327570674  0.714647668634421   1.00488527275837    -1.4344227886331    0.637219423443802
US  -0.775649983771687  0.0900448150403809  0.243317360780493   -1.72498526814162   -0.618714136277983
US  -0.372815509141658  0.419096654055852   0.904247466040119   -0.573219421959129  -0.0154666267035251

我希望在R中执行层次聚类（hclust）分析，最终得到对应4个country类别的4个聚类节点。常规思路是按country取PC1至PC5列的均值后运行hclust，但由于每个类别至少有200条观测，我希望通过bootstrap方式实现：每次从每个类别中随机抽取1条观测生成子样本，重复数千次运行hclust后得到最终聚类结果。我了解到pvclust、ClusterBootstrap、Bclust等工具，但均不契合我的需求，请问如何实现基于真实观测子抽样的bootstrap层次聚类？

实现方案

核心思路

手动实现bootstrap流程：循环指定次数，每次从每个国家的观测中随机抽取1条，生成包含4个样本（每个国家1条）的子数据集，对该子数据集执行层次聚类，记录每次的聚类结果，最后基于多次bootstrap的结果汇总得到稳定的聚类节点。

代码实现

1. 加载数据并预处理

首先读入数据（假设数据已存入data.csv），按国家分组：

# 读入数据
df <- read.csv("data.csv", sep = "\t", header = TRUE)

# 按country分组，提取特征列
country_groups <- split(df[, -1], df$country)

2. 定义单次bootstrap聚类函数

编写函数完成单次抽样+聚类的完整流程：

bootstrap_hclust <- function(groups) {
  # 从每个国家随机抽取1条观测
  sampled_rows <- lapply(groups, function(x) x[sample(nrow(x), 1), ])
  # 合并成子数据集
  sampled_data <- do.call(rbind, sampled_rows)
  # 计算欧氏距离矩阵（可根据需求调整距离方法）
  dist_mat <- dist(sampled_data, method = "euclidean")
  # 执行层次聚类（这里用ward.D2方法，可调整合并规则）
  hc <- hclust(dist_mat, method = "ward.D2")
  # 返回聚类的合并矩阵，记录节点合并顺序
  return(hc$merge)
}

3. 批量执行bootstrap过程

设置重复次数（比如1000次），批量执行聚类：

# 设置bootstrap重复次数
n_boot <- 1000

# 执行多次bootstrap聚类，保存所有结果
boot_results <- replicate(n_boot, bootstrap_hclust(country_groups), simplify = FALSE)

4. 汇总bootstrap结果，评估聚类稳定性

统计每个聚类分支在bootstrap过程中的出现频率，高频分支代表更稳定的聚类结构：

# 定义函数，将合并矩阵转换为可统计的分支字符串
get_clusters <- function(merge_mat) {
  # 初始节点为各国家名称
  nodes <- names(country_groups)
  # 遍历每一步合并
  for (i in 1:nrow(merge_mat)) {
    left <- merge_mat[i, 1]
    right <- merge_mat[i, 2]
    # 处理负索引（对应原始样本节点）
    left_node <- if (left < 0) nodes[-left] else paste0("cluster_", left)
    right_node <- if (right < 0) nodes[-right] else paste0("cluster_", right)
    # 排序后拼接，避免顺序影响统计结果
    new_cluster <- paste(sort(c(left_node, right_node)), collapse = "-")
    nodes <- c(nodes, new_cluster)
  }
  # 返回所有聚类分支
  return(tail(nodes, length(nodes) - length(country_groups)))
}

# 提取所有bootstrap结果的聚类分支
all_clusters <- lapply(boot_results, get_clusters)

# 统计每个分支的出现频率
cluster_counts <- table(unlist(all_clusters))
cluster_freq <- cluster_counts / n_boot

# 按频率降序查看，高频分支为稳定聚类结构
sort(cluster_freq, decreasing = TRUE)

5. 生成最终稳定聚类树

基于所有bootstrap样本的平均距离矩阵，构建最终的层次聚类树：

# 提取所有bootstrap的距离矩阵
all_dist <- lapply(1:n_boot, function(i) {
  sampled_rows <- lapply(country_groups, function(x) x[sample(nrow(x), 1), ])
  sampled_data <- do.call(rbind, sampled_rows)
  as.matrix(dist(sampled_data))
})

# 计算平均距离矩阵
mean_dist <- Reduce("+", all_dist) / n_boot

# 基于平均距离矩阵执行层次聚类
final_hc <- hclust(as.dist(mean_dist), method = "ward.D2")

# 可视化最终聚类树
plot(final_hc, main = "Bootstrap-based Hierarchical Clustering", labels = names(country_groups))

关键说明

抽样规则：严格保证每次从每个国家抽取1条观测，确保子样本覆盖所有类别，完全匹配需求。
参数可调：距离计算方法（dist的method参数）和聚类合并规则（hclust的method参数）可根据数据特性调整，比如改用曼哈顿距离、complete链接等。
结果验证：分支频率统计可直观评估聚类稳定性，平均距离矩阵聚类则是一种简洁的结果汇总方式。

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