简体   繁体   中英

Adding minor tick marks to the x axis in ggplot2 (with no labels)

Below is example code of a plot that does almost exactly what I want. The only thing I want to add is tick marks on the x axis (same size as the major ticks) according to the minor_breaks defined below.

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

Thanks in advance, --JT

This would do it in the precise instance:

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

Here's a function that is not bullet-proof but works to insert blank labels when the beginning and ending major labels are aligned with the start and stopping values for the at argument:

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

Test:

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

Although the response above is able to add breaks, thse are not actually the minor_breaks, To do so you could use annotation_ticks function, which works similarly to annotation_logticks .

Code function is available here. You may need to load grid package

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
}

Very nice functions above.

A solution I find somewhat simpler or easier to wrap my head around is to simply specify you major axis breaks in the increments you want for both major and minor breaks - so if you want major in increments of 10, and minor in increments of 5, you should nevertheless specify your major increments in steps of 5.

Then, in the theme, you are asked to give a color for the axis text. Rather than choosing one color, you can give it a list of colors - specifying whatever color you want the major axis number to be, and then NA for the minor axis color. This will give you the text on the major mark, but nothing on the 'minor' mark. Likewise, for the grid that goes inside the plot, you can specify a list for the line sizes, so that there is still a difference in thickness for major and minor gridlines within the plot, even though you are specifying the minor gridlines as major grid lines. As an example of what you could put in theme:

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

I suspect you can change the size of the outer tick mark in the exact same way, though I haven't tried it.

This can now be done with the awesome ggh4x package.

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

Created on 2021-04-19 by the reprex package (v2.0.0)

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM