如何绘制不超出值的圆端线段

Question

令我有些惊讶的是，这从未引起我的注意（我想直到今天我才用圆线末端画了很多东西）。

当绘制带有圆线末端的线段时，这“当然”是作为附加的 grob 元素添加的，但它通过超出给定值来向图形表示添加“值”。我怎样才能改变这个？

我认为需要重新计算原始值，以便在添加圆端时达到正确的值，但这需要在绘制时（即在 grob 函数内）进行此计算。我对杂种很不擅长。如有帮助，将不胜感激。

library(ggplot2)
df <- data.frame(x = 0, xend = 1, y = 0, yend = 0)
ggplot(df, aes(x, y)) +
  geom_vline(xintercept = c(0, 1), lty = 2) +
  geom_segment(aes(xend = xend, yend = yend), 
               linewidth = 6, alpha = .5, 
               lineend = "round")  +
  labs(title =  "NOT an accurate representation of the data",
       caption = "The line extends beyond the given values")

^{创建于 2023 年 11 月 16 日，使用reprex v2.0.2}

Answer 1

这看似困难。makeContent最简单的方法是为 a定义一个新方法segmentsGrob，这又意味着定义一个新的 grob 类，必须从一个新类调用它Geom，而新类需要一个新的geom. 数学本身并不太难，但涉及很多样板文件。

首先，让我们定义一个对 modded 进行实际数学运算的函数segmentsGrob，该函数只是具有segmentsGrob不同的 S3 类名 - 我们将其命名为"roundseg"：

makeContent.roundseg <- function(x) {
  x$x0 <- grid::convertX(x$x0, "cm")
  x$x1 <- grid::convertX(x$x1, "cm")
  x$y0 <- grid::convertY(x$y0, "cm")
  x$y1 <- grid::convertY(x$y1, "cm")
  xmin <- pmin(as.numeric(x$x0), as.numeric(x$x1))
  xmax <- pmax(as.numeric(x$x0), as.numeric(x$x1))
  ymin <- pmin(as.numeric(x$y0), as.numeric(x$y1))
  ymax <- pmax(as.numeric(x$y0), as.numeric(x$y1))
  theta <- atan2(ymax - ymin, xmax - xmin)
  size <- 0.5 * x$gp$lwd / .stroke
  xmin <- xmin + cos(theta) * size
  xmax <- xmax - cos(theta) * size
  ymin <- ymin + sin(theta) * size
  ymax <- ymax - sin(theta) * size
  x$x0 <- unit(xmin, "cm")
  x$x1 <- unit(xmax, "cm")
  x$y0 <- unit(ymin, "cm")
  x$y1 <- unit(ymax, "cm")
  return(x)
}

现在我们定义一个新Geom类 - 我们将其命名为GeomRoundseg. 它几乎与 相同GeomSegment，只是它的draw_panel成员被重新定义以将 更改segmentsGrob为不同的类，以便每当绘制 grob 或调整窗口大小时都会调用上述函数：

GeomRoundseg <- ggproto("GeomRoundseg", GeomSegment,
  draw_panel = function (self, data, panel_params, coord, arrow = NULL, 
                         arrow.fill = NULL, linejoin = "round", na.rm = FALSE) 
{
  data <- ggplot2:::check_linewidth(data, snake_class(self))
  data <- ggplot2:::remove_missing(data, na.rm = na.rm, c("x", "y", "xend", 
                        "yend", "linetype", "linewidth", "shape"), 
                        name = "geom_roundseg")
  if (ggplot2:::empty(data)) 
    return(zeroGrob())
  if (coord$is_linear()) {
    coord <- coord$transform(data, panel_params)
    arrow.fill <- ggplot2:::`%||%`(arrow.fill, coord$colour)
    sg <- grid::segmentsGrob(coord$x, coord$y, coord$xend, coord$yend, 
              default.units = "native", 
              gp = grid::gpar(col = scales::alpha(coord$colour, 
              coord$alpha), fill = scales::alpha(arrow.fill, coord$alpha), 
              lwd = coord$linewidth * .pt, lty = coord$linetype, 
              lineend = "round", linejoin = linejoin), arrow = arrow)
    class(sg) <- c("roundseg", class(sg))
    return(sg)
  }
  data$group <- 1:nrow(data)
  starts <- subset(data, select = c(-xend, -yend))
  ends <- rename(subset(data, select = c(-x, -y)), c(xend = "x", 
                                                     yend = "y"))
  pieces <- vec_rbind0(starts, ends)
  pieces <- pieces[order(pieces$group), ]
  GeomPath$draw_panel(pieces, panel_params, coord, arrow = arrow, 
                      lineend = lineend)
})

最后，我们需要一个geom_roundseg几乎是 的精确副本的函数geom_segment，除了它的lineend参数被删除并且它使用我们的新 Geom 对象：

geom_roundseg <- function (mapping = NULL, data = NULL, stat = "identity", 
          position = "identity", ..., arrow = NULL, arrow.fill = NULL, 
          linejoin = "round", na.rm = FALSE, 
          show.legend = NA, inherit.aes = TRUE) {
  layer(data = data, mapping = mapping, stat = stat, geom = GeomRoundseg, 
        position = position, show.legend = show.legend, 
        inherit.aes = inherit.aes, 
        params = rlang::list2(arrow = arrow, arrow.fill = arrow.fill, 
                       linejoin = linejoin, na.rm = na.rm, ...))
}

现在我们完成了。当我们调用绘图时，圆角线段的尖端将位于指定的 x、y 坐标处：

df <- data.frame(x = 0, xend = 1, y = 0, yend = 0)
ggplot(df, aes(x, y)) +
  geom_vline(xintercept = c(0, 1), lty = 2) +
  geom_roundseg(aes(xend = xend, yend = yend), 
               linewidth = 6, alpha = 0.5)  +
  labs(title =  "Now an accurate representation of the data",
       caption = "The line meets the given values")

如果我们重新调整窗口大小，提示将保持不变：

改变线宽是为了满足：

df <- data.frame(x = 0, xend = 1, y = 0, yend = 0)
ggplot(df, aes(x, y)) +
  geom_roundseg(aes(xend = xend, yend = yend), 
               linewidth = 30, alpha = 0.5)  +
  geom_point() +
  geom_point(aes(xend, yend))

df <- data.frame(x = 0, xend = 1, y = 0, yend = 0)
ggplot(df, aes(x, y)) +
  geom_roundseg(aes(xend = xend, yend = yend), 
               linewidth = 1, alpha = 0.5)  +
  geom_point() +
  geom_point(aes(xend, yend))

无论我们的细分市场从哪个角度来看，这都将继续发挥作用：

df <- data.frame(x = 0, xend = 1, y = 0, yend = 1)
ggplot(df, aes(x, y)) +
  geom_roundseg(aes(xend = xend, yend = yend), 
               linewidth = 6, alpha = 0.5)  +
  geom_point() +
  geom_point(aes(xend, yend))