ggplot2中单独的符号和行键连接图例

Question

我有一个类似于以下的图，其中线型和形状映射到同一变量。我想保留连接的图例，但希望图例中的点在线上方，以便我可以更好地看到线型。任何帮助表示赞赏。

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

感谢@starja 的提示，

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"))

请注意，此函数需要两个未导出的ggplot2函数（`%||%`和translate_shape_string），这将导致此函数（如果添加到包中）无法通过 R 检查。将这些函数的当前版本复制到包代码中并不难，有效地及时冻结它们的主体，认识到您需要使包与 ggplot2 中的更改/错误修复保持最新。

此函数将一组硬编码默认值 ( 0.5, 0.5) 替换为另一组硬编码默认值 ( 0.5, 0.9)。显然还有其他方法可以解决这个问题，例如函数返回一个函数：

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"))

其中可以设置任何键/图例字形组件（x、y、颜色、形状、alpha、填充、大小）。