是否有可能在ggplot2中实现base-r plot`type = b`功能?

joe*_*nko 17 plot r ggplot2

基本plot()功能允许人们设置type='b'并获得组合的线和点图,其中点从线段偏移

plot(pressure, type = 'b', pch = 19)
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述

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

ggplot(pressure, aes(temperature, pressure)) + 
  geom_line() + 
  geom_point()
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述

然而,这些线直到点.我可以想象一种方法,我可以type='b'使用其他geom(例如geom_segment()?)将某些功能组合在一起,但我想知道是否有更直接的方法来实现这一点geom_line()geom_point().

Wei*_*ong 19

这样做的一个有点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"))
Run Code Online (Sandbox Code Playgroud)

另外,在ggplot中控制点边框厚度之后,在版本2.0.0中ggplot2可以使用stroke参数geom_point来控制边框厚度,因此geom_point可以用(例如)替换两个s geom_point(size=2, shape=21, fill="black", colour="white", stroke=3),从而消除了叠加点的需要.

在此输入图像描述


cam*_*lle 14

与手动将笔触颜色与面板背景匹配相比,不那么棘手的一种选择是预先从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)
Run Code Online (Sandbox Code Playgroud)

几个SO问题(这里是一个)涉及缩短点之间的线段背后的数学问题。它是简单但乏味的几何图形。但是,自从这个问题首次发布以来,该lemon软件包就已经问世了,它具有一定的魔力。它有关于如何计算缩短时间的参数,这可能只需要一些简单的调整即可。

library(lemon)

ggplot(pressure, aes(x = temperature, y = pressure)) +
  geom_pointline()
Run Code Online (Sandbox Code Playgroud)


teu*_*and 6

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

*请注意,路径的行为不是沿x轴连接点,而是沿data.frameggplot中指定的行顺序。如果需要,可以事先对数据进行排序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,
  )
)
Run Code Online (Sandbox Code Playgroud)

细心的人可能已经注意到这条线了bgcol <- sys.frame(4)$theme$panel.background$fill。我找不到其他方法来访问当前图的主题,而不必调整至少其他几个函数以将该主题作为参数传递。在我的ggplot(3.1.0)版本中,第4个sys.frame()ggplot2:::ggplot_gtable.ggplot_built调用环境,在其中评估了geom绘图代码。很难想象此功能可以在将来进行更新(这可能会更改作用域),因此会发出稳定性警告。作为备份,当找不到当前主题时,它将默认使用全局主题设置。

编辑:现在应该更稳定

继续到不言自明的图层包装器:

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, ...))
}
Run Code Online (Sandbox Code Playgroud)

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

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

当然,这种方法会使背景点的网格线模糊,但这是我为防止由于线径缩短而产生的扭曲而做出的权衡。线条大小,线条类型和背景点的相对大小可以使用aes(linesize = ..., linetype = ..., mult = ...)或根据中的...参数进行设置geom_pointpath()。它继承了其他美学GeomPoint

在此处输入图片说明


teu*_*and 6

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

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

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

我无耻地从其他人那里窃取了一些好主意,所以感谢 @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,
  )
)
Run Code Online (Sandbox Code Playgroud)

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

# 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
}
Run Code Online (Sandbox Code Playgroud)

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

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, ...))
}
Run Code Online (Sandbox Code Playgroud)

演示:

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()
Run Code Online (Sandbox Code Playgroud)

在此处输入图片说明

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