annotation-logticks.r

#' Annotation: log tick marks
#'
#' This annotation adds log tick marks with diminishing spacing.
#' These tick marks probably make sense only for base 10.
#'
#' @param base the base of the log (default 10)
#' @param sides a string that controls which sides of the plot the log ticks appear on.
#'   It can be set to a string containing any of `"trbl"`, for top, right,
#'   bottom, and left.
#' @param outside logical that controls whether to move the log ticks outside
#' of the plot area. Default is off (`FALSE`). You will also need to use
#' `coord_cartesian(clip = "off")`. See examples.
#' @param short a [grid::unit()] object specifying the length of the
#'   short tick marks
#' @param mid a [grid::unit()] object specifying the length of the
#'   middle tick marks. In base 10, these are the "5" ticks.
#' @param long a [grid::unit()] object specifying the length of the
#'   long tick marks. In base 10, these are the "1" (or "10") ticks.
#' @param scaled is the data already log-scaled? This should be `TRUE`
#'   (default) when the data is already transformed with `log10()` or when
#'   using `scale_y_log10()`. It should be `FALSE` when using
#'   `coord_trans(y = "log10")`.
#' @param colour Colour of the tick marks.
#' @param size Thickness of tick marks, in mm.
#' @param linetype Linetype of tick marks (`solid`, `dashed`, etc.)
#' @param alpha The transparency of the tick marks.
#' @param color An alias for `colour`.
#' @param ... Other parameters passed on to the layer
#'
#' @export
#' @seealso [scale_y_continuous()], [scale_y_log10()] for log scale
#'   transformations.
#' @seealso [coord_trans()] for log coordinate transformations.
#'
#' @examples
#' # Make a log-log plot (without log ticks)
#' a <- ggplot(msleep, aes(bodywt, brainwt)) +
#'  geom_point(na.rm = TRUE) +
#'  scale_x_log10(
#'    breaks = scales::trans_breaks("log10", function(x) 10^x),
#'    labels = scales::trans_format("log10", scales::math_format(10^.x))
#'  ) +
#'  scale_y_log10(
#'    breaks = scales::trans_breaks("log10", function(x) 10^x),
#'    labels = scales::trans_format("log10", scales::math_format(10^.x))
#'  ) +
#'  theme_bw()
#'
#' a + annotation_logticks()                # Default: log ticks on bottom and left
#' a + annotation_logticks(sides = "lr")    # Log ticks for y, on left and right
#' a + annotation_logticks(sides = "trbl")  # All four sides
#'
#' a + annotation_logticks(sides = "lr", outside = TRUE) +
#'  coord_cartesian(clip = "off")  # Ticks outside plot
#'
#' # Hide the minor grid lines because they don't align with the ticks
#' a + annotation_logticks(sides = "trbl") + theme(panel.grid.minor = element_blank())
#'
#' # Another way to get the same results as 'a' above: log-transform the data before
#' # plotting it. Also hide the minor grid lines.
#' b <- ggplot(msleep, aes(log10(bodywt), log10(brainwt))) +
#'  geom_point(na.rm = TRUE) +
#'  scale_x_continuous(name = "body", labels = scales::math_format(10^.x)) +
#'  scale_y_continuous(name = "brain", labels = scales::math_format(10^.x)) +
#'  theme_bw() + theme(panel.grid.minor = element_blank())
#'
#' b + annotation_logticks()
#'
#' # Using a coordinate transform requires scaled = FALSE
#' t <- ggplot(msleep, aes(bodywt, brainwt)) +
#'   geom_point() +
#'   coord_trans(x = "log10", y = "log10") +
#'   theme_bw()
#' t + annotation_logticks(scaled = FALSE)
#'
#' # Change the length of the ticks
#' a + annotation_logticks(
#'   short = unit(.5,"mm"),
#'   mid = unit(3,"mm"),
#'   long = unit(4,"mm")
#' )
annotation_logticks <- function(base = 10, sides = "bl", outside = FALSE, 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, ...)
{
  if (!is.null(color))
    colour <- color

  layer(
    data = dummy_data(),
    mapping = NULL,
    stat = StatIdentity,
    geom = GeomLogticks,
    position = PositionIdentity,
    show.legend = FALSE,
    inherit.aes = FALSE,
    params = list(
      base = base,
      sides = sides,
      outside = outside,
      scaled = scaled,
      short = short,
      mid = mid,
      long = long,
      colour = colour,
      size = size,
      linetype = linetype,
      alpha = alpha,
      ...
    )
  )
}

#' @rdname ggplot2-ggproto
#' @format NULL
#' @usage NULL
#' @export
GeomLogticks <- ggproto("GeomLogticks", Geom,
  extra_params = "",
  handle_na = function(data, params) {
    data
  },

  draw_panel = function(data, panel_params, coord, base = 10, sides = "bl",
                        outside = FALSE, scaled = TRUE, short = unit(0.1, "cm"),
                        mid = unit(0.2, "cm"), long = unit(0.3, "cm"))
  {
    ticks <- list()
    flipped <- inherits(coord, "CoordFlip")
    x_name <- if (flipped) "y" else "x"
    y_name <- if (flipped) "x" else "y"

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

    if (grepl("[b|t]", sides)) {

      # Get positions of x tick marks
      xticks <- calc_logticks(
        base = base,
        minpow = floor(panel_params$x.range[1]),
        maxpow = ceiling(panel_params$x.range[2]),
        start = 0,
        shortend = short,
        midend = mid,
        longend = long
      )

      if (scaled)
        xticks$value <- log(xticks$value, base)

      names(xticks)[names(xticks) == "value"] <- x_name   # Rename to 'x' for coordinates$transform
      xticks <- coord$transform(xticks, panel_params)
      xticks = xticks[xticks$x <= 1 & xticks$x >= 0,]

      if (outside)
        xticks$end = -xticks$end

      # Make the grobs
      if (grepl("b", sides)) {
        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)) {
        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)) {
      yticks <- calc_logticks(
        base = base,
        minpow = floor(panel_params$y.range[1]),
        maxpow = ceiling(panel_params$y.range[2]),
        start = 0,
        shortend = short,
        midend = mid,
        longend = long
      )

      if (scaled)
        yticks$value <- log(yticks$value, base)

      names(yticks)[names(yticks) == "value"] <- y_name   # Rename to 'y' for coordinates$transform
      yticks <- coord$transform(yticks, panel_params)
      yticks = yticks[yticks$y <= 1 & yticks$y >= 0,]

      if (outside)
        yticks$end = -yticks$end

      # Make the grobs
      if (grepl("l", sides)) {
        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)) {
        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_logticks <- function(base = 10, ticks_per_base = base - 1,
    minpow = 0, maxpow = minpow + 1, start = 0, shortend = .1, midend = .2, longend = .3) {

  # 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

  tickdf <- new_data_frame(list(value = ticks, start = start, end = tickend), n = length(ticks))

  return(tickdf)
}