r - 如何在热图的一个图块上显示两个分类变量 - 三角形图块

Question

我有一个类似于以下示例的数据集

df <- structure(list(Species = structure(c(1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L,3L, 
1L, 2L, 3L), .Label = c("setosa", "versicolor", "virginica"), class = 
"factor"), flower_att = c("Sepal.Length", "Sepal.Length", "Sepal.Length", 
"Sepal.Width", "Sepal.Width", "Sepal.Width", "Petal.Length", "Petal.Length", 
"Petal.Length", "Petal.Width", "Petal.Width", "Petal.Width"), measurement = 
c(5.1, 7, 6.3, 3.5, 3.2, 3.3, 1.4, 4.7, 6, 0.2, 1.4, 2.5), month = 
c("January", "February", "January", "February", "January", "February", 
"January", "February", "January", "February", "January", "February")), 
row.names = c(NA,-12L), class = "data.frame")

我想并排显示每个物种和月份的萼片长度和宽度。我希望使用热图中的对角分割单元来执行此操作，该单元具有 2 个不同的颜色图例，即红色表示长度，蓝色表示宽度。如果可能的话，我希望将值显示在单元格段中。到目前为止，我的搜索找到了这个最接近的例子，但我正在寻找一个可行的 ggplot 版本。

我自己的尝试目前如下所示。我不知道如何分解细胞。

ggplot(df, aes(x=month, y=Species)) +   geom_tile(aes(fill=measurement), 
color="black") +   theme(axis.text.x = element_text(angle=45, hjust = .5)) +   
geom_text(aes(label = round(measurement, .1))) +   scale_fill_gradient(low = 
"white", high = "red")

更新

在互联网上进行了一些认真的挖掘之后，我发现了一个使用geom_segmentand的潜在选项geom_text_repel，见下文。谁能告诉我这是否是一个可行的选择？如果是这样，我怎样才能让它满足上述要求？

我愿意切换scale_fill_gradient到scale_fill_manual或其他替代方案，我的主要目标是让所有数据并排显示

ggplot(df, aes(x=month, y=Species)) +
geom_tile(aes(fill=measurement), color="black") +
theme(axis.text.x = element_text(angle=45, hjust = .5)) +
geom_text_repel(aes(label = round(measurement, .1))) +
scale_fill_gradient(low = "white", high = "red")

gb <- ggplot_build(p)

p + geom_segment(data=gb$data[[1]],
aes(x=xmin, xend=xmax, y=ymin, yend=ymax), color="black")

标签： rggplot2heatmapggrepel

Answer 1

这有点 hacky，但老实说，如果不创建专用的 geom，我认为你不能让它变得不那么 hacky - 创建 geom 也会变得有点 hacky :)

• 使用 为每个 x/y 坐标创建三角形多边形sapply。我想你可以在你的层使用这种方法compute_group在你的未来StatSplitTile。
• 弄乱因素是使秩序正确的必要之恶。如果您想要 y 轴上的特定顺序，您还需Species要先进行因式分解。
• ggnewscale用于具有多个填充比例的非常简单的方法。
• 设置相同的限制以获得更好的可比性
• coord_equal 让它看起来更好

library(tidyverse)

mydat <- structure(list(Species = structure(c(1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L), .Label = c("setosa", "versicolor", "virginica"), class = "factor"), flower_att = c("Sepal.Length", "Sepal.Length", "Sepal.Length", "Sepal.Width", "Sepal.Width", "Sepal.Width", "Petal.Length", "Petal.Length", "Petal.Length", "Petal.Width", "Petal.Width", "Petal.Width"), measurement = c(5.1, 7, 6.3, 3.5, 3.2, 3.3, 1.4, 4.7, 6, 0.2, 1.4, 2.5), month = c("January", "February", "January", "February", "January", "February", "January", "February", "January", "February", "January", "February")),
  row.names = c(NA, -12L), class = "data.frame"
)

make_triangles <- function(x, y, point = "up") {
  x <- as.integer(as.factor((x)))
  y <- as.integer(as.factor((y)))

  if (point == "up") {
    newx <- sapply(x, function(x) {
      c(x - 0.5, x - 0.5, x + 0.5)
    }, simplify = FALSE)
    newy <- sapply(y, function(y) {
      c(y - 0.5, y + 0.5, y + 0.5)
    }, simplify = FALSE)
  } else if (point == "down") {
    newx <- sapply(x, function(x) {
      c(x - 0.5, x + 0.5, x + 0.5)
    }, simplify = FALSE)
    newy <- sapply(y, function(y) {
      c(y - 0.5, y - 0.5, y + 0.5)
    }, simplify = FALSE)
  }
  data.frame(x = unlist(newx), y = unlist(newy))
}

# required, otherwise you cannot use the values as fill
mydat_wide <- mydat %>% pivot_wider(names_from = "flower_att", values_from = "measurement")
# making your ordered months factor
mydat_wide$month <- droplevels(factor(mydat_wide$month, levels = month.name))
# The actual triangle computation
newcoord_up <- make_triangles(mydat_wide$month, mydat_wide$Species)
newcoord_down <- make_triangles(mydat_wide$month, mydat_wide$Species, point = "down")
# just a dirty trick for renaming
newcoord_down <- newcoord_down %>% select(xdown = x, ydown = y)
# you need to repeat each row of your previous data frame 3 times
repdata <- map_df(1:nrow(mydat_wide), function(i) mydat_wide[rep(i, 3), ])
newdata <- bind_cols(repdata, newcoord_up, newcoord_down)

ggplot(newdata) +
  geom_polygon(aes(x = x, y = y, fill = Sepal.Length, group = interaction(Species, month)), color = "black") +
  scale_fill_gradient(low = "white", high = "red", limits = c(0, 10)) +
  ggnewscale::new_scale_fill() +
  geom_polygon(aes(x = xdown, y = ydown, fill = Sepal.Width, group = interaction(Species, month)), color = "black") +
  scale_fill_gradient(low = "white", high = "red", limits = c(0, 10)) +
  scale_x_continuous(breaks = seq_along(unique(mydat_wide$month)), 
                     labels = unique(levels(mydat_wide$month))) +
  scale_y_continuous(breaks = seq_along(unique(mydat_wide$Species)),
                     labels = unique(mydat_wide$Species))+
  coord_equal()

^{由reprex 包（v0.3.0）于 2021-01-27 创建}