使用 ggplot2 再现晶格树状图

Question

这可以用 ggplot2 重现这个格子图吗？

library(latticeExtra)
data(mtcars)
x  <- t(as.matrix(scale(mtcars)))
dd.row <- as.dendrogram(hclust(dist(x)))
row.ord <- order.dendrogram(dd.row)

dd.col <- as.dendrogram(hclust(dist(t(x))))
col.ord <- order.dendrogram(dd.col)

library(lattice)

levelplot(x[row.ord, col.ord],
      aspect = "fill",
      scales = list(x = list(rot = 90)),
      colorkey = list(space = "left"),
      legend =
      list(right =
           list(fun = dendrogramGrob,
                args =
                list(x = dd.col, ord = col.ord,
                     side = "right",
                     size = 10)),
           top =
           list(fun = dendrogramGrob,
                args =
                list(x = dd.row,
                     side = "top",
                     size = 10))))

Answer 1

编辑

从 2011 年 8 月 8 日起，

ggdendro

套餐可在 CRAN 上购买 另请注意，树状图提取函数现在称为

dendro_data

而不是

cluster_data

---

是的，确实如此。 但目前你必须克服一些困难：

1. 安装

   ggdendro

   软件包（可从 CRAN 获取）。 该包将从多种类型的聚类方法（包括

   Hclust

   和

   dendrogram

   ）中提取聚类信息，其明确目的是在

   ggplot

   中进行绘图。
2. 使用网格图形创建视口并对齐三个不同的绘图。

代码：

首先加载库并设置 ggplot 的数据：

library(ggplot2)
library(reshape2)
library(ggdendro)

data(mtcars)
x <- as.matrix(scale(mtcars))
dd.col <- as.dendrogram(hclust(dist(x)))
col.ord <- order.dendrogram(dd.col)

dd.row <- as.dendrogram(hclust(dist(t(x))))
row.ord <- order.dendrogram(dd.row)

xx <- scale(mtcars)[col.ord, row.ord]
xx_names <- attr(xx, "dimnames")
df <- as.data.frame(xx)
colnames(df) <- xx_names[[2]]
df$car <- xx_names[[1]]
df$car <- with(df, factor(car, levels=car, ordered=TRUE))

mdf <- melt(df, id.vars="car")

提取树状图数据并创建绘图

ddata_x <- dendro_data(dd.row)
ddata_y <- dendro_data(dd.col)

### Set up a blank theme
theme_none <- theme(
  panel.grid.major = element_blank(),
  panel.grid.minor = element_blank(),
  panel.background = element_blank(),
  axis.title.x = element_text(colour=NA),
  axis.title.y = element_blank(),
  axis.text.x = element_blank(),
  axis.text.y = element_blank(),
  axis.line = element_blank()
  #axis.ticks.length = element_blank()
)

### Create plot components ###    
# Heatmap
p1 <- ggplot(mdf, aes(x=variable, y=car)) + 
  geom_tile(aes(fill=value)) + scale_fill_gradient2()

# Dendrogram 1
p2 <- ggplot(segment(ddata_x)) + 
  geom_segment(aes(x=x, y=y, xend=xend, yend=yend)) + 
  theme_none + theme(axis.title.x=element_blank())

# Dendrogram 2
p3 <- ggplot(segment(ddata_y)) + 
  geom_segment(aes(x=x, y=y, xend=xend, yend=yend)) + 
  coord_flip() + theme_none

使用网格图形和一些手动对齐来定位页面上的三个图

### Draw graphic ###

grid.newpage()
print(p1, vp=viewport(0.8, 0.8, x=0.4, y=0.4))
print(p2, vp=viewport(0.52, 0.2, x=0.45, y=0.9))
print(p3, vp=viewport(0.2, 0.8, x=0.9, y=0.4))

Answer 2

正如本所说，一切皆有可能。一些支持树状图的工作已经完成。 Andrie de Vries 为树对象创建了一个 fortify 方法。然而，生成的图形并不像您所看到的那样漂亮。

瓷砖很容易做。对于树状图，我将检查

plot.dendrogram

（使用

getAnywhere

）以查看如何计算线段的坐标。提取这些坐标并使用 geom_segment 绘制树状图。然后使用视口将图块和树状图一起绘制。抱歉，我无法举例，这需要大量工作，而且为时已晚。

我希望这有帮助

干杯

Answer 3

值得怀疑。我在 ggplot2 索引中没有看到任何建议支持树状图的函数，当这位博主将 Sarkar 的 Lattice 书中插图的一组翻译放在一起时，他无法获得 ggplot 树状图图例：

http://learnr.wordpress.com/2009/08/10/ggplot2-version-of-figures-in-lattice-multivariate-data-visualization-with-r-part-9/

Answer 4

这些链接为 ggplot2 中带有树状图的热图提供了解决方案：

https://gist.github.com/chr1swallace/4672065

