在密度图下方添加箱线图

Question

我是 ggplot 的新手，我正在尝试创建此图：

但实际上，我只是被困在这里：

这是我的代码：

ggplot(diamonds)  + 
  aes(x = carat, group = cut) + 
  geom_line(stat = "density", size = 1) + 
  theme_grey() + 
  facet_wrap(~cut, nrow = 5, strip.position = "right") + 
  geom_boxplot(aes())

有人知道我接下来可以做什么吗？

Answer 1

编辑：从 ggplot2 3.3.0 开始，这可以在 ggplot2 中完成，无需任何扩展包。

在包的 新闻下，在新功能下：

所有具有方向（即 x 轴和 y 轴有不同解释）的几何体和统计数据现在可以自由选择它们的方向，而不是依赖coord_flip() 。 方向是从美学映射推导出来的，但也可以直接使用新的orientation参数（@thomasp85，#3506）指定。

以下现在将直接工作（用geom_boxploth / stat_boxploth替换原始答案中对geom_boxplot / stat_boxplot所有引用：

library(ggplot2)

ggplot(diamonds, aes(x = carat, y = -0.5)) +

  # horizontal boxplots & density plots
  geom_boxplot(aes(fill = cut)) +
  geom_density(aes(x = carat), inherit.aes = FALSE) +
  
  # vertical lines at Q1 / Q2 / Q3
  stat_boxplot(geom = "vline", aes(xintercept = ..xlower..)) +
  stat_boxplot(geom = "vline", aes(xintercept = ..xmiddle..)) +
  stat_boxplot(geom = "vline", aes(xintercept = ..xupper..)) +
  
  facet_grid(cut ~ .) +
  scale_fill_discrete()

---

原答案

这可以通过ggstance包中的水平箱线图geom_boxploth() / stat_boxploth()轻松完成：

library(ggstance)

ggplot(diamonds, aes(x = carat, y = -0.5)) +

  # horizontal box plot
  geom_boxploth(aes(fill = cut)) +

  # normal density plot
  geom_density(aes(x = carat), inherit.aes = FALSE) +

  # vertical lines at Q1 / Q2 / Q3
  stat_boxploth(geom = "vline", aes(xintercept = ..xlower..)) +
  stat_boxploth(geom = "vline", aes(xintercept = ..xmiddle..)) +
  stat_boxploth(geom = "vline", aes(xintercept = ..xupper..)) +
  
  facet_grid(cut ~ .) +
  
  # reproduce original chart's color scale (o/w ordered factors will result
  # in viridis scale by default, using the current version of ggplot2)
  scale_fill_discrete()

如果您由于某种原因被限制在 ggplot2 包中，它仍然可以完成，但它会不那么直接，因为geom_boxplot()和geom_density()走向不同的方向。

备选方案 1 ：计算箱线图的坐标，并在将结果传递给ggplot()之前手动翻转它们。 以正常方式添加密度层：

library(dplyr)
library(tidyr)

p.box <- ggplot(diamonds, aes(x = cut, y = carat)) + geom_boxplot()    
p.box.data <- layer_data(p.box) %>%
  select(x, ymin, lower, middle, upper, ymax, outliers) %>%
  mutate(cut = factor(x, labels = levels(diamonds$cut), ordered = TRUE)) %>%
  select(-x)

ggplot(p.box.data) +
  
  # manually plot flipped boxplot
  geom_segment(aes(x = ymin, xend = ymax, y = -0.5, yend = -0.5)) +
  geom_rect(aes(xmin = lower, xmax = upper, ymin = -0.75, ymax = -0.25, fill = cut),
            color = "black") +
  geom_point(data = . %>% unnest(outliers),
             aes(x = outliers, y = -0.5)) +
  
  # vertical lines at Q1 / Q2 / Q3
  geom_vline(data = . %>% select(cut, lower, middle, upper) %>% gather(key, value, -cut),
             aes(xintercept = value)) +
  
  # density plot
  geom_density(data = diamonds, aes(x = carat)) +

  facet_grid(cut ~ .) +
  labs(x = "carat") +
  scale_fill_discrete()

备选方案 2 ：计算密度图的坐标，并在将结果传递给ggplot()之前手动翻转它们。 以正常方式添加箱线图图层。 翻转整个图表：

p.density <- ggplot(diamonds, aes(x = carat, group = cut)) + geom_density()    
p.density.data <- layer_data(p.density) %>%
  select(x, y, group) %>%
  mutate(cut = factor(group, labels = levels(diamonds$cut), ordered = TRUE)) %>%
  select(-group)
p.density.data <- p.density.data %>%
  rbind(p.density.data %>% 
          group_by(cut) %>% 
          filter(x == min(x)) %>% 
          mutate(y = 0) %>% 
          ungroup())

ggplot(diamonds, aes(x = -0.5, y = carat)) +

  # manually flipped density plot
  geom_polygon(data = p.density.data, aes(x = y, y = x), 
               fill = NA, color = "black") +

  # box plot
  geom_boxplot(aes(fill = cut, group = cut)) +

  # vertical lines at Q1 / Q2 / Q3
  stat_boxplot(geom = "hline", aes(yintercept = ..lower..)) +
  stat_boxplot(geom = "hline", aes(yintercept = ..middle..)) +
  stat_boxplot(geom = "hline", aes(yintercept = ..upper..)) +

  facet_grid(cut ~ .) +
  scale_fill_discrete() +
  coord_flip()

Answer 2

也许这会有所帮助。 虽然几乎不需要升级:)

library(tidyverse)
library(magrittr)
library(wrapr)

subplots <-
diamonds$cut %>%
  unique() %>%
  tibble(Cut = .) %>%
  mutate(rn = row_number() - 1) %$%
  map2(
    .x = Cut,
    .y = rn,
    ~annotation_custom(ggplotGrob(
      diamonds %>%
        filter(cut == .x) %.>%
        ggplot(data = .) + 
        aes(x = carat, fill = cut) + 
        annotation_custom(ggplotGrob(
          ggplot(data = .) +
            geom_boxplot(
              aes(x = -1, y = carat),
              fill = .y + 1
            ) +
            coord_flip() +
            theme_void() +
            theme(plot.margin = margin(t = 20))
        )) +
        geom_line(stat = 'density', size = 1) +
        theme_void() +
        theme(plot.margin = margin(t = .y * 100 + 10, b = (4 - .y) * 100 + 40)) 
    ))
  )

ggplot() + subplots