如何在因子*组组合没有观察值的箱线图中保持一致的箱宽？

Question

我正在尝试为跨越多个因素的 2 个组创建一个箱线图以及观察次数的标签。当一个组和一个因子水平没有观察值时，带有观察值的组的框会占用两者的空间并且看起来很奇怪。

小例子：

library(tidyverse)

mtcars %>%
  select(mpg, cyl,am) %>%
  filter(!(cyl == 8 & am == 0)) %>%
  ggplot(aes(factor(cyl),mpg,fill=factor(am))) + 
  stat_boxplot(geom = "errorbar") + ## Draw horizontal lines across ends of whiskers
  geom_boxplot(outlier.shape=1, outlier.size=3, 
               position =  position_dodge(width = 0.75)) +
  geom_text(data = mtcars %>%
              select(mpg, cyl, am) %>%
              filter(!(cyl == 8 & am == 0)) %>%
              group_by(cyl, am) %>%
              summarize(Count = n(),
                      q3 = quantile(mpg, 0.75),
                      iqr = IQR(mpg),
                      lab_pos = max(ifelse(mpg < q3+1.5*iqr, mpg, NA), na.rm = TRUE)),
                      aes(x= factor(cyl), y = lab_pos,label = paste0("n = ",Count, "\n")),
                  position = position_dodge(width = 0.75))

产生：

有没有办法让am(1) 的框在cyl(8) 宽度的一半，所以它与情节上的其他框一致？我曾尝试使用虚假数据，但这会导致am(0) 的计数标签位于cyl(8)。

Answer 1

我在这个网站上看到了一些涉及添加虚假值或使用ggplot_build 的答案。我会考虑使用interaction。这是一个基于您的代码的简单示例：

library(tidyverse)
mtcars %>%
  select(mpg, cyl,am) %>%
  filter(!(cyl == 8 & am == 0)) %>%
  ggplot(aes(reorder(interaction(cyl, am, sep = "/"), -mpg), mpg,
             fill = factor(am))) + 
    geom_boxplot() +
    labs(x = "Cylinders/AM")

另一种选择是对第三个变量使用构面：

mtcars %>%
  select(mpg, cyl,am) %>%
  filter(!(cyl == 8 & am == 0)) %>%
  ggplot(aes(factor(cyl), mpg)) + 
    geom_boxplot() +
    facet_wrap(~am)

Answer 2

通过从 GitHub 安装最新版本的 ggplot2 并使用默认使用 preserve = "single" 的 position_dodge2，我能够得到一个合理的解决方案。

# Install devtools
install.packages('devtools')

# Install dependency of scales package
install.packages(c("RColorBrewer", "stringr", "dichromat", 
                   "munsell", "plyr", "colorspace"))

# Load devtools
library(devtools)

# Move to development mode
# This installed scales and ggplot2 in the "~/R-dev" directory, 
# so CRAN version of ggplot2 is not removed.
dev_mode(TRUE)

# Install scales
install_github("hadley/scales")

# Main branch of development
install_github("hadley/ggplot2", "hadley/develop")

# load development version of ggplot2
library(dplyr)
library(ggplot2)

mtcars %>%
  select(mpg, cyl,am) %>%
  filter(!(cyl == 8 & am == 0)) %>%
  ggplot(aes(factor(cyl),mpg,fill=factor(am))) + 
  stat_boxplot(geom = "errorbar",
               position =  position_dodge2(width = 0.75, preserve = "single")) + 
  geom_boxplot(outlier.shape=1, outlier.size=3, 
               position =  position_dodge2(width = 0.75, preserve = "single")) +
  geom_text(data = mtcars %>%
              select(mpg, cyl, am) %>%
              filter(!(cyl == 8 & am == 0)) %>%
              group_by(cyl, am) %>%
              summarize(Count = n(),
                        q3 = quantile(mpg, 0.75),
                        iqr = IQR(mpg),
                        lab_pos = max(mpg)),
            aes(x= factor(cyl), y = lab_pos,label = paste0("n = ",Count, "\n")),
            position = position_dodge2(width = 0.75, preserve = "single"))