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

时间:2016-08-11 11:49:50

标签: r plot ggplot2

基本return $http({ method: 'GET', url: 'url/config', timeout: 1 * 60 * 1000 // timeout of 1 minute }); 功能允许您设置plot()并获得一个组合线和点图,其中点从线段偏移

type='b'

enter image description here

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

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

enter image description here

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

4 个答案:

答案 0 :(得分:18)

这样做的一种稍微晦涩的方法就是在较大的白点上涂上一个小黑点:

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

此外,关注Control point border thickness in ggplot,在ggplot2版本2.0.0中,可以使用stroke的{​​{1}}参数来控制边框粗细,因此这两个geom_point可以仅用(例如)geom_point替换,从而无需覆盖点。

enter image description here

答案 1 :(得分: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)

几个SO问题(here's one)处理缩短点之间的线段背后的数学问题。它是简单但乏味的几何图形。但是自从这个问题首次发布以来,lemon package已经问世,它具有一定的逻辑。有一些关于如何计算缩短时间的参数,可能只需要一些简单的调整即可。

library(lemon)

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

答案 2 :(得分:6)

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

*请注意,路径的行为不是沿x轴连接点,而是沿data.frame中赋予ggplot的行顺序。如果您想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)版本中,第四个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, ...))
}

将它添加到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的其他美学。

enter image description here

答案 3 :(得分:4)

对不起,我回答了两次,但这似乎足够不同,值得提出不同的答案。

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

除了先手动设置长宽比或使用space的{​​{1}}参数外,几乎不可能先验地知道绘图的长宽比或确切大小。由于这是不可能的,因此如果调整图的大小,则任何预先计算的坐标集都将不足。

我无耻地偷了别人的一些好主意,因此感谢@Tjebo和@moody_mudskipper的数学功劳,并感谢ggplot大师thomasp85和ggforce软件包,以便在绘图时汲取灵感。

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

facet_grid()

通过面向对象编程的魔力,我们现在可以为新的grob类编写一个新方法。尽管这本身可能并不有趣,但是如果我们为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

现在我们需要的是像以前一样的图层包装器,它没有什么特殊之处:

# 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, ...))
}

enter image description here

这对于任何调整大小的宽高比​​应该是稳定的。您可以提供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 = ...)来控制段之间的间隙大小。默认情况下,它与点的大小成正比,因此在保持间隙不变的同时改变点的大小是一个挑战。间隔小于两倍的片段将被删除。