Skip to content

Instantly share code, notes, and snippets.

@davidtedfordholt
Last active May 31, 2022 18:14
Show Gist options
  • Save davidtedfordholt/3e6ed189c58af941069991aef79b45a9 to your computer and use it in GitHub Desktop.
Save davidtedfordholt/3e6ed189c58af941069991aef79b45a9 to your computer and use it in GitHub Desktop.
A `scales`/`ggplot2` implementation of the `symlog` transformation
#' symlog transformation
#'
#' `symlog_trans()` transforms data using `log(x)` for `abs(x) > thr`, where
#' `thr` is a tuneable threshold, but leaves the data linear for `abs(x) < thr`.
#' (credit for base code to https://stackoverflow.com/users/1320535/julius-vainora)
#'
#'
#' @param base base of logarithm
#' @param thr numeric threshold for transitioning from log to linear
#' @param scale numeric scaling factor for data
#' @export
#' @examples
#' plot(symlog_trans(), xlim = c(-100, 100))
#' plot(pseudo_log_trans(), xlim = c(-100, 100))
#'
#' library(ggplot2)
#' library(patchwork)
#' options(scipen = 9)
#' data <- data.frame(x = 1:100, y = (rexp(1000))^rnorm(1000, 1, 2)* ifelse(runif(1000) > .5, 1, -1))
#' p1 <- ggplot(data, aes(x, y)) +
#' geom_point() +
#' ggtitle("Using regular scaling")
#' p2 <- ggplot(data, aes(x, y)) +
#' geom_point() +
#' scale_y_continuous(trans = pseudo_log_trans()) +
#' ggtitle("Using pseudo_log scaling")
#' p3 <- ggplot(data, aes(x, y)) +
#' geom_point() +
#' scale_y_continuous(trans = symlog_trans()) +
#' ggtitle("Using symlog scaling")
#' p4 <- ggplot(data, aes(x, y)) +
#' geom_point() +
#' scale_y_continuous(trans = symlog_trans(), n.breaks = 3) +
#' ggtitle("Using symlog and n.breaks=3")
#' p1 + p2 + p3 + p4
symlog_trans <- function(base = 10, thr = 1, scale = 1){
trans <- function(x)
ifelse(abs(x) < thr, x, sign(x) *
(thr + scale * suppressWarnings(log(sign(x) * x / thr, base))))
inv <- function(x)
ifelse(abs(x) < thr, x, sign(x) *
base^((sign(x) * x - thr) / scale) * thr)
trans_new(paste("symlog", thr, base, scale, sep = "-"), trans, inv, symlog_breaks(base = base, thr = thr))
}
#' create breaks for symlog transformation
#' (allows for use of the `n.breaks` argument)
#'
#' @export
symlog_breaks <- function(n = 5, base, thr) {
n_default <- n
function(x, n = n_default) {
n <- ceiling(n / 2)
sgn <- sign(x[which.max(abs(x))])
if(all(abs(x) < thr))
pretty_breaks(n = n)(x)
else if(prod(x) >= 0){
if(min(abs(x)) < thr)
sgn * unique(c(pretty_breaks(n = n)(c(min(abs(x)), thr)),
log_breaks(base, n = n)(c(max(abs(x)), thr))))
else
sgn * log_breaks(base, n = n)(sgn * x)
} else {
if(min(abs(x)) < thr)
unique(c(sgn * log_breaks(n = n)(c(max(abs(x)), thr)),
pretty_breaks(n = n)(c(sgn * thr, x[which.min(abs(x))]))))
else
unique(c(-log_breaks(base, n = n)(c(thr, -x[1])),
pretty_breaks(n = n)(c(-thr, thr)),
log_breaks(base, n = n)(c(thr, x[2]))))
}
}
}
@davidtedfordholt
Copy link
Author

davidtedfordholt commented Jun 7, 2021

This allows for the use of + scale_y_continuous(trans = symlog_trans()), as well as + scale_y_continuous(trans = symlog_trans(), n.breaks = n).

The original code from Julius Vainora via StackOverflow is only adjusted to allow the use of the n.breaks argument.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment