你如何同时使用 `group_by()` 和 `ggplot_build()` 和 facets？

Question

# Create the Data Frame
library(tidyverse)
library(ggQC)
set.seed(5555)
Golden_Egg_df <- data.frame(month = 1:12, 
                            egg_diameter = rnorm(n=12, mean=1.5, sd=0.2)) %>% 
  mutate(grp = c(rep("A", 3), rep("B", 9)))
Golden_Egg_df$egg_diameter[3] <- 5

# Determine the control limit values (red lines)
p <- ggplot(Golden_Egg_df, aes(x = month, y = egg_diameter)) +
  geom_point() + 
  geom_line() + 
  stat_QC(method = "XmR")
pb <- ggplot_build(p)
thres <- range(pb$data[[3]]$yintercept)

# Circle anything outside the control limits (red lines)
p + geom_point(
  data = subset(Golden_Egg_df,
                egg_diameter > max(thres) | egg_diameter < min(thres)),
  shape = 21,
  size = 4,
  col = "red"
)

上面的代码块确定了来自ggplot_build() 函数的控制限（红线）的 y 值。然后它在异常值周围绘制红色圆圈。在我处理情节之前，这很有效。这是因为thres <- range(pb$data[[3]]$yintercept) 的逻辑不够“聪明”，无法涉足不同的方面分组。

# ONLY ONE 'Y-INTERCEPT' RANGE HERE TO WORRY ABOUT WITHOUT FACETING
#> $`data`[[3]]
#>   yintercept          y    x label
#> 1 -0.2688471 -0.2688471 -Inf   LCL
#> 2  3.7995203  3.7995203 -Inf   UCL
#> 3 -0.2688471 -0.2688471  Inf  -0.3
#> 4  3.7995203  3.7995203  Inf   3.8

# MULTIPLE 'Y-INTERCEPT' RANGES HERE TO WORRY ABOUT WITH FACETING
#> $`data`[[3]]
#>   yintercept          y    x label
#> 1 -0.8759612 -0.8759612 -Inf   LCL
#> 2  4.5303358  4.5303358 -Inf   UCL
#> 3 -0.8759612 -0.8759612  Inf  -0.9
#> 4  4.5303358  4.5303358  Inf   4.5
#> 5  1.2074161  1.2074161 -Inf   LCL
#> 6  1.9521532  1.9521532 -Inf   UCL
#> 7  1.2074161  1.2074161  Inf   1.2
#> 8  1.9521532  1.9521532  Inf     2

如何让下面的代码块正常工作并圈出异常值？我显然需要一个更复杂的thres2，它可以识别不同方面之间存在不同的控制限制分组（红线）。

# Determine the control limit values (red lines)
Golden_Egg_df$egg_diameter[11] <- 5
p2 <- ggplot(Golden_Egg_df, aes(x = month, y = egg_diameter)) +
  geom_point() + 
  geom_line() + 
  stat_QC(method = "XmR") + 
  facet_grid(~ grp, scales = "free_x", space = "free_x") + 
  scale_x_continuous(breaks = 1:12, labels = month.abb)
pb2 <- ggplot_build(p2)
thres2 <- range(pb2$data[[3]]$yintercept)
thres2
#> [1] -2.274056  7.445141

# Circle anything outside the control limits (red lines)
p2 + geom_point(
  data = subset(Golden_Egg_df,
                egg_diameter > max(thres2) | egg_diameter < min(thres2)),
  shape = 21,
  size = 4,
  col = "red"
)

Answer 1

我认为最好的方法是在与您的数据相同的 data.frame 中获取范围。我不确定这是否是最优雅的解决方案，但它适用于您的示例：

library(tidyverse)
library(ggQC)
set.seed(5555)
Golden_Egg_df <- data.frame(month = 1:12, 
                            egg_diameter = rnorm(n=12, mean=1.5, sd=0.2)) %>% 
  mutate(grp = c(rep("A", 3), rep("B", 9)))
Golden_Egg_df$egg_diameter[3] <- 5
Golden_Egg_df$egg_diameter[11] <- 5

# create the plot
p2 <- ggplot(Golden_Egg_df, aes(x = month,
                                y = egg_diameter)) +
  geom_point() + 
  geom_line() + 
  stat_QC(method = "XmR") + 
  facet_grid(~ grp,
             scales = "free_x",
             space = "free_x") + 
  scale_x_continuous(breaks = 1:12,
                     labels = month.abb)

# get all the info about the plot
pb2 <- ggplot_build(p2)
# extract the UCL and LCL for each plot (facet)
Golden_Egg_df <- Golden_Egg_df %>% 
  mutate(min = ifelse(grp == "A", 
                      min(pb2$data[[3]]$yintercept[1:4]),    # LCL of 1st plot 
                      min(pb2$data[[3]]$yintercept[5:8])),   # LCL of 1st plot
         max = ifelse(grp == "A", 
                      max(pb2$data[[3]]$yintercept[1:4]),    # UCL 2nd plot 
                      max(pb2$data[[3]]$yintercept[5:8])))   # UCL 2nd plot

# add the circled outlier
p2 + geom_point(data = subset(Golden_Egg_df,
                              egg_diameter > max |
                                egg_diameter < min),
                shape = 21,
                size = 4,
                col = "red")

干杯，里科