ggplot2注释刻度在绘图区域外部

Question

我试图找到一种优雅的方法，在使用ggplot2创建的图中插入次刻度。我找到了一个几乎完全符合我的要求的函数：https://rdrr.io/github/hrbrmstr/ggalt/src/R/annotation_ticks.r 唯一的缺点是：像annotation_logticks中的刻度一样，这些刻度绘制在图形区域内部。我需要它们在外部。

一个解决方案可能是使用负值来表示刻度长度。当我这样做时，刻度消失了。我认为这是由于ggplot2的默认剪辑操作抑制了绘制在绘图区域之外的内容（？）（参见log ticks on the outer side of axes (annotation_logticks)，在那里剪辑被关闭，这不幸地导致刻度超出了绘图范围）。

所以：是否有一种选项可以修改annotation_ticks函数，以便在绘图范围内只覆盖绘图范围的外部产生刻度? 理想情况下，这个功能应该被纳入到annotate_ticks函数中（我不想保存然后重新排列绘图; 我宁愿一步构建我的最终绘图）。

- yenats

Answer 1

我已经找到了一种令人满意的适应annotation_ticks函数的解决方案。如果我们仅仅从您发布的链接中复制粘贴代码，我们可以在GeomTicks ggproto对象的末尾进行以下小修改：

GeomTicks <- ggproto(
  "GeomTicks", Geom,
  # ...
  # all the rest of the code
  # ...
    gTree(children = do.call("gList", ticks), cl = "ticktrimmer") # Change this line
  },
  default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = 1)
)

接下来我们可以编写一个小函数，通过劫持grid包中的S3通用函数makeContent在绘制前触发的范围之外截取刻度：

library(grid)

makeContent.ticktrimmer <- function(x) {
  # Loop over segment grobs
  x$children <- lapply(x$children, function(m) {
    # convert positions to values
    x0 <- convertX(m$x0, "npc", valueOnly = T)
    x1 <- convertX(m$x1, "npc", valueOnly = T)
    y0 <- convertY(m$y0, "npc", valueOnly = T)
    y1 <- convertY(m$y1, "npc", valueOnly = T)

    # check if values are outside 0-1
    if (length(unique(x0)) == 1) {
      keep <- y0 >= 0 & y0 <= 1 & y1 >= 0 & y1 <= 1
    } else if (length(unique(y0)) == 1) {
      keep <- x0 >= 0 & x0 <= 1 & x1 >= 0 & x1 <= 1
    } else {
      keep <- TRUE
    }

    # Trim the segments
    m$x0 <- m$x0[keep]
    m$y0 <- m$y0[keep]
    m$x1 <- m$x1[keep]
    m$y1 <- m$y1[keep]
    m
  })
  x
}

现在我们可以进行绘图：

g <- ggplot(iris, aes(Sepal.Width, Sepal.Length)) +
  geom_point(aes(colour = Species)) +
  annotation_ticks(long = -1 * unit(0.3, "cm"),
                   mid = -1 * unit(0.2, "cm"),
                   short = -1 * unit(0.1, "cm")) +
  coord_cartesian(clip = "off")

除了最左边的第一个刻度有点奇怪之外，这个看起来还是很不错的。

编辑：这里有一个快速重构代码的方法，使用本地的小间隔而不是重新计算小间隔。用户函数：

annotation_ticks <- function(sides = "b",
                             scale = "identity",
                             scaled = TRUE,
                             ticklength = unit(0.1, "cm"),
                             colour = "black",
                             size = 0.5,
                             linetype = 1,
                             alpha = 1,
                             color = NULL,
                             ticks_per_base = NULL,
                             ...) {
  if (!is.null(color)) {
    colour <- color
  }

  # check for invalid side
  if (grepl("[^btlr]", sides)) {
    stop(gsub("[btlr]", "", sides), " is not a valid side: b,t,l,r are valid")
  }

  # split sides to character vector
  sides <- strsplit(sides, "")[[1]]

  if (length(sides) != length(scale)) {
    if (length(scale) == 1) {
      scale <- rep(scale, length(sides))
    } else {
      stop("Number of scales does not match the number of sides")
    }
  }

  base <- sapply(scale, function(x) switch(x, "identity" = 10, "log10" = 10, "log" = exp(1)), USE.NAMES = FALSE)

  if (missing(ticks_per_base)) {
    ticks_per_base <- base - 1
  } else {
    if ((length(sides) != length(ticks_per_base))) {
      if (length(ticks_per_base) == 1) {
        ticks_per_base <- rep(ticks_per_base, length(sides))
      } else {
        stop("Number of ticks_per_base does not match the number of sides")
      }
    }
  }

  delog <- scale %in% "identity"

  layer(
    data = data.frame(x = NA),
    mapping = NULL,
    stat = StatIdentity,
    geom = GeomTicks,
    position = PositionIdentity,
    show.legend = FALSE,
    inherit.aes = FALSE,
    params = list(
      base = base,
      sides = sides,
      scaled = scaled,
      ticklength = ticklength,
      colour = colour,
      size = size,
      linetype = linetype,
      alpha = alpha,
      ticks_per_base = ticks_per_base,
      delog = delog,
      ...
    )
  )
}

ggproto对象：

