How do you simultaneously use `group_by()` and `ggplot_build()` with facets? - r

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"
)
The code chunk above determines the y-values of the control limits (red lines) from the ggplot_build() function. It then draws red circles around outliers. This works great until I facet the plot. It's because the logic of thres <- range(pb$data[[3]]$yintercept) isn't "smart" enough to wade through the different facet groupings.
# 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
How do I get my code block below to work properly and circle the outliers? I obviously need a more sophisticated thres2, that can recognize there are different groupings of control limits (red lines) between the different facets.
# 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

I think the best way is to get the ranges in the same data.frame as your data. I'am not sure if this is the most elegant solution, but it works with your example:
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")
Cheers, Rico