Plot ribbon between lines created with geom_abline

Question

I am trying to create a shaded area between lines created with geom_abline

require(ggplot2)

val_intcpt <- c(-1,1)

ggplot() + 
  geom_point(data = iris, mapping = aes(x = Petal.Length, y = Sepal.Width)) +
  geom_abline(intercept = 0, slope = 1, linetype = 'dashed') +
  geom_abline(intercept = val_intcpt, slope = 1, linetype = 'dotted')

The idea would be to shade the area between the dotted lines.

geom_ribbon doesn't work because it requires ymin/ymax and I do not have this information (of course, I could just hardcode a data frame, but this is not exactly a great solution, as it would not work automatically for any given data.)
Using ggplot_build doesn't help because the data frames do not provide x/y data.

I am sure I am missing something very obvious:(

user_8449629 · Answer

Plot a polygon, perhaps?

# let ss be the slope for geom_abline
ss <- 1

p <- ggplot() + 
  geom_point(data = iris, mapping = aes(x = Petal.Length, y = Sepal.Width)) +
  geom_abline(intercept = 0, slope = ss, linetype = 'dashed') +
  geom_abline(intercept = val_intcpt, slope = ss, linetype = 'dotted') 

# get plot limits
p.x <- layer_scales(p)$x$get_limits()
p.y <- layer_scales(p)$y$get_limits()

# create polygon coordinates, setting x positions somewhere
# beyond the current plot limits
df <- data.frame(
  x = rep(c(p.x[1] - (p.x[2] - p.x[1]),
            p.x[2] + (p.x[2] - p.x[1])), each = 2),
  intcpt = c(val_intcpt, rev(val_intcpt))
) %>%
  mutate(y = intcpt + ss * x)

# add polygon layer, & constrain to previous plot limits
p +
  annotate(geom = "polygon",
           x = df$x,
           y = df$y,
           alpha = 0.2) +
  coord_cartesian(xlim = p.x, ylim = p.y)

Explanation for why it works

Let's consider a normal plot:

ss <- 0.75 # this doubles up as illustration for different slope values

p <- ggplot() +
  geom_point(data = iris, aes(x = Petal.Length, y = Sepal.Width), color = "grey75") +
  geom_abline(intercept = val_intcpt, slope = ss, linetype = 'dashed', 
              color = c("blue", "red"), size = 1) +
  annotate(geom = "text", x = c(6, 3), y = c(2.3, 4), color = c("blue", "red"), size = 4,
           label = c("y == a[1] + b*x", "y == a[2] + b*x"), parse = TRUE)
  coord_fixed(ratio = 1.5) +
  theme_classic()

p + ggtitle("Step 0: Construct plot")

Get the limits p.x / p.y from the p, & take a look at the corresponding locations in the plot itself (in purple):

p.x <- layer_scales(p)$x$get_limits()
p.y <- layer_scales(p)$y$get_limits()

p1 <- p + 
  geom_point(data = data.frame(x = p.x, y = p.y) %>% tidyr::complete(x, y),
             aes(x = x, y = y), 
             size = 2, stroke = 1, color = "purple")

p1 + ggtitle("Step 1: Get plot limits")

Take note of the values for the x-axis limits (still in purple):

p2 <- p1 +
  annotate(geom = "text", x = p.x, y = min(p.y), label = c("x[0]", "x[1]"), 
           vjust = -1, parse = TRUE, color = "purple", size = 4)

p2 + 
  ggtitle("Step 2: Note x-axis coordinates of limits") +
  annotate(geom = "segment", 
           x = p.x[1] + diff(p.x), 
           xend = p.x[2] - diff(p.x), 
           y = min(p.y), yend = min(p.y),
           color = "purple", linetype = "dashed", size = 1,
           arrow = arrow(ends = "both")) +
  annotate(geom = "text", x = mean(p.x), y = min(p.y), label = "x[1] - x[0]",
           vjust = -1, parse = TRUE, color = "purple", size = 4)

We want to construct a polygon (a parallelogram, to be precise) with corners far beyond the original plot's range, so that none of it is visible within the plot. One way to achieve this is to take the existing plot's x-axis limits & shifting them outwards by the same amount as the existing plot's x-axis range: the resulting positions (in black) are pretty far out:

p3 <- p2 +
  annotate(geom = "point", 
           x = c(p.x[1] - diff(p.x), p.x[2] + diff(p.x)), y = min(p.y),
           shape = 4, size = 1, stroke = 2) +
  annotate(geom = "text", 
           x = c(p.x[1] - diff(p.x), p.x[2] + diff(p.x)), y = min(p.y),
           label = c("x[0] - (x[1] - x[0])", "x[1] + (x[1] - x[0])"),
           vjust = -1, parse = TRUE, size = 5, hjust = c(0, 1))

p3 +
  ggtitle("Calculate x-axis coordinates of two points far beyond the limits") +
  annotate(geom = "segment", 
           x = p.x, 
           xend = p.x + c(-diff(p.x), diff(p.x)), 
           y = min(p.y), yend = min(p.y),
           linetype = "dashed", size = 0.5,
           arrow = arrow(ends = "both", length = unit(0.1, "inches")))

We can derive the corresponding y values associated with the x-axis positions, for each geom_abline (in red / blue), using the standard y = a + b * x formula:

p4 <- p3 + 
  annotate(geom = "point",
           x = c(p.x[1] - diff(p.x), p.x[2] + diff(p.x)),
           y = val_intcpt[2] + ss * c(p.x[1] - diff(p.x), p.x[2] + diff(p.x)),
           shape = 8, size = 2, stroke = 2, col = "red") + 
  annotate(geom = "point",
           x = c(p.x[1] - diff(p.x), p.x[2] + diff(p.x)),
           y = val_intcpt[1] + ss * c(p.x[1] - diff(p.x), p.x[2] + diff(p.x)),
           shape = 8, size = 2, stroke = 2, col = "blue")

p4 +
  ggtitle("Calculate the corresponding y coordinates for both ab-lines") +
  annotate(geom = "text",
           x = p.x[1] - diff(p.x),
           y = val_intcpt + ss * (p.x[1] - diff(p.x)),
           label = c("y == a[1] + b * (x[0] - (x[1] - x[0]))", 
                     "y == a[2] + b * (x[0] - (x[1] - x[0]))"), 
           hjust = -0.2, parse = TRUE, 
           color = c("blue", "red")) +
  annotate(geom = "text",
           x = p.x[2] + diff(p.x),
           y = val_intcpt + ss * (p.x[2] + diff(p.x)),
           label = c("y == a[1] + b * (x[1] + (x[1] - x[0]))", 
                     "y == a[2] + b * (x[1] + (x[1] - x[0]))"), 
           hjust = 1.2, parse = TRUE, 
           color = c("blue", "red"))

Now that we have the x / y coordinates for the corners, constructing the polygon is a simple matter of joining them together:

p5 <- p4 +
  annotate(geom = "polygon",
           x = rep(c(p.x[1] - diff(p.x),
                     p.x[2] + diff(p.x)),
                   each = 2),
           y = c(val_intcpt + ss * (p.x[1] - diff(p.x)),
                 rev(val_intcpt) + ss * (p.x[2] + diff(p.x))),
           fill = "yellow", alpha = 0.4)

p5 +
  ggtitle("Step 5: Draw polygon based on calculated coordinates") +
  annotate(geom = "label",
           x = rep(c(p.x[1] - diff(p.x),
                     p.x[2] + diff(p.x)),
                   each = 2),
           y = c(val_intcpt + ss * (p.x[1] - diff(p.x)),
                 rev(val_intcpt) + ss * (p.x[2] + diff(p.x))),
           label = c("list(x[0] - (x[1] - x[0]), a[1] + b*(x[0] - (x[1] - x[0])))",
                     "list(x[0] - (x[1] - x[0]), a[2] + b*(x[0] - (x[1] - x[0])))",
                     "list(x[1] + (x[1] - x[0]), a[2] + b*(x[1] + (x[1] - x[0])))",
                     "list(x[1] + (x[1] - x[0]), a[1] + b*(x[1] + (x[1] - x[0])))"),
           parse = TRUE, hjust = rep(c(0, 1), each = 2))

Apply the original plot range, & we have a polygon pretending to be a filled ribbon, with corners safely hidden out of the way beyond view:

p5 +
  ggtitle("Step 6: Reset plot range to original range") +
  coord_fixed(ratio = 1.5, xlim = p.x, ylim = p.y)

(Note: There's a lot of unnecessary code here, to label & colour intermediate steps for illustration purpose. For actual use, as per my original solution, none of that is necessary. But as far as explanation goes, it's either this or sketch + scan in my crappy handwriting...)

Plot ribbon between lines created with geom_abline

1 Answers

Explanation for why it works