GeomTicks <- ggproto(
  "GeomTicks", Geom,
  extra_params = "",
  handle_na = function(data, params) {
    data
  },

  draw_panel = function(data,
                        panel_scales,
                        coord,
                        base = c(10, 10),
                        sides = c("b", "l"),
                        scaled = TRUE,
                        ticklength = unit(0.1, "cm"),
                        ticks_per_base = base - 1,
                        delog = c(x = TRUE, y = TRUE)) {
    ticks <- list()

    for (s in 1:length(sides)) {
      if (grepl("[b|t]", sides[s])) {

        xticks <- panel_scales$x.minor

        # Make the grobs
        if (grepl("b", sides[s])) {
          ticks$x_b <- with(
            data,
            segmentsGrob(
              x0 = unit(xticks, "npc"),
              x1 = unit(xticks, "npc"),
              y0 = unit(0, "npc"),
              y1 = ticklength,
              gp = gpar(
                col = alpha(colour, alpha),
                lty = linetype,
                lwd = size * .pt
              )
            )
          )
        }
        if (grepl("t", sides[s])) {
          ticks$x_t <- with(
            data,
            segmentsGrob(
              x0 = unit(xticks, "npc"),
              x1 = unit(xticks, "npc"),
              y0 = unit(1, "npc"),
              y1 = unit(1, "npc") - ticklength,
              gp = gpar(
                col = alpha(colour, alpha),
                lty = linetype,
                lwd = size * .pt
              )
            )
          )
        }
      }


      if (grepl("[l|r]", sides[s])) {

        yticks <- panel_scales$y.minor

        # Make the grobs
        if (grepl("l", sides[s])) {
          ticks$y_l <- with(
            data,
            segmentsGrob(
              y0 = unit(yticks, "npc"),
              y1 = unit(yticks, "npc"),
              x0 = unit(0, "npc"),
              x1 = ticklength,
              gp = gpar(
                col = alpha(colour, alpha),
                lty = linetype, lwd = size * .pt
              )
            )
          )
        }
        if (grepl("r", sides[s])) {
          ticks$y_r <- with(
            data,
            segmentsGrob(
              y0 = unit(yticks, "npc"),
              y1 = unit(yticks, "npc"),
              x0 = unit(1, "npc"),
              x1 = unit(1, "npc") - ticklength,
              gp = gpar(
                col = alpha(colour, alpha),
                lty = linetype,
                lwd = size * .pt
              )
            )
          )
        }
      }
    }
    gTree(children = do.call("gList", ticks))
  },
  default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = 1)
)

绘图:

ggplot(iris, aes(Sepal.Width, Sepal.Length)) +
  geom_point(aes(colour = Species)) +
  annotation_ticks(ticklength = -1 * unit(0.1, "cm"),
                   side = "b") +
  coord_cartesian(clip = "off")

- teunbrand

---

实际上，这导致了一个非常有前途的方向。次刻度在开始时的奇怪行为（以及在其他数据中可见的结束时）当然是不希望的。你能看出它来自哪里吗？也许可以修复它... - undefined

我不知道，在我适应之前，它已经在函数中了。也许最好的地方是查看你发布的链接中的calc_ticks，但我不熟悉那段代码在做什么。如果你在这个语句中注释掉minpow和maxpow： majorTicks <- sort( unique( c( minpow, regScale[which(regScale %in% majorTicks)], maxpow, majorTicks ) ) )，奇怪的刻度会消失，但同时也会消失超出最后一个主要断点的部分。 - undefined

我觉得可能有可能为我的目的编写一个更简单的calc_ticks版本 - 似乎代码是从annotation_logticks改编而来，后者需要更复杂的计算来确定刻度位置。 - undefined

或者，你可以通过使用已经计算好的小刻度来减少计算休息时间的工作量。请参见上面的编辑。 - undefined

这简直像是个奇迹：你的解决方案起作用了。而且它运行得相当好 - 可以通过minor_breaks参数来调整次要刻度，例如在scale_x_continuous中。 非常感谢你的努力！我认为，在未来的ggplot2版本中应该实现次要刻度。然而，你提出的解决方案是一个非常有用的权宜之计，只要在ggplot2中没有这样的实现。 - undefined

Answer 2

上述函数非常棒。

我找到的一种解决方法可能更简单或更容易理解，就是指定主轴断点为所需的主要和次要断点增量 - 因此，如果您想要按10的增量进行主要断点和5的增量进行次要断点，则仍应以5的步骤指定主要增量。

然后，在主题中，您需要为轴文本指定颜色。与其选择一种颜色，您可以为其指定一个颜色列表 - 指定您希望主轴数字具有的任何颜色，然后为次要轴颜色指定NA。这将为您提供主标记上的文本，但不显示“次要”标记上的内容。同样，对于绘图内部的网格，您可以为线条大小指定一个列表，这样尽管将次要网格线指定为主要网格线，但在绘图中主要网格线和次要网格线之间仍会有粗细差异。下面是在主题中输入的示例：

panel.grid.major.x = element_line(colour = c("white"), size = c(0.33, 0.2)),
panel.grid.major.y = element_line(colour = c("white"), size = c(0.33, 0.2)),
axis.text.y = element_text(colour = c("black", NA), family = "Gill Sans"),
axis.text.x = element_text(colour = c("black", NA), family = "Gill Sans"),

我猜您可以以完全相同的方式更改外部刻度线的大小，尽管我还没有尝试过。

- Jamie