如何在ggplot2中创建基本R图'type = b'等价物？

Question

Base plot()功能允许设置type='b'并获得组合线和点图，其中点与线段偏移

plot(pressure, type = 'b', pch = 19)

我可以轻松地创建一个带有线和点的 ggplot，如下所示。

ggplot(pressure, aes(temperature, pressure)) + 
  geom_line() + 
  geom_point()

然而，这些线一直延伸到这些点。 我可以设想一种方法，我可以使用其他 geoms（例如geom_segment() ？）将type='b'功能组合在一起，但我想知道是否有更直接的方法来使用geom_line()和geom_point() 。

Answer 1

这样做的一个有点hacky的方法是在更大的白点上过度绘制一个小黑点：

ggplot(pressure, aes(temperature, pressure)) + 
  geom_line() +
  geom_point(size=5, colour="white") + 
  geom_point(size=2) + 
  theme_classic() +
  theme(panel.background = element_rect(colour = "black"))

此外，在 ggplot 中的控制点边框厚度之后，在ggplot2的 2.0.0 版本中，可以使用geom_point的stroke参数来控制边框厚度，因此两个geom_point可以替换为（例如） geom_point(size=2, shape=21, fill="black", colour="white", stroke=3) ，无需叠加点。

Answer 2

一种比手动将笔触颜色与面板背景匹配更简单的选项是预先获取面板背景，从theme_get获取默认主题，或者使用您将使用的特定主题。 使用像21这样的描边形状可以使内圈变黑并使描边与背景颜色相同。

library(ggplot2)

bgnd <- theme_get()$panel.background$fill

ggplot(pressure, aes(x = temperature, y = pressure)) + 
  geom_line() + 
  geom_point(shape = 21, fill = "black", size = 2, stroke = 1, color = bgnd)

几个 SO 问题（这里是一个）处理缩短点之间的段背后的数学。 这是简单但乏味的几何。 但是自从这个问题第一次发布以来， lemon包已经出来了，它有一个geom来做这个。 它有关于如何计算缩短的参数，这可能只需要一些简单的调整。

library(lemon)

ggplot(pressure, aes(x = temperature, y = pressure)) +
  geom_pointline()

Answer 3

好的，我有一个 geom 的实现，它不依赖于硬编码，也不应该有奇怪的偏移量。 它本质上是一个geom_point()实现，它在点之间绘制路径*，绘制一个更大的背景点，颜色设置为面板背景，然后是法线点。

*请注意，路径的行为不是沿 x 轴连接点，而是沿提供给 ggplot 的data.frame中的行顺序连接。 如果您想要geom_line()行为，您可以事先对数据进行排序。

对我来说，主要问题是获取 geom 绘图代码的内部工作原理，以检索当前绘图的主题以提取面板的背景颜色。 因此，我非常不确定这会有多稳定（并欢迎任何提示），但至少它有效。

编辑：现在应该更稳定

让我们进入公认冗长的ggproto目标代码：

GeomPointPath <- ggproto(
  "GeomPointPath", GeomPoint,
  draw_panel = function(self, data, panel_params, coord, na.rm = FALSE)
  {

    # bgcol <- sys.frame(4)$theme$panel.background$fill
    # if (is.null(bgcol)) {
    #   bgcol <- theme_get()$panel.background$fill
    # }

    # EDIT: More robust bgcol finding -----------
    # Find theme, approach as in https://github.com/tidyverse/ggplot2/issues/3116
    theme <- NULL
    for(i in 1:20) {
      env <- parent.frame(i)
      if("theme" %in% names(env)) {
        theme <- env$theme
        break
      }
    }
    if (is.null(theme)) {
      theme <- theme_get()
    }

    # Lookup likely background fills
    bgcol <- theme$panel.background$fill
    if (is.null(bgcol)) {
      bgcol <- theme$plot.background$fill
    }
    if (is.null(bgcol)) {
      bgcol <- theme$rect$fill
    }
    if (is.null(bgcol)) {
      # Default to white if no fill can be found
      bgcol <- "white"
    }
    # END EDIT ------------------

    if (is.character(data$shape)) {
      data$shape <- ggplot2:::translate_shape_string(data$shape)
    }

    coords <- coord$transform(data, panel_params)

    # Draw background points
    bgpoints <- grid::pointsGrob(
      coords$x, coords$y, pch = coords$shape,
      gp = grid::gpar(
        col = alpha(bgcol, NA), 
        fill = alpha(bgcol, NA),
        fontsize = (coords$size * .pt + coords$stroke * .stroke/2) * coords$mult,
        lwd = coords$stroke * .stroke/2
      )
    )

    # Draw actual points
    mypoints <- grid::pointsGrob(
      coords$x, coords$y, pch = coords$shape, 
      gp = grid::gpar(
        col = alpha(coords$colour, coords$alpha), 
        fill = alpha(coords$fill, coords$alpha), 
        fontsize = coords$size * .pt + coords$stroke * .stroke/2, 
        lwd = coords$stroke * .stroke/2
      )
    )

    # Draw line
    myline <- grid::polylineGrob(
      coords$x, coords$y, 
      id = match(coords$group, unique(coords$group)),
      default.units = "native",
      gp = grid::gpar(
        col = alpha(coords$colour, coords$alpha),
        fill = alpha(coords$colour, coords$alpha),
        lwd = (coords$linesize * .pt),
        lty = coords$linetype,
        lineend = "butt",
        linejoin = "round", linemitre = 10
      )
    )

    # Place graphical objects in a tree
    ggplot2:::ggname(
      "geom_pointpath",
      grid::grobTree(myline, bgpoints, mypoints) 
    )
  },
  # Set some defaults, assures that aesthetic mappings can be made
  default_aes = aes(
    shape = 19, colour = "black", size = 1.5, fill = NA, alpha = NA, stroke = 0.5,
    linesize = 0.5, linetype = 1, mult = 3,
  )
)

