ggplot2 中单独的符号和线路键加入图例

Question

I have a plot similar to the following which has both l.netype and shape mappings to the same variable. I would like to keep the joined legend but would like the point in the legend to be above the line so I can better see the l.netype. Any help is appreciated.

library(tidyverse)
library(grid)

ggplot(mtcars, aes(gear, mpg, 
                   shape = factor(cyl), 
                   linetype = factor(cyl),
                   color = factor(cyl))) + 
  geom_point(size = 2) +
  stat_summary(fun = mean, geom = "line", size = 1)+
  theme(legend.key.width  = grid::unit(0.5, "inch"))

Answer 1

Thanks to @starja's cue,

draw_key_point2 <- function (data, params, size) {
  `%||%` <- ggplot2:::`%||%`
  if (is.null(data$shape)) {
    data$shape <- 19
  }
  else if (is.character(data$shape)) {
    data$shape <- ggplot2:::translate_shape_string(data$shape)
  }
  stroke_size <- data$stroke %||% 0.5
  stroke_size[is.na(stroke_size)] <- 0
  grid::pointsGrob(0.5, 0.9, pch = data$shape,
                   gp = grid::gpar(col = alpha(data$colour %||% "black", data$alpha),
                                   fill = alpha(data$fill %||% "black", data$alpha),
                                   fontsize = (data$size %||% 1.5) * .pt + stroke_size * .stroke/2,
                                   lwd = stroke_size * .stroke/2))
}

ggplot(mtcars, aes(gear, mpg, 
                   shape = factor(cyl), 
                   linetype = factor(cyl),
                   color = factor(cyl))) + 
  # geom_point(size = 2) +
  geom_point(size = 2, key_glyph = draw_key_point2) +
  stat_summary(fun = mean, geom = "line", size = 1)+
  theme(legend.key.width  = grid::unit(0.5, "inch"))

Note that this function needs two unexported ggplot2 functions ( `%||%` and translate_shape_string ), which will cause this function (if added to a package) to not pass R checks. It's not hard to copy the current version of those functions into your package code, effectively freezing-in-time their bodies, recognizing that you would need to keep your package up-to-date with changes/bug-fixes in ggplot2.

This function replaces one set of hard-coded defaults ( 0.5, 0.5 ) with another set of hard-coded defaults ( 0.5, 0.9 ). Obviously there are other ways to address this, such as a function returning a function:

draw_key_point3 <- function(...) {
  function(data, params, size) {
    `%||%` <- ggplot2:::`%||%`
    dots <- list(...)
    colour <- dots$colour %||% dots$color %||% data$colour %||% "black"
    shape <- dots$shape %||% data$shape %||% 19L
    alpha <- dots$alpha %||% data$alpha
    if (is.character(shape)) {
      shape <- ggplot2:::translate_shape_string(shape)
    }
    stroke_size <- dots$stroke %||% data$stroke %||% 0.5
    stroke_size[is.na(stroke_size)] <- 0
    grid::pointsGrob(dots$x %||% 0.5, dots$y %||% 0.5, pch = shape,
                     gp = grid::gpar(col = alpha(colour, alpha),
                                     fill = alpha(dots$fill %||% data$fill %||% "black", alpha),
                                     fontsize = (dots$size %||% data$size %||% 1.5) * .pt + stroke_size * .stroke/2,
                                     lwd = stroke_size * .stroke/2))
  }
}
ggplot(mtcars, aes(gear, mpg, 
                   shape = factor(cyl), 
                   linetype = factor(cyl),
                   color = factor(cyl))) + 
  geom_point(size = 2, key_glyph = draw_key_point3(x=0.5, y=0.1, shape = 18)) +
  stat_summary(fun = mean, geom = "line", size = 1)+
  theme(legend.key.width  = grid::unit(0.5, "inch"))

where one can set any of the key/legend glyph components (x, y, colour, shape, alpha, fill, size).