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

后端 未结 3 1160
离开以前
离开以前 2020-11-27 18:20

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 th

相关标签:
3条回答
  • 2020-11-27 18:46

    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())
    
    0 讨论(0)
  • 2020-11-27 18:47

    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.

    0 讨论(0)
  • 2020-11-27 18:48

    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
    }
    
    0 讨论(0)
提交回复
热议问题