R语言pheatmap热图图例置底、单元格边距及聚类线实现咨询

实现逻辑 #

• 图例底部放置：pheatmap无原生参数支持，通过捕获绘图返回的gtable对象，调整图例位置实现
• 单元格细微间距：设置边框颜色为浅色模拟间距，可根据需要调整边框线宽控制间距大小
• 列聚类分割线：先计算列聚类的分组边界，传入gaps_col参数生成分割线，如需水平分割线可对应调整gaps_row参数逻辑

完整可运行代码 #

# 加载所需包
library(pheatmap)
library(viridis)
library(grid)
library(gtable)

# 读取数据，可替换为本地读取路径
all_rscu = read.csv("https://raw.githubusercontent.com/plemey/SARSCoV2origins/master/codonUsage/all_rscu_codonBiasReanalysis.csv")
all_df <- as.data.frame(all_rscu[,2:26])
row.names(all_df) <- all_rscu$codon

# 先计算列聚类结果，用于生成gaps_col
col_clust <- hclust(dist(t(all_df)))
col_groups <- cutree(col_clust, k = 4)
# 计算列分割位置
gaps_col_pos <- which(diff(col_groups[col_clust$order]) != 0)

# 绘制热图，silent=TRUE返回gtable对象不直接绘图
p <- pheatmap(all_df,
         cluster_rows = F,
         gaps_row = c(10, 14),
         gaps_col = gaps_col_pos, # 对应列聚类分割线需求
         scale = 'none',
         fontsize_row = 5,
         fontsize_col = 10,
         color = magma(50),
         border_color = "#f0f0f0", # 对应单元格细微间距需求，替换为白色可实现更明显间距
         cutree_cols = 4,
         silent = TRUE
)

# 对应图例放置底部需求
# 找到图例所在的gtable位置
legend_idx <- which(p$layout$name == "legend")
# 修改图例的位置参数，移到热图下方
p$layout[legend_idx, c("t", "l", "b", "r")] <- c(nrow(p$layout), 2, nrow(p$layout), 2)
# 可选：调整图例为横向排列，更适合底部放置
p$grobs[[legend_idx]]$children[[1]]$gp$legend.direction <- "horizontal"
p$grobs[[legend_idx]]$children[[1]]$x <- unit(0.5, "npc")
p$grobs[[legend_idx]]$children[[1]]$y <- unit(0.2, "npc")
p$grobs[[legend_idx]]$children[[1]]$just <- "center"

# 输出最终热图
grid.newpage()
grid.draw(p)

可调参数说明 #

• 如需缩小单元格间距，可添加代码修改边框线宽：p$grobs[[which(p$layout$name == "matrix")]]$gp$lwd <- 0.3，数值越小间距越窄
• 如需调整底部图例的上下左右位置，可修改p$layout[legend_idx, ]中的位置数值适配需求

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