如何在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 日創建}