How to transform an x-axis scale both right and left of a density peak to zoom in with R?

Question

Consider the density histogram of the depth variable from the diamonds data.

dat0 <- ggplot2::diamonds %>% select(depth)

gg0 <- ggplot(dat0, aes(x = depth)) +
  scale_x_continuous(limits = c(30, 90), expand = c(0,0), breaks = seq(30,90,10)) +
  scale_y_continuous(limits = c(0, 20000), expand = c(0,0), trans = modulus_trans(0.3)) +
  geom_histogram(bins = 100)  

gg0

Using scales::modulus_trans(), it is easy to transform the x-axis to tighten the scale to the left (gg1) or to the right (gg2).

gg1 <- ggplot(dat0, aes(x = depth)) +
  scale_x_continuous(limits = c(30, 90), expand = c(0,0), breaks = seq(30,90,10),
                     trans = modulus_trans(2.8)) +
  scale_y_continuous(limits = c(0, 20000), expand = c(0,0), trans = modulus_trans(0.3)) +
  geom_histogram(bins = 100)

gg2 <- ggplot(dat0, aes(x = depth)) +
  scale_x_continuous(limits = c(30, 90), expand = c(0,0), breaks = seq(30,90,10),
                     trans = modulus_trans(-1)) +
  scale_y_continuous(limits = c(0, 20000), expand = c(0,0), trans = modulus_trans(0.3)) +
  geom_histogram(bins = 100) 

gg1

gg2

But how to transform the x-scale to tighten on both sides of the density peak (located at say depth = 62) while keeping the possibility to adjust p (the transformation exponent λ from the modulus_trans() function) ideally independently for each side? Maybe a naive question, but would two modulus_trans() combined in a trans_new() function be possible?

If not, what other type of transformation could be used to zoom in on the density peak while keeping it at its initial position?

Thanks for help and advice

Answer 1

I would just create a custom transform here that takes as an argument your central value and smoothly decreases the spacing as you move away from this value using simple exponentiation of the difference. You can control the strength with a strength parameter too:

squish_trans <- function(x, strength) {
  
  trans_new("squish", 
            transform = function(.x) {
              val <- .x - x
              val <- abs(val)^(1/strength) * sign(val)
              mean(x) + val
            }, 
            inverse = function(.x) {
              val <- .x - x
              val <- abs(val)^strength * sign(val)
              mean(x) + val
            })
}

Testing, with a strength of 1.5 we get

ggplot(ggplot2::diamonds, aes(x = depth)) +
  scale_x_continuous(limits = c(30, 90), expand = c(0,0), 
                     breaks = seq(30,90,10),
                     trans = squish_trans(62, 1.5)) +
  scale_y_continuous(limits = c(0, 20000), expand = c(0,0), 
                     trans = modulus_trans(0.3)) +
  geom_histogram(breaks = 1:100)  +
  theme_gray(16)

Or with a milder setting of strength = 1.2 we get

Note that I have specified the histogram breaks at all the integers between 1 and 100; otherwise the bin positions would change to be at fixed intervals along the new scale, giving weird effects at higher strengths.