FactoMineR绘制3D图时如何用元数据分组替换默认聚类标签

问题说明 #

默认FactoMineR包的HCPC配套绘图函数（plot.HCPC、fviz_dend调用HCPC结果时）默认使用算法自动生成的聚类簇做着色、分组标注，没有提供直接替换为外部自定义分组的参数入口。
你当前运行的基础代码如下：

library(FactoMineR); library(factoextra)

res.pca <- PCA(t(data),ncp = 10, graph = FALSE)
res.hcpc <- HCPC(res.pca, graph = FALSE)

fviz_dend(res.hcpc, 
          cex = 0.7,                     # Label size
          palette = "jco",               # Color palette see ?ggpubr::ggpar
          rect = TRUE, rect_fill = TRUE, # Add rectangle around groups
          rect_border = "jco",           # Rectangle color
          labels_track_height = 0.8      # Augment the room for labels
)

tiff("plot.tiff",width=3000,height=1856,res=600)
plot(res.hcpc, choice = "3D.map",ind.names=TRUE,cex.axis=3.5,cex.symbols=3.5,xlab="",ylab="")
dev.off()

实现步骤 #

1. 预处理对齐分组信息 #

首先读入元数据，确保FAB分组和样本顺序完全匹配，这步是避免分组错配的核心：

# 读入元数据，根据你的文件格式调整读取函数，确保行名是样本ID，和t(data)的行名完全一致
meta <- read.delim("元数据文件路径", row.names = 1, check.names = FALSE, stringsAsFactors = FALSE)
# 按PCA结果中的样本顺序对齐元数据
meta <- meta[rownames(res.pca$ind$coord), ]
fab_group <- meta$FAB

# 自定义FAB分组配色，可根据需要替换颜色值
library(ggpubr)
fab_pal <- get_palette("jco", k = length(unique(fab_group)))
names(fab_pal) <- unique(fab_group)

2. 修改树状图按FAB分组标注 #

关闭默认的HCPC聚类矩形、聚类配色，直接传入FAB分组的配色映射即可：

fviz_dend(res.hcpc, 
          cex = 0.7,
          k = NULL, # 关闭默认聚类分群切割
          palette = fab_pal[fab_group], # 按FAB分组给分支、标签着色
          rect = FALSE, # 关闭默认聚类分组矩形
          labels_track_height = 0.8
)

如果需要给FAB分组加外围矩形，可以用dendextend包对树状图对象单独添加分组边框。

3. 自定义3D映射图按FAB分组标注 #

原生choice="3D.map"的绘图逻辑硬编码绑定了HCPC聚类簇配色，没有自定义参数入口，最稳定的方式是提取PCA坐标后手动绘制3D图，完全可控：

# 提取前3个主成分坐标（3D图默认使用前3个主成分）
plot_coord <- as.data.frame(res.pca$ind$coord[, 1:3])
colnames(plot_coord) <- c("Dim1", "Dim2", "Dim3")
plot_coord$FAB <- fab_group

library(scatterplot3d)
tiff("3d_FAB_annotated.tiff",width=3000,height=1856,res=600)
s3d <- scatterplot3d(plot_coord[,1:3],
                     color = fab_pal[plot_coord$FAB],
                     pch = 16,
                     cex.symbols = 3.5,
                     cex.axis = 3.5,
                     xlab = "", ylab = "", zlab = "")
# 添加样本名标注
text(s3d$xyz.convert(plot_coord[,1:3]), labels = rownames(plot_coord), cex = 0.7, pos = 4)
# 添加分组图例
legend("topright", legend = names(fab_pal), col = fab_pal, pch = 16, cex = 2, bty = "n")
dev.off()

注意：绘图前必须检查all(rownames(plot_coord) == rownames(meta))返回值为TRUE，确认分组和样本完全对应，避免标注错误。

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