在ggplot2中向x轴添加次刻度标记（没有标签）

Question

下面是几乎完全符合我想要的情节的示例代码。根据下面定义的minor_breaks，我想要添加的唯一内容是x轴上的刻度线（与主刻度相同）。

df <- data.frame(x = c(1900,1950,2000), y = c(50,75,60))

p <- ggplot(df, aes(x=x, y=y))
  p + geom_line() + 
  scale_x_continuous(minor_breaks = seq(1900,2000,by=10), breaks = seq(1900,2000,by=50), limits = c(1900,2000), expand = c(0,0)) +
  scale_y_continuous(breaks = c(20,40,60,80), limits = c(0,100)) +
  theme(legend.position="none", panel.background = element_blank(), 
  axis.line = element_line(color='black'), panel.grid.minor = element_blank())

提前致谢， --JT

Answer 1

这可以在精确的实例中完成：

scale_x_continuous(breaks= seq(1900,2000,by=10), 
                  labels = c(1900, rep("",4), 1950, rep("",4), 2000), 
                  limits = c(1900,2000), expand = c(0,0)) +

这是一个非防弹的功能，但当开始和结束主要标签与at参数的开始和结束值对齐时，可以插入空白标签：

insert_minor <- function(major_labs, n_minor) {labs <- 
                              c( sapply( major_labs, function(x) c(x, rep("", 4) ) ) )
                              labs[1:(length(labs)-n_minor)]}

测试：

p <- ggplot(df, aes(x=x, y=y))
  p + geom_line() + 
  scale_x_continuous(breaks= seq(1900,2000,by=10), 
                     labels = insert_minor( seq(1900, 2000, by=50), 4 ), 
                     limits = c(1900,2000), expand = c(0,0)) +
  scale_y_continuous(breaks = c(20,40,60,80), limits = c(0,100)) +
  theme(legend.position="none", panel.background = element_blank(), 
        axis.line = element_line(color='black'), panel.grid.minor = element_blank())

Answer 2

上面的功能非常好。

我发现可以更简单或更轻松地解决问题的一种方法是简单地以大和小次要中断的增量指定长轴断点-因此，如果您要以10为增量来指定主断点，以小为增量则以次要间隔为例5，您仍然应该以5为步长指定主要增量。

然后，在主题中，要求您为轴文本提供颜色。您可以给它提供颜色的 list ，而不是选择 one 颜色-指定希望主轴编号为哪种颜色，然后为次轴颜色指定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"),

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

Answer 3

现在可以使用很棒的 ggh4x 包来完成。

library(ggh4x)
#> Loading required package: ggplot2
df <- data.frame(x = c(1900, 1950, 2000), y = c(50, 75, 60))

ggplot(df, aes(x, y)) +
  geom_line() +
  scale_x_continuous(
    minor_breaks = seq(1900, 2000, by = 10),
    breaks = seq(1900, 2000, by = 50), limits = c(1900, 2000),
    guide = "axis_minor" # this is added to the original code
  ) +
  theme(ggh4x.axis.ticks.length.minor = rel(1)) # add this to get the same length

^{由 reprex package (v2.0.0) 于 2021 年 4 月 19 日创建}

Answer 4

尽管上面的响应能够添加中断，但实际上并不是次要中断，为此，您可以使用annotation_ticks函数，其功能与annotation_logticks类似。

代码功能可用here.，您可能需要加载grid包

annotation_ticks <- function(sides = "b",
                             scale = "identity",
                             scaled = TRUE,
                             short = unit(0.1, "cm"),
                             mid = unit(0.2, "cm"),
                             long = unit(0.3, "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,
      short = short,
      mid = mid,
      long = long,
      colour = colour,
      size = size,
      linetype = linetype,
      alpha = alpha,
      ticks_per_base = ticks_per_base,
      delog = delog,
      ...
    )
  )
}