细心的人可能已经注意到bgcol <- sys.frame(4)$theme$panel.background$fill 。 我找不到另一种方法来访问当前情节的主题，而不必调整至少其他几个函数来将主题作为参数传递。 在我的 ggplot (3.1.0) 版本中，第 4 个sys.frame()是ggplot2:::ggplot_gtable.ggplot_built调用的环境，其中评估了ggplot2:::ggplot_gtable.ggplot_built绘图代码。 很容易想象这个功能可以在未来更新 - 这可以改变范围 - 因此稳定性警告。 作为备份，当找不到当前主题时，它默认为全局主题设置。

编辑：现在应该更稳定

继续层包装，这几乎是不言自明的：

geom_pointpath <- function(mapping = NULL, data = NULL, stat = "identity",
                           position = "identity", ..., na.rm = FALSE, show.legend = NA,
                           inherit.aes = TRUE)
{
  layer(data = data, mapping = mapping, stat = stat, geom = GeomPointPath,
        position = position, show.legend = show.legend, inherit.aes = inherit.aes,
        params = list(na.rm = na.rm, ...))
}

将它添加到 ggplot 应该是一件熟悉的事情。 只需将主题设置为默认的theme_gray()即可测试它是否确实采用了当前情节的主题。

theme_set(theme_gray())
g <- ggplot(pressure, aes(temperature, pressure)) +
  geom_pointpath() +
  theme(panel.background = element_rect(fill = "dodgerblue"))

当然，这种方法会用背景点模糊网格线，但这是我愿意为防止由于线路径缩短而导致不稳定的权衡。 可以使用aes(linesize = ..., linetype = ..., mult = ...)或根据geom_pointpath()的...参数设置线条大小、线条类型和背景点的相对大小。 它继承了GeomPoint的其他美学。

Answer 4

我很抱歉回答了两次，但这似乎完全不同，值得一个不同的答案。

我已经对这个问题进行了更多思考，我承认几何方法确实比点对点方法更好。 但是，几何方法有其自身的一系列问题，即在绘制时间之前预计算坐标的任何尝试都会以一种或另一种方式给您一些偏斜（请参阅@Tjebo 的后续问题）。

除了通过手动设置纵横比或使用facet_grid()的space参数之外，几乎不可能先验地知道图的纵横比或确切大小。 因为这是不可能的，所以如果调整图的大小，任何预先计算的坐标集都将是不够的。

我无耻地从其他人那里窃取了一些好主意，所以感谢 @Tjebo 和 @moody_mudskipper 的数学和功劳，感谢 ggplot 大师thomasp85和 ggforce 包在绘制时进行计算灵感。

继续吧； 首先，我们将像以前一样定义我们的 ggproto，现在为我们的路径创建一个自定义的 grob 类。 一个重要的细节是我们将 xy 坐标转换为正式单位。

