如何修改FactoMineR的plot.HCPC实现3D聚类树图自定义标注

问题描述 #

使用FactoMineR的HCPC做聚类分析时，修改hc$call$X$clust为自定义水平的因子后，plot(hc, choice="map")能正常更新聚类标注，但plot.HCPC(hc, choice="3D.map")的图例颜色完全没变化。查看源码发现，3D图的图例颜色是通过as.numeric(levels(X$clust))生成的，这导致颜色和聚类分组的对应关系受因子水平顺序影响，无法准确识别聚类。

解决方案 #

重写plot.HCPC函数，调整图例的颜色映射逻辑，让每个聚类分组的颜色与因子水平绑定，不受数据框顺序干扰，实现类似ComplexHeatmap的固定颜色标注效果。

修改后的函数代码 #

library(FactoMineR)
library(scatterplot3d)

# 重写plot.HCPC函数，重点修改3D图的图例部分
my_plot.HCPC <- function (x, choice = c("map", "tree", "3D.map", "bar", "boxplot"), 
                          axes = c(1, 2), angle = 60, palette = NULL, title = NULL, 
                          ind.names = TRUE, new.plot = TRUE, ...) 
{
  if (!inherits(x, "HCPC")) 
    stop("non convenient object")
  choice <- match.arg(choice)
  if (is.null(title)) 
    title <- switch(choice, map = "Factor map with clusters", 
                    tree = "Hierarchical tree", `3D.map` = "3D map with clusters", 
                    bar = "Barplots of the clusters", boxplot = "Boxplots of the clusters")
  if (new.plot) 
    par(mfrow = c(1, 1))
  X <- x$call$X
  if (is.null(X$clust)) 
    stop("no clusters")
  clust <- X$clust
  if (is.numeric(clust)) 
    clust <- factor(clust)
  levs <- levels(clust)
  nb.clust <- length(levs)
  
  # 自定义调色板，默认用rainbow，支持传入自定义调色板
  if (is.null(palette)) 
    palette <- rainbow(nb.clust)
  else if (length(palette) < nb.clust) 
    stop("palette is too short")
  
  col.clust <- palette[as.numeric(clust)]
  
  if (choice == "map") {
    if (!inherits(x$call$call, "PCA")) 
      stop("choice map is only available for PCA results")
    plot.PCA(x$call$call, axes = axes, choix = "ind", habillage = clust, 
             title = title, new.plot = new.plot, ...)
  }
  else if (choice == "tree") {
    plot(x$call$call$call, hang = -1, main = title, ...)
    rect.hclust(x$call$call$call, k = nb.clust, border = palette)
  }
  else if (choice == "3D.map") {
    if (!inherits(x$call$call, "PCA")) 
      stop("choice 3D.map is only available for PCA results")
    res.pca <- x$call$call
    scatterplot3d(res.pca$ind$coord[, axes[1]], 
                  res.pca$ind$coord[, axes[2]], res.pca$ind$coord[, 3], 
                  color = col.clust, pch = 16, angle = angle, main = title, 
                  xlab = paste("Dim", axes[1], " (", round(res.pca$eig[axes[1], 2], 1), "%)", sep = ""), 
                  ylab = paste("Dim", axes[2], " (", round(res.pca$eig[axes[2], 2], 1), "%)", sep = ""), 
                  zlab = paste("Dim 3 (", round(res.pca$eig[3, 2], 1), "%)", sep = ""), ...)
    # 修改图例：让颜色与聚类水平一一对应，不受顺序影响
    leg <- paste("cluster", levs, sep = " ")
    legend("topleft", legend = leg, text.col = palette[seq_len(nb.clust)], 
           cex = 0.8)
  }
  else if (choice == "bar") {
    mean.clust <- aggregate(X[, !(names(X) %in% c("clust", "dist"))], 
                            by = list(clust = clust), mean)
    rownames(mean.clust) <- mean.clust$clust
    mean.clust <- mean.clust[, !(names(mean.clust) == "clust")]
    barplot(t(mean.clust), beside = TRUE, col = palette, main = title, ...)
    legend("top", legend = levs, fill = palette, cex = 0.8, ncol = nb.clust)
  }
  else if (choice == "boxplot") {
    for (var in names(X)[!(names(X) %in% c("clust", "dist"))]) {
      boxplot(X[, var] ~ clust, col = palette, main = paste(title, "-", var), ...)
    }
  }
  invisible()
}

使用示例 #

# 1. 基础聚类流程
res.pca <- PCA(iris[, -5], scale = TRUE)
hc <- HCPC(res.pca, nb.clust=-1)

# 2. 修改聚类因子水平顺序（模拟自定义顺序场景）
hc$call$X$clust <- factor(hc$call$X$clust, levels = unique(hc$call$X$clust))

# 3. 使用修改后的函数生成3D聚类图
my_plot.HCPC(hc, choice="3D.map", angle=60)

# 可选：传入自定义调色板
my_plot.HCPC(hc, choice="3D.map", angle=60, palette = c("#E69F00", "#56B4E9", "#009E73"))

修改要点 #

1. 新增palette参数，支持自定义聚类颜色，默认用rainbow生成
2. 3D图例的颜色直接使用调色板对应位置的颜色，与聚类因子水平一一绑定，不再依赖levels(X$clust)的数值索引
3. 确保无论如何调整X$clust的因子水平顺序，图例颜色都能和聚类分组准确对应，解决原函数的颜色匹配问题

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