https://github.com/chr1swallace/random-functions/blob/master/R/ggplot-heatmap.R

还有这个：

垂直对齐 ggplot2 绘图

Answer 5

如果您想使用

ggplot2

创建带树状图的热图。我创建了一个名为 ggalign 的包，您可以使用它来创建像

Complexheatmap

一样复杂的热图：

具体来说，它可以将热图拆分为分面组，并确保树状图即使在分面后也能正确对齐。

mat <- matrix(rnorm(81), nrow = 9)
rownames(mat) <- paste0("row", seq_len(nrow(mat)))
colnames(mat) <- paste0("column", seq_len(ncol(mat)))
ggheatmap(mat) +
  scale_fill_viridis_c() +
  hmanno("t") +
  align_dendro(aes(color = branch), k = 3L) +
  labs(color = "top-branch") +
  ggalign(aes(y = value), data = rowSums) +
  geom_bar(stat = "identity", aes(fill = factor(.panel))) +
  scale_fill_brewer(name = NULL, palette = "Dark2") +
  hmanno("l") +
  ggalign(aes(x = value), data = rowSums, size = 0.5) +
  geom_bar(
    aes(y = .y, fill = factor(.y)),
    stat = "identity",
    orientation = "y"
  ) +
  scale_x_reverse() +
  align_dendro(aes(color = branch),
    size = unit(1, "null"),
    k = 4L
  ) +
  labs(color = "left-branch") +
  scale_x_reverse()

^{创建于 2024-07-17，使用 reprex v2.1.0} 〜

可以从 ComplexHeatmap 创建更复杂的热图示例：

expr <- readRDS(system.file(package = "ComplexHeatmap", "extdata", "gene_expression.rds"))
mat <- as.matrix(expr[, grep("cell", colnames(expr))])
base_mean <- rowMeans(mat)
mat_scaled <- t(apply(mat, 1, scale))
type <- gsub("s\\d+_", "", colnames(mat))

ggstack(data = mat_scaled) +
  # group stack rows into 5 groups
  align_kmeans(centers = 5L) +
  # add a block plot for each group in the stack
  ggpanel(size = unit(1, "cm")) +
  geom_tile(aes(x = 1, fill = factor(.panel))) +
  scale_fill_brewer(palette = "Dark2", name = "Kmeans group") +
  scale_x_continuous(breaks = NULL, name = NULL) +
  # add a heatmap plot in the stack
  ggheatmap() +
  hmanno(free_spaces = "l") +
  scale_y_continuous(breaks = NULL) +
  scale_fill_viridis_c() +
  # add dendrogram for this heatmap
  hmanno("t") +
  align_dendro() +
  # add a block for the heatmap column
  ggalign(data = type, size = unit(1, "cm")) +
  geom_tile(aes(y = 1, fill = factor(value))) +
  scale_y_continuous(breaks = NULL, name = NULL) +
  scale_fill_brewer(palette = "Set1", name = "type") +
  # reset the heatmap active context into the heatmap body
  hmanno() +
  # add another heatmap in the stack
  ggheatmap(base_mean) +
  # set the heatmap body width
  hmanno(width = unit(2, "cm")) +
  scale_y_continuous(breaks = NULL) +
  scale_x_continuous(name = "base mean", breaks = FALSE) +
  scale_fill_gradientn(colours = c("#2600D1FF", "white", "#EE3F3FFF")) +
  # set the active context of the heatmap to the top
  # and set the size of the top stack
  hmanno("t", size = unit(4, "cm")) +
  # add box plot in the heatmap top
  ggalign() +
  geom_boxplot(aes(y = value, fill = factor(.extra_panel))) +
  scale_x_continuous(expand = expansion(), breaks = NULL) +
  scale_fill_brewer(palette = "Dark2", guide = "none") +
  theme(axis.title.y = element_blank()) +
  # we move into the stack layout
  stack_active() +
  # add a point plot
  ggalign(data = expr$length, size = unit(2, "cm")) +
  geom_point(aes(x = value)) +
  labs(x = "length") +
  theme(
    panel.border = element_rect(fill = NA),
    axis.text.x = element_text(angle = -60, hjust = 0)
  ) +
  # add another heatmap
  ggheatmap(expr$type) +
  # set the heatmap body width, and remove the spaces in the y-axis
  hmanno(width = unit(2, "cm"), free_spaces = "y") +
  scale_fill_brewer(palette = "Set3", name = "gene type") +
  scale_x_continuous(breaks = NULL, name = "gene type") +
  # add barplot in the top annotation
  hmanno("t") +
  ggalign(limits = FALSE) +
  geom_bar(
    aes(.extra_panel, fill = factor(value)),
    position = position_fill()
  ) +
  scale_x_discrete() +
  scale_y_continuous(expand = expansion()) +
  scale_fill_brewer(palette = "Set3", name = "gene type", guide = "none") &
  theme(plot.margin = margin())