GeomPointPath <- ggproto(
  "GeomPointPath", GeomPoint,
  draw_panel = function(data, panel_params, coord, na.rm = FALSE){

    # Default geom point behaviour
    if (is.character(data$shape)) {
      data$shape <- translate_shape_string(data$shape)
    }
    coords <- coord$transform(data, panel_params)
    my_points <- pointsGrob(
      coords$x, 
      coords$y, 
      pch = coords$shape, 
      gp = gpar(col = alpha(coords$colour, coords$alpha), 
                fill = alpha(coords$fill, coords$alpha), 
                fontsize = coords$size * .pt + coords$stroke * .stroke/2, 
                lwd = coords$stroke * .stroke/2))

    # New behaviour
    ## Convert x and y to units
    x <- unit(coords$x, "npc")
    y <- unit(coords$y, "npc")

    ## Make custom grob class
    my_path <- grob(
      x = x,
      y = y,
      mult = (coords$size * .pt + coords$stroke * .stroke/2) * coords$mult,
      name = "pointpath",
      gp = grid::gpar(
        col = alpha(coords$colour, coords$alpha),
        fill = alpha(coords$colour, coords$alpha),
        lwd = (coords$linesize * .pt),
        lty = coords$linetype,
        lineend = "butt",
        linejoin = "round", linemitre = 10
      ),
      vp = NULL,
      ### Now this is the important bit:
      cl = 'pointpath'
    )

    ## Combine grobs
    ggplot2:::ggname(
      "geom_pointpath",
      grid::grobTree(my_path, my_points) 
    )
  },
  # Adding some defaults for lines and mult
  default_aes = aes(
    shape = 19, colour = "black", size = 1.5, fill = NA, alpha = NA, stroke = 0.5,
    linesize = 0.5, linetype = 1, mult = 0.5,
  )
)

通过面向对象编程的魔力，我们现在可以为我们的新 grob 类编写一个新方法。 虽然这本身可能很无趣，但如果我们为makeContent编写这个方法就会变得特别有趣，每次绘制makeContent时都会调用它。 因此，让我们编写一个方法，在图形设备将使用的精确坐标上调用数学运算：

# Make hook for drawing
makeContent.pointpath <- function(x){
  # Convert npcs to absolute units
  x_new <- convertX(x$x, "mm", TRUE)
  y_new <- convertY(x$y, "mm", TRUE)

  # Do trigonometry stuff
  hyp <- sqrt(diff(x_new)^2 + diff(y_new)^2)
  sin_plot <- diff(y_new) / hyp 
  cos_plot <- diff(x_new) / hyp

  diff_x0_seg <- head(x$mult, -1) * cos_plot
  diff_x1_seg <- (hyp - head(x$mult, -1)) * cos_plot
  diff_y0_seg <- head(x$mult, -1) * sin_plot
  diff_y1_seg <- (hyp - head(x$mult, -1)) * sin_plot

  x0 = head(x_new, -1) + diff_x0_seg
  x1 = head(x_new, -1) + diff_x1_seg
  y0 = head(y_new, -1) + diff_y0_seg
  y1 = head(y_new, -1) + diff_y1_seg
  keep <- unclass(x0) < unclass(x1)

  # Remove old xy coordinates
  x$x <- NULL
  x$y <- NULL

  # Supply new xy coordinates
  x$x0 <- unit(x0, "mm")[keep]
  x$x1 <- unit(x1, "mm")[keep]
  x$y0 <- unit(y0, "mm")[keep]
  x$y1 <- unit(y1, "mm")[keep]

  # Set to segments class
  class(x)[1] <- 'segments'
  x
}

现在我们只需要一个像以前一样的层包装器，它没有什么特别的：

geom_pointpath <- function(mapping = NULL, data = NULL, stat = "identity",
                           position = "identity", ..., na.rm = FALSE, show.legend = NA,
                           inherit.aes = TRUE)
{
  layer(data = data, mapping = mapping, stat = stat, geom = GeomPointPath,
        position = position, show.legend = show.legend, inherit.aes = inherit.aes,
        params = list(na.rm = na.rm, ...))
}

演示：

g <- ggplot(pressure, aes(temperature, pressure)) +
  # Ribbon for showing no point-over-point background artefacts
  geom_ribbon(aes(ymin = pressure - 50, ymax = pressure + 50), alpha = 0.2) +
  geom_pointpath()

对于任何调整大小的纵横比，这应该是稳定的。 您可以提供aes(mult = ...)或仅mult = ...来控制段之间的间隙大小。 默认情况下，它与点大小成正比，因此在保持间隙不变的同时改变点大小是一个挑战。 短于间隙两倍的段将被删除。

Answer 5

这现在可以通过 CRAN 包 {ggh4x} 实现。 有趣的事实是，这个包的 geom 在这篇 SO 帖子上大放异彩：）谢谢 teunbrand！

library(ggh4x)
#> Loading required package: ggplot2
ggplot(pressure, aes(temperature, pressure)) + 
  geom_pointpath()

^{由reprex 包(v2.0.1) 于 2021 年 11 月 13 日创建}