diff --git a/NEWS.md b/NEWS.md
index 1b1ce5196b..34a7d7bc17 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -107,6 +107,8 @@ core developer team.
* `stat_bin()` will now error when the number of bins exceeds 1e6 to avoid
accidentally freezing the user session (@thomasp85).
+
+* `sec_axis()` now places ticks accurately when using nonlinear transformations (@dpseidel, #2978).
* `facet_wrap()` and `facet_grid()` now automatically remove NULL from facet
specs, and accept empty specs (@yutannihilation, #3070, #2986).
diff --git a/R/axis-secondary.R b/R/axis-secondary.R
index 28d5dccd0c..21465ce335 100644
--- a/R/axis-secondary.R
+++ b/R/axis-secondary.R
@@ -29,6 +29,15 @@
#' `dup_axis` is provide as a shorthand for creating a secondary axis that
#' is a duplication of the primary axis, effectively mirroring the primary axis.
#'
+#' As of v3.1, date and datetime scales have limited secondary axis capabilities.
+#' Unlike other continuous scales, secondary axis transformations for date and datetime scales
+#' must respect their primary POSIX data structure.
+#' This means they may only be transformed via addition or subtraction, e.g.
+#' `~. + hms::hms(days = 8)`, or
+#' `~.- 8*60*60`. Nonlinear transformations will return an error.
+#' To produce a time-since-event secondary axis in this context, users
+#' may consider adapting secondary axis labels.
+#'
#' @examples
#' p <- ggplot(mtcars, aes(cyl, mpg)) +
#' geom_point()
@@ -56,7 +65,7 @@
#' price = seq(20, 200000, length.out = 10)
#' )
#'
-#' # useful for labelling different time scales in the same plot
+#' # This may useful for labelling different time scales in the same plot
#' ggplot(df, aes(x = dx, y = price)) + geom_line() +
#' scale_x_datetime("Date", date_labels = "%b %d",
#' date_breaks = "6 hour",
@@ -136,6 +145,7 @@ AxisSecondary <- ggproto("AxisSecondary", NULL,
if (!is.formula(self$trans)) stop("transformation for secondary axes must be a formula", call. = FALSE)
if (is.derived(self$name) && !is.waive(scale$name)) self$name <- scale$name
if (is.derived(self$breaks)) self$breaks <- scale$breaks
+ if (is.waive(self$breaks)) self$breaks <- scale$trans$breaks
if (is.derived(self$labels)) self$labels <- scale$labels
},
@@ -148,37 +158,66 @@ AxisSecondary <- ggproto("AxisSecondary", NULL,
)
},
- break_info = function(self, range, scale) {
- if (self$empty()) return()
-
- # Get original range before transformation
- inv_range <- scale$trans$inverse(range)
+ mono_test = function(self, scale){
+ range <- scale$range$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
if (length(unique(sign(diff(full_range)))) != 1)
stop("transformation for secondary axes must be monotonic")
+ },
+
+ break_info = function(self, range, scale) {
+ if (self$empty()) return()
+
+ # Test for monotonicity on unexpanded range
+ self$mono_test(scale)
+
+ # Get scale's original range before transformation
+ 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
+ full_range <- self$transform_range(old_range)
# 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()
+ new_range <- range(full_range, na.rm = TRUE)
+
+ # patch for date and datetime scales just to maintain functionality
+ # works only for linear secondary transforms that respect the time or date transform
+ if (scale$trans$name %in% c("date", "time")){
+ temp_scale <- self$create_scale(new_range, trans = scale$trans)
+ range_info <- temp_scale$break_info()
+ names(range_info) <- paste0("sec.", names(range_info))
+ return(range_info)
+ }
+
+ temp_scale <- self$create_scale(new_range)
+ range_info <- temp_scale$break_info()
+
+ # Map the break values back to their correct position on the primary scale
+ old_val <- lapply(range_info$major_source, function(x) which.min(abs(full_range - x)))
+ old_val <- old_range[unlist(old_val)]
+ 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
},
# Temporary scale for the purpose of calling break_info()
- create_scale = function(self, range, primary) {
+ create_scale = function(self, range, trans = identity_trans()) {
scale <- ggproto(NULL, ScaleContinuousPosition,
- name = self$name,
- breaks = self$breaks,
- labels = self$labels,
- limits = range,
- expand = c(0, 0),
- trans = primary$trans
+ name = self$name,
+ breaks = self$breaks,
+ labels = self$labels,
+ limits = range,
+ expand = c(0, 0),
+ trans = trans
)
scale$train(range)
scale
diff --git a/man/sec_axis.Rd b/man/sec_axis.Rd
index b6383830d4..ad7a9fd737 100644
--- a/man/sec_axis.Rd
+++ b/man/sec_axis.Rd
@@ -48,6 +48,15 @@ settings from the primary axis.
\code{dup_axis} is provide as a shorthand for creating a secondary axis that
is a duplication of the primary axis, effectively mirroring the primary axis.
+
+As of v3.1, date and datetime scales have limited secondary axis capabilities.
+Unlike other continuous scales, secondary axis transformations for date and datetime scales
+must respect their primary POSIX data structure.
+This means they may only be transformed via addition or subtraction, e.g.
+\code{~. + hms::hms(days = 8)}, or
+\code{~.- 8*60*60}. Nonlinear transformations will return an error.
+To produce a time-since-event secondary axis in this context, users
+may consider adapting secondary axis labels.
}
\examples{
p <- ggplot(mtcars, aes(cyl, mpg)) +
@@ -76,7 +85,7 @@ df <- data.frame(
price = seq(20, 200000, length.out = 10)
)
-# useful for labelling different time scales in the same plot
+# This may useful for labelling different time scales in the same plot
ggplot(df, aes(x = dx, y = price)) + geom_line() +
scale_x_datetime("Date", date_labels = "\%b \%d",
date_breaks = "6 hour",
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 @@
+
+
diff --git a/tests/figs/sec-axis/sec-axis-datetime-scale.svg b/tests/figs/sec-axis/sec-axis-datetime-scale.svg
new file mode 100644
index 0000000000..725fd0c833
--- /dev/null
+++ b/tests/figs/sec-axis/sec-axis-datetime-scale.svg
@@ -0,0 +1,131 @@
+
+
diff --git a/tests/figs/sec-axis/sec-axis-independent-transformations.svg b/tests/figs/sec-axis/sec-axis-independent-transformations.svg
new file mode 100644
index 0000000000..e9fa100779
--- /dev/null
+++ b/tests/figs/sec-axis/sec-axis-independent-transformations.svg
@@ -0,0 +1,77 @@
+
+
diff --git a/tests/figs/sec-axis/sec-axis-monotonicity-test.svg b/tests/figs/sec-axis/sec-axis-monotonicity-test.svg
new file mode 100644
index 0000000000..09da192d8a
--- /dev/null
+++ b/tests/figs/sec-axis/sec-axis-monotonicity-test.svg
@@ -0,0 +1,77 @@
+
+
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..7451419cde
--- /dev/null
+++ b/tests/figs/sec-axis/sec-axis-sec-power-transform.svg
@@ -0,0 +1,88 @@
+
+
diff --git a/tests/figs/sec-axis/sec-axis-skewed-transform.svg b/tests/figs/sec-axis/sec-axis-skewed-transform.svg
index 5728631d99..4e5e2630ec 100644
--- a/tests/figs/sec-axis/sec-axis-skewed-transform.svg
+++ b/tests/figs/sec-axis/sec-axis-skewed-transform.svg
@@ -19,6 +19,28 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -119,46 +141,46 @@
-
+
-1e-01
-1e+00
-1e+01
-1e+02
-1e+03
-
-
-
-
-
-0.00
-0.25
-0.50
-0.75
-1.00
-
-
-
-
-
-
-
-
-
-
-
-
-1e-03
-1e-02
-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
+0.75
+1.00
+
+
+
+
+
+
+
+
+
+
+
+
+1e-03
+1e-02
+1e-01
+1e+00
+1e+01
+1e+02
+1e+03
Unit B
Unit A
y
diff --git a/tests/figs/sec-axis/sec-axis-with-division.svg b/tests/figs/sec-axis/sec-axis-with-division.svg
new file mode 100644
index 0000000000..a7dc81bcff
--- /dev/null
+++ b/tests/figs/sec-axis/sec-axis-with-division.svg
@@ -0,0 +1,309 @@
+
+
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..612f2f6ab3 100644
--- a/tests/testthat/test-sec-axis.R
+++ b/tests/testthat/test-sec-axis.R
@@ -20,6 +20,30 @@ test_that("dup_axis() works", {
expect_equal(breaks$major_source, breaks$sec.major_source)
})
+test_that("sec_axis() works with subtraction", {
+ p <- ggplot(foo, aes(x, y)) +
+ geom_point() +
+ scale_y_continuous(
+ sec.axis = sec_axis(~1-.)
+ )
+ scale <- layer_scales(p)$y
+ expect_equal(scale$sec_name(), scale$name)
+ breaks <- scale$break_info()
+ expect_equal(breaks$minor, breaks$sec.minor)
+ expect_equal(breaks$major_source, breaks$sec.major_source)
+})
+
+test_that("sex axis works with division (#1804)", {
+ expect_doppelganger(
+ "sec_axis, with division",
+ ggplot(mpg, aes(displ, hwy)) +
+ geom_point() +
+ scale_y_continuous(sec.axis = sec_axis(~ 235 / ., name = "100km / L")) +
+ theme_linedraw()
+ )
+})
+
+
test_that("sec_axis() breaks work for log-transformed scales", {
df <- data_frame(
x = c("A", "B", "C"),
@@ -34,33 +58,40 @@ test_that("sec_axis() breaks work for log-transformed scales", {
scale <- layer_scales(p)$y
breaks <- scale$break_info()
- expect_equal(breaks$major_source, breaks$sec.major_source)
+ # test value
+ expect_equal(breaks$major_source, log10(breaks$sec.major_source))
+ # test position
+ expect_equal(breaks$major, round(breaks$sec.major, 1))
# sec_axis() with transform
p <- ggplot(data = df, aes(x, y)) +
geom_point() +
- scale_y_log10(sec.axis = sec_axis(~. * 100))
+ scale_y_log10(sec.axis = sec_axis(~ . * 100))
scale <- layer_scales(p)$y
breaks <- scale$break_info()
- expect_equal(breaks$major_source, breaks$sec.major_source - 2)
+ # test value
+ expect_equal(breaks$major_source, log10(breaks$sec.major_source) - 2)
+ # test position
+ expect_equal(breaks$major, round(breaks$sec.major, 1))
+
# sec_axis() with transform and breaks
custom_breaks <- c(10, 20, 40, 200, 400, 800)
p <- ggplot(data = df, aes(x, y)) +
geom_point() +
- scale_y_log10(breaks = custom_breaks, sec.axis = sec_axis(~. * 100))
+ scale_y_log10(breaks = custom_breaks, sec.axis = sec_axis(~ . * 100))
scale <- layer_scales(p)$y
breaks <- scale$break_info()
expect_equal(breaks$major_source, log(custom_breaks, base = 10))
- expect_equal(log_breaks()(df$y) * 100, 10^(breaks$sec.major_source))
+ expect_equal(log_breaks()(df$y) * 100, breaks$sec.major_source)
})
test_that("custom breaks work", {
- custom_breaks <- c(0.01, 0.1, 1, 10, 100)
+ custom_breaks <- c(100, 375, 800)
p <- ggplot(foo, aes(x, y)) +
geom_point() +
scale_x_continuous(
@@ -83,12 +114,12 @@ test_that("sec axis works with skewed transform", {
scale_x_continuous(
name = "Unit A", trans = "log",
breaks = c(0.001, 0.01, 0.1, 1, 10, 100, 1000),
- sec.axis = sec_axis(~. * 100,
+ sec.axis = sec_axis(~ . * 100,
name = "Unit B",
labels = derive(),
breaks = derive()
)
- )
+ ) + theme_linedraw()
)
})
@@ -105,7 +136,7 @@ test_that("sec axis works with tidy eval", {
g <- ggplot(df, aes(x = !!x, y = !!y)) +
geom_bar(stat = "identity") +
geom_point(aes(y = !!z)) +
- scale_y_continuous(sec.axis = sec_axis(~. / a))
+ scale_y_continuous(sec.axis = sec_axis(~ . / a))
g
}
@@ -117,7 +148,81 @@ 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() 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_y_continuous(sec.axis = sec_axis(trans = (~ 2^.)))
+
+ scale <- layer_scales(p)$y
+ breaks <- scale$break_info()
+
+ 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(.))) +
+ theme_linedraw()
+ )
+})
+
+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()
+ )
})
test_that("sec_axis works with date/time/datetime scales", {
@@ -131,6 +236,8 @@ test_that("sec_axis works with date/time/datetime scales", {
price = seq(20, 200000, length.out = 10)
)
df$date <- as.Date(df$dx)
+
+ # date scale, dup_axis
dt <- ggplot(df, aes(dx, price)) +
geom_line() +
scale_x_datetime(sec.axis = dup_axis())
@@ -138,6 +245,7 @@ test_that("sec_axis works with date/time/datetime scales", {
breaks <- scale$break_info()
expect_equal(breaks$major_source, breaks$sec.major_source)
+ # datetime scale
dt <- ggplot(df, aes(date, price)) +
geom_line() +
scale_x_date(sec.axis = dup_axis())
@@ -145,11 +253,12 @@ test_that("sec_axis works with date/time/datetime scales", {
breaks <- scale$break_info()
expect_equal(breaks$major_source, breaks$sec.major_source)
+ # sec_axis
dt <- ggplot(df, aes(dx, price)) +
geom_line() +
scale_x_datetime(
name = "UTC",
- sec.axis = dup_axis(~. + 12 * 60 * 60,
+ sec.axis = sec_axis(~ . + 12 * 60 * 60,
name = "UTC+12"
)
)
@@ -160,9 +269,69 @@ test_that("sec_axis works with date/time/datetime scales", {
as.numeric(breaks$major_source) + 12 * 60 * 60,
as.numeric(breaks$sec.major_source)
)
+
+ # visual test, datetime scales, reprex #1936
+ df <- data_frame(
+ x = as.POSIXct(c(
+ "2016-11-30 00:00:00",
+ "2016-11-30 06:00:00",
+ "2016-11-30 12:00:00",
+ "2016-11-30 18:00:00",
+ "2016-12-01 00:00:00"
+ ), tz = "UTC"),
+ y = c(0, -1, 0, 1, 0)
+ )
+
+ expect_doppelganger(
+ "sec_axis, datetime scale",
+ ggplot(df, aes(x = x, y = y)) +
+ geom_line() +
+ scale_x_datetime("UTC",
+ date_breaks = "2 hours", date_labels = "%I%p",
+ sec.axis = dup_axis(~ . - 8 * 60 * 60, name = "PST")
+ ) + theme_linedraw()
+ )
})
+test_that("sec.axis allows independent trans btwn primary and secondary axes", {
+ data <- data_frame(
+ Value = c(0.18, 0.29, 0.35, 0.46, 0.50, 0.50, 0.51),
+ Probability = c(0.045, 0.090, 0.136, 0.181, 0.227, 0.272, 0.318)
+ )
+ expect_doppelganger(
+ "sec_axis, independent transformations",
+ ggplot(data = data, aes(Probability, Value)) + geom_point() +
+ scale_x_continuous(
+ trans = scales::probability_trans(distribution = "norm", lower.tail = FALSE),
+ sec.axis = sec_axis(trans = ~ 1 / ., name = "Return Period")
+ ) + theme_linedraw()
+ )
+})
+
+# Currently fails do to necessary reversion of #2805
test_that("sec_axis() works for power transformations (monotonicity test doesn't fail)", {
+ data <- data_frame(
+ x = seq(0, 1, length.out = 100),
+ y = seq(0, 4, length.out = 100)
+ )
+ expect_doppelganger(
+ "sec axis monotonicity test",
+ ggplot(data, aes(x, y)) +
+ geom_line() +
+ scale_y_continuous(trans = "sqrt", sec.axis = dup_axis()) + theme_linedraw()
+ )
+
+ testdat <- data_frame(
+ x = runif(11),
+ y = seq(0, 1, 0.1)
+ )
+ p <- ggplot(data = testdat, aes(x = x, y = y)) +
+ geom_point() +
+ scale_y_continuous(sec.axis = sec_axis(trans = ~ .^0.5))
+ scale <- layer_scales(p)$y
+ breaks <- scale$break_info()
+ expect_equal(breaks$major, sqrt(breaks$sec.major), tolerance = .005)
+
p <- ggplot(foo, aes(x, y)) +
geom_point() +
scale_x_sqrt(sec.axis = dup_axis())
@@ -172,7 +341,7 @@ test_that("sec_axis() works for power transformations (monotonicity test doesn't
p <- ggplot(foo, aes(x, y)) +
geom_point() +
- scale_x_sqrt(sec.axis = sec_axis(~. * 100))
+ scale_x_sqrt(sec.axis = sec_axis(~ . * 100))
scale <- layer_scales(p)$x
breaks <- scale$break_info()
expect_equal(breaks$major, breaks$sec.major, tolerance = .001)