diff --git a/R/axis-secondary.R b/R/axis-secondary.R index 28d5dccd0c..bf018bd9e6 100644 --- a/R/axis-secondary.R +++ b/R/axis-secondary.R @@ -152,10 +152,10 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, if (self$empty()) return() # Get original range before transformation - inv_range <- scale$trans$inverse(range) + along_range <- seq(range[1], range[2], length.out = self$detail) + old_range <- scale$trans$inverse(along_range) # Create mapping between primary and secondary range - old_range <- seq(inv_range[1], inv_range[2], length.out = self$detail) full_range <- self$transform_range(old_range) # Test for monotonicity @@ -165,7 +165,12 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, # Get break info for the secondary axis new_range <- range(scale$transform(full_range), na.rm = TRUE) sec_scale <- self$create_scale(new_range, scale) + range_info <- sec_scale$break_info() + old_val <- old_range[unlist(lapply(range_info$major_source, function(x) which.min(abs(scale$trans$transform(full_range) - x))))] + old_val_trans <- scale$trans$transform(old_val) + range_info$major[] <- round(rescale(scale$map(old_val_trans, range(old_val_trans)), from = range), digits = 3) + names(range_info) <- paste0("sec.", names(range_info)) range_info }, diff --git a/tests/figs/sec-axis/sec-axis-custom-transform.svg b/tests/figs/sec-axis/sec-axis-custom-transform.svg new file mode 100644 index 0000000000..9635517c6a --- /dev/null +++ b/tests/figs/sec-axis/sec-axis-custom-transform.svg @@ -0,0 +1,104 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.001 +0.010 +0.100 +0.500 +0.600 +0.700 +0.800 +0.900 +1.000 + + + + + + + + + + + + + + + + + + +0.001 +0.010 +0.100 +0.250 +0.300 +0.350 +0.400 +0.450 +0.500 + + + + + +-1.0 +-0.5 +0.0 +0.5 +1.0 +x +y +sec_axis, custom transform + diff --git a/tests/figs/sec-axis/sec-axis-sec-power-transform.svg b/tests/figs/sec-axis/sec-axis-sec-power-transform.svg new file mode 100644 index 0000000000..ee476392b5 --- /dev/null +++ b/tests/figs/sec-axis/sec-axis-sec-power-transform.svg @@ -0,0 +1,71 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-0.25 +0.00 +0.25 +0.50 +0.75 +1.00 + + + + + + +4.950 +4.975 +5.000 +5.025 +5.050 + + + + + + + + + +2.5 +5.0 +7.5 +10.0 +1:10 +rep(5, 10) +sec_axis, sec power transform + diff --git a/tests/figs/sec-axis/sec-axis-skewed-transform.svg b/tests/figs/sec-axis/sec-axis-skewed-transform.svg index 5728631d99..fdaf89c417 100644 --- a/tests/figs/sec-axis/sec-axis-skewed-transform.svg +++ b/tests/figs/sec-axis/sec-axis-skewed-transform.svg @@ -125,16 +125,16 @@ -1e-01 -1e+00 -1e+01 -1e+02 -1e+03 - - - - - +1e-01 +1e+00 +1e+01 +1e+02 +1e+03 + + + + + 0.00 0.25 0.50 diff --git a/tests/figs/themes/axes-styling.svg b/tests/figs/themes/axes-styling.svg index fc1d1d063f..e16319a8e5 100644 --- a/tests/figs/themes/axes-styling.svg +++ b/tests/figs/themes/axes-styling.svg @@ -51,14 +51,14 @@ -2.5 -5.0 -7.5 -10.0 - - - - +2.5 +5.0 +7.5 +10.0 + + + + 2.5 5.0 @@ -69,14 +69,14 @@ - - - - -2.5 -5.0 -7.5 -10.0 + + + + +2.5 +5.0 +7.5 +10.0 diff --git a/tests/testthat/test-sec-axis.R b/tests/testthat/test-sec-axis.R index d272d6eaf8..1618424288 100644 --- a/tests/testthat/test-sec-axis.R +++ b/tests/testthat/test-sec-axis.R @@ -117,7 +117,10 @@ test_that("sec axis works with tidy eval", { scale <- layer_scales(p)$y breaks <- scale$break_info() + # test transform expect_equal(breaks$major_source / 10, breaks$sec.major_source) + # test positioning + expect_equal(round(breaks$major, 2), round(breaks$sec.major, 2)) }) test_that("sec_axis works with date/time/datetime scales", { @@ -162,18 +165,72 @@ test_that("sec_axis works with date/time/datetime scales", { ) }) -test_that("sec_axis() works for power transformations (monotonicity test doesn't fail)", { - p <- ggplot(foo, aes(x, y)) + +test_that("sec_axis() handles secondary power transformations", { + set.seed(111) + df <- data_frame( + x = rnorm(100), + y = rnorm(100) + ) + p <- ggplot(df, aes(x, y)) + geom_point() + - scale_x_sqrt(sec.axis = dup_axis()) - scale <- layer_scales(p)$x - breaks <- scale$break_info() - expect_equal(breaks$major, breaks$sec.major, tolerance = .001) + scale_y_continuous(sec.axis = sec_axis(trans = (~2^.))) - p <- ggplot(foo, aes(x, y)) + - geom_point() + - scale_x_sqrt(sec.axis = sec_axis(~. * 100)) - scale <- layer_scales(p)$x + scale <- layer_scales(p)$y breaks <- scale$break_info() - expect_equal(breaks$major, breaks$sec.major, tolerance = .001) + + expect_equal(round(breaks$major[4:6], 2), round(breaks$sec.major[c(1, 2, 4)], 2)) + + expect_doppelganger( + "sec_axis, sec power transform", + ggplot() + + geom_point(aes(x = 1:10, y = rep(5, 10))) + + scale_x_continuous(sec.axis = sec_axis(~log10(.))) + ) +}) + +test_that("sec_axis() respects custom transformations", { + # Custom transform code submitted by DInfanger, Issue #2798 + magnify_trans_log <- function(interval_low = 0.05, interval_high = 1, reducer = 0.05, reducer2 = 8) { + trans <- Vectorize(function(x, i_low = interval_low, i_high = interval_high, r = reducer, r2 = reducer2) { + if (is.na(x) || (x >= i_low & x <= i_high)) { + x + } else if (x < i_low & !is.na(x)) { + (log10(x / r) / r2 + i_low) + } else { + log10((x - i_high) / r + i_high) / r2 + } + }) + + inv <- Vectorize(function(x, i_low = interval_low, i_high = interval_high, r = reducer, r2 = reducer2) { + if (is.na(x) || (x >= i_low & x <= i_high)) { + x + } else if (x < i_low & !is.na(x)) { + 10^(-(i_low - x) * r2) * r + } else { + i_high + 10^(x * r2) * r - i_high * r + } + }) + + trans_new(name = "customlog", transform = trans, inverse = inv, domain = c(1e-16, Inf)) + } + + # Create data + x <- seq(-1, 1, length.out = 1000) + y <- c(x[x < 0] + 1, -x[x > 0] + 1) + 1e-6 + dat <- data_frame(x = c(NA, x), y = c(1, y)) + + expect_doppelganger( + "sec_axis, custom transform", + ggplot(dat, aes(x = x, y = y)) + + geom_line(size = 1, na.rm = T) + + scale_y_continuous( + trans = magnify_trans_log(interval_low = 0.5, interval_high = 1, reducer = 0.5, reducer2 = 8) + , breaks = c(0.001, 0.01, 0.1, 0.5, 0.6, 0.7, 0.8, 0.9, 1) + , limits = c(0.001, 1) + , sec.axis = sec_axis( + trans = ~. * (1 / 2) + , breaks = c(0.001, 0.01, 0.1, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5) + ) + ) + theme_linedraw() + ) })