Rotate legend keys of geom_abline

Question

I would like to rotate the legends keys of geom_abline to a horizontal legend key or if possible based on their slope. Here is some reproducible code (dput df below):

library(ggplot2)
p = ggplot(df, mapping = aes(x = x, y = y)) +
  geom_point() +
  geom_abline(df, mapping = aes(slope = slope, intercept = 0, color = factor(group))) +
  coord_cartesian(xlim = c(0, 3), ylim = c(0, 3)) 
p

^{Created on 2023-04-19 with reprex v2.0.2}

I tried using @Sandy Muspratt his answer here with grid functions, but that also rotates the ablines and the legend keys. So I was wondering if anyone knows how to rotate the legend keys of geom_abline?

---

dput df:

df<-structure(list(x = c(0, 0, 0), y = c(0, 0, 0), slope = c(0.5, 
1, 0.75), group = c("A", "B", "C")), class = "data.frame", row.names = c(NA, 
-3L))

Answer 1

The solution here lies in defining a new draw key. However, as Tjebo points out in the comments, it is difficult to customize the slopes this way because the data passed to the draw_key_* functions does not contain all the aesthetic data - only that necessary to make the standard draw keys (linewidth, colour, fill, etc).

One way round this is to take advantage of the fact that ggplots are built using the ggproto system, which itself is based on nested environments. A custom draw_key_* function can be written that looks up the appropriate ancestor frame to find the whole aesthetic data set:

draw_key_custom <- function (data, params, size) {
  colour <- data$colour 
  datalist <- get("data", parent.frame((10)))
  i <- which(sapply(datalist, function(x) "slope" %in% names(x)))[1]
  data <- datalist[[i]]
  data <- data[data$colour == colour,]
  slope <- data$slope
  intercept <- (1 - slope)/2
  y1 <- ifelse(abs(slope) > 1, (sign(slope) + 1)/2, intercept)
  y2 <- ifelse(abs(slope) > 1, 1 - (sign(slope) + 1)/2, intercept + slope)
  x1 <- ifelse(abs(slope) > 1, (y1 - intercept)/slope, 0)
  x2 <- ifelse(abs(slope) > 1, (y2 - intercept)/slope, 1)
  grid::segmentsGrob(x1, y1, x2, y2,
               gp = grid::gpar(col = data$colour, 
                               lwd = data$linewidth * 2))
}

This allows:

ggplot(df, mapping = aes(x = x, y = y)) +
  geom_point() +
  geom_abline(aes(slope = slope, intercept = 0, color = factor(group)),
              key_glyph = draw_key_custom) +
  coord_cartesian(xlim = c(0, 3), ylim = c(0, 3))

A couple of things I would point out are that:

1. It is unusual and unnecessary to change slopes in a legend
2. The resulting slopes will not necessarily match the slopes in the plot unless the aspect ratios of the legend keys fit the aspect ratio of the plotting panel. This ratio is not stable under plot resizing unless the aspect ratio is specified in theme
3. The above implementation is fragile to changes within ggplot, and may not work if multiple lines have the same colour.

Still, nice to know it can be done I suppose...

Answer 2

Not a real answer to the question, and I understand that this was also more about proof of concept. And it is absolutely amazing to think of all the possibilities that arise from it. However, I believe it is important to offer an alternative especially for future readers who might have a fancy legend in mind although the arguably better solution might be:

No legend.

You could avoid a legend altogether by simply direct labelling, here basically improving on Allan's answer with Allan's very own geomtextpath package.

library(geomtextpath)

ggplot(df, mapping = aes(x = x, y = y)) +
  geom_point() +
  geom_textabline(aes(label = group, slope = slope, intercept = 0, color = group), hjust = .8) +
  coord_cartesian(xlim = c(0, 3), ylim = c(0, 3)) +
  theme(legend.position = "none")