README.md

Annotation: log10 tick marks on logit scale

This annotation adds log tick marks with diminishing spacing on logit scale.

Useful for small and mid values, though not for high. Anyway, better than nothing.

source("https://gist.githubusercontent.com/yoursdearboy/8ebb35e31b88d0477ceab2ce3112ecb7/raw/1b886c371a6d15235758a5f4fc78ed953e2bb022/annotation-logitticks.R")

df <- data.frame(x = 1 / (1 + exp(-rlogis(100, -2))),
                 y = 1 / (1 + exp(-rlogis(100, 2))))

ggplot(df, aes(x,y)) +
  geom_point() +
  scale_x_continuous(trans = "logit", breaks = c(10^(-3:0), .5, .9)) +
  scale_y_continuous(trans = "logit", breaks = c(10^(-3:0), .5, .9)) +
  annotation_logitticks() +
  theme(panel.grid.minor = element_blank())

annotation-logitticks.R

annotation_logitticks <- function(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 = ggplot2:::dummy_data(),
    mapping = NULL,
    stat = StatIdentity,
    geom = GeomLogitticks,
    position = PositionIdentity,
    show.legend = FALSE,
    inherit.aes = FALSE,
    params = list(
      sides = sides,
      outside = outside,
      scaled = scaled,
      short = short,
      mid = mid,
      long = long,
      colour = colour,
      size = size,
      linetype = linetype,
      alpha = alpha,
      ...
    )
  )
}

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

  draw_panel = function(data, panel_params, coord, sides = "bl",
                        outside = FALSE, scaled = TRUE, short = unit(0.1, "cm"),
                        mid = unit(0.2, "cm"), long = unit(0.3, "cm")) {
    ticks <- list()

    if (grepl("[b|t]", sides)) {
      xtrans <- panel_params$x$scale$trans
      xrange <- xtrans$inverse(panel_params$x.range)
      xticks <- ggplot2:::calc_logticks(minpow = floor(log10(xrange[1])),
                                        maxpow = ceiling(log10(xrange[2])))

      if (scaled)
        xticks$value <- xtrans$transform(xticks$value)

      xticks$value <- scales::rescale(xticks$value, to = c(0,1), from = panel_params$x.range)

      if (grepl("b", sides) && nrow(xticks) > 0) {
        ticks$x_b <- with(data, grid::segmentsGrob(
          x0 = unit(xticks$value, "native"), x1 = unit(xticks$value, "native"),
          y0 = unit(xticks$start, "cm"), y1 = unit(xticks$end, "cm"),
          gp = grid::gpar(col = alpha(colour, alpha), lty = linetype, lwd = size * .pt)
        ))
      }

      if (grepl("t", sides) && nrow(xticks) > 0) {
        ticks$x_t <- with(data, grid::segmentsGrob(
          x0 = unit(xticks$value, "native"), x1 = unit(xticks$value, "native"),
          y0 = unit(1, "npc") - unit(xticks$start, "cm"), y1 = unit(1, "npc") - unit(xticks$end, "cm"),
          gp = grid::gpar(col = alpha(colour, alpha), lty = linetype, lwd = size * .pt)
        ))
      }
    }

    if (grepl("[l|r]", sides)) {
      ytrans <- panel_params$y$scale$trans
      yrange <- ytrans$inverse(panel_params$y.range)
      yticks <- ggplot2:::calc_logticks(minpow = floor(log10(yrange[1])),
                                        maxpow = ceiling(log10(yrange[2])))

      if (scaled)
        yticks$value <- ytrans$transform(yticks$value)

      yticks$value <- scales::rescale(yticks$value, to = c(0,1), from = panel_params$y.range)

      if (grepl("l", sides) && nrow(yticks) > 0) {
        ticks$y_l <- with(data, grid::segmentsGrob(
          y0 = unit(yticks$value, "native"), y1 = unit(yticks$value, "native"),
          x0 = unit(yticks$start, "cm"), x1 = unit(yticks$end, "cm"),
          gp = grid::gpar(col = alpha(colour, alpha), lty = linetype, lwd = size * .pt)
        ))
      }

      if (grepl("r", sides) && nrow(yticks) > 0) {
        ticks$y_r <- with(data, grid::segmentsGrob(
          y0 = unit(yticks$value, "native"), y1 = unit(yticks$value, "native"),
          x0 = unit(1, "npc") - unit(yticks$start, "cm"), x1 = unit(1, "npc") - unit(yticks$end, "cm"),
          gp = grid::gpar(col = alpha(colour, alpha), lty = linetype, lwd = size * .pt)
        ))
      }
    }

    grid::gTree(children = rlang::inject(grid::gList(!!!ticks)))
  },

  default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = 1)
)