#' Base ggproto classes for ggplot2
#'
#' If you are creating a new geom, stat, position, or scale in another package,
#' you'll need to extend from ggplot2::Geom, ggplot2::Stat, ggplot2::Position, or ggplot2::Scale.
#'
#' @seealso \code{\link[ggplot2]{ggplot2-ggproto}}
#' @usage NULL
#' @format NULL
#' @rdname ggplot2-ggproto
#' @export
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,
                        short = unit(0.1, "cm"),
                        mid = unit(0.2, "cm"),
                        long = unit(0.3, "cm"),
                        ticks_per_base = base - 1,
                        delog = c(x = TRUE, y = TRUE)) {
    ticks <- list()

    # Convert these units to numbers so that they can be put in data frames
    short <- convertUnit(short, "cm", valueOnly = TRUE)
    mid <- convertUnit(mid, "cm", valueOnly = TRUE)
    long <- convertUnit(long, "cm", valueOnly = TRUE)

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

        # Get positions of x tick marks
        xticks <- calc_ticks(
          base = base[s],
          minpow = floor(panel_scales$x.range[1]),
          maxpow = ceiling(panel_scales$x.range[2]),
          majorTicks = panel_scales$x.major_source,
          start = 0,
          shortend = short,
          midend = mid,
          longend = long,
          ticks_per_base = ticks_per_base[s],
          delog = delog[s]
        )

        if (scaled) {
          if (!delog[s]) {
            xticks$value <- log(xticks$value, base[s])
          }
        }

        names(xticks)[names(xticks) == "value"] <- "x" # Rename to 'x' for coordinates$transform

        xticks <- coord$transform(xticks, panel_scales)

        # Make the grobs
        if (grepl("b", sides[s])) {
          ticks$x_b <- with(
            data,
            segmentsGrob(
              x0 = unit(xticks$x, "native"),
              x1 = unit(xticks$x, "native"),
              y0 = unit(xticks$start, "cm"),
              y1 = unit(xticks$end, "cm"),
              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$x, "native"),
              x1 = unit(xticks$x, "native"),
              y0 = unit(1, "npc") - unit(xticks$start, "cm"),
              y1 = unit(1, "npc") - unit(xticks$end, "cm"),
              gp = gpar(
                col = alpha(colour, alpha),
                lty = linetype,
                lwd = size * .pt
              )
            )
          )
        }
      }


      if (grepl("[l|r]", sides[s])) {
        yticks <- calc_ticks(
          base = base[s],
          minpow = floor(panel_scales$y.range[1]),
          maxpow = ceiling(panel_scales$y.range[2]),
          majorTicks = panel_scales$y.major_source,
          start = 0,
          shortend = short,
          midend = mid,
          longend = long,
          ticks_per_base = ticks_per_base[s],
          delog = delog[s]
        )

        if (scaled) {
          if (!delog[s]) {
            yticks$value <- log(yticks$value, base[s])
          }
        }

        names(yticks)[names(yticks) == "value"] <- "y" # Rename to 'y' for coordinates$transform
        yticks <- coord$transform(yticks, panel_scales)

        # Make the grobs
        if (grepl("l", sides[s])) {
          ticks$y_l <- with(
            data,
            segmentsGrob(
              y0 = unit(yticks$y, "native"),
              y1 = unit(yticks$y, "native"),
              x0 = unit(yticks$start, "cm"),
              x1 = unit(yticks$end, "cm"),
              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$y, "native"),
              y1 = unit(yticks$y, "native"),
              x0 = unit(1, "npc") - unit(yticks$start, "cm"),
              x1 = unit(1, "npc") - unit(yticks$end, "cm"),
              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)
)


# Calculate the position of log tick marks Returns data frame with: - value: the
# position of the log tick on the data axis, for example 1, 2, ..., 9, 10, 20, ...
# - start: on the other axis, start position of the line (usually 0) - end: on the
# other axis, end position of the line (for example, .1, .2, or .3)
calc_ticks <- function(base = 10,
                       ticks_per_base = base - 1,
                       minpow = 0,
                       maxpow = minpow + 1,
                       majorTicks = 0,
                       start = 0,
                       shortend = 0.1,
                       midend = 0.2,
                       longend = 0.3,
                       delog = FALSE) {

  # Number of blocks of tick marks
  reps <- maxpow - minpow

  # For base 10: 1, 2, 3, ..., 7, 8, 9, 1, 2, ...
  ticknums <- rep(seq(1, base - 1, length.out = ticks_per_base), reps)

  # For base 10: 1, 1, 1, ..., 1, 1, 1, 2, 2, ... (for example)
  powers <- rep(seq(minpow, maxpow - 1), each = ticks_per_base)

  ticks <- ticknums * base ^ powers

  ticks <- c(ticks, base ^ maxpow) # Add the last tick mark

  # Set all of the ticks short
  tickend <- rep(shortend, length(ticks))

  # Get the position within each cycle, 0, 1, 2, ..., 8, 0, 1, 2. ...
  cycleIdx <- ticknums - 1

  # Set the 'major' ticks long
  tickend[cycleIdx == 0] <- longend

  # Where to place the longer tick marks that are between each base For base 10, this
  # will be at each 5
  longtick_after_base <- floor(ticks_per_base / 2)
  tickend[cycleIdx == longtick_after_base] <- midend

  if (delog) {
    ticksCopy <- ticks

    regScale <- log(ticks, base)

    majorTicks <- sort(
      unique(
        c(
          minpow,
          regScale[which(regScale %in% majorTicks)],
          maxpow,
          majorTicks
        )
      )
    )

    expandScale <- c()

    if (length(majorTicks) > 1) {
      for (i in 1:(length(majorTicks) - 1)) {
        expandScale <- c(
          expandScale,
          seq(majorTicks[i], majorTicks[i + 1], length.out = (ticks_per_base + 1))
        )
      }

      ticks <- unique(expandScale)

      # Set all of the ticks short
      tickend <- rep(shortend, length(ticks))

      # Set the 'major' ticks long
      tickend[which(ticks %in% majorTicks)] <- longend
    }
  }

  tickdf <- data.frame(value = ticks, start = start, end = tickend)

  tickdf
}