Skip to content

Allow functional limits in continuous scales #2334

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 5 commits into from
Apr 24, 2019
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 5 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -47,6 +47,11 @@ core developer team.

* `x0` and `y0` are now recognized positional aesthetics so they will get scaled
if used in extension geoms and stats (@thomasp85, #3168)

* Continuous scale limits now accept functions which accept the default
limits and return adjusted limits. This makes it possible to write
a function that e.g. ensures the limits are always a multiple of 100,
regardless of the data (@econandrew, #2307).

## Minor improvements and bug fixes

Expand Down
25 changes: 16 additions & 9 deletions R/scale-.r
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,6 @@
Scale <- ggproto("Scale", NULL,

call = NULL,

aesthetics = aes(),
scale_name = NULL,
palette = function() {
Expand Down Expand Up @@ -107,16 +106,20 @@ Scale <- ggproto("Scale", NULL,
stop("Not implemented", call. = FALSE)
},

# if scale contains a NULL, use the default scale range
# if scale is a function, apply it to the default (inverted) scale range
# if scale is NULL, use the default scale range
# if scale contains a NA, use the default range for that axis, otherwise
# use the user defined limit for that axis
get_limits = function(self) {
if (self$is_empty()) return(c(0, 1))

if (!is.null(self$limits)) {
ifelse(!is.na(self$limits), self$limits, self$range$range)
} else {
if (is.null(self$limits)) {
self$range$range
} else if (is.function(self$limits)) {
# if limits is a function, it expects to work in data space
self$trans$transform(self$limits(self$trans$inverse(self$range$range)))
} else {
ifelse(is.na(self$limits), self$range$range, self$limits)
}
},

Expand Down Expand Up @@ -526,8 +529,12 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale,
#' - A character vector giving labels (must be same length as `breaks`)
#' - A function that takes the breaks as input and returns labels
#' as output
#' @param limits A numeric vector of length two providing limits of the scale.
#' Use `NA` to refer to the existing minimum or maximum.
#' @param limits One of:
#' - `NULL` to use the default scale range
#' - A numeric vector of length two providing limits of the scale.
#' Use `NA` to refer to the existing minimum or maximum
#' - A function that accepts the existing (automatic) limits and returns
#' new limits
#' @param rescaler Used by diverging and n colour gradients
#' (i.e. [scale_colour_gradient2()], [scale_colour_gradientn()]).
#' A function used to scale the input values to the range \[0, 1].
Expand All @@ -538,7 +545,7 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale,
#' @param trans Either the name of a transformation object, or the
#' object itself. Built-in transformations include "asn", "atanh",
#' "boxcox", "date", "exp", "hms", "identity", "log", "log10", "log1p", "log2",
#' "logit", "modulus", "probability", "probit", "pseudo_log", "reciprocal",
#' "logit", "modulus", "probability", "probit", "pseudo_log", "reciprocal",
#' "reverse", "sqrt" and "time".
#'
#' A transformation object bundles together a transform, its inverse,
Expand Down Expand Up @@ -569,7 +576,7 @@ continuous_scale <- function(aesthetics, scale_name, palette, name = waiver(),
}

trans <- as.trans(trans)
if (!is.null(limits)) {
if (!is.null(limits) && !is.function(limits)) {
limits <- trans$transform(limits)
}

Expand Down
10 changes: 8 additions & 2 deletions man/continuous_scale.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

10 changes: 8 additions & 2 deletions man/scale_continuous.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

10 changes: 8 additions & 2 deletions man/scale_date.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

10 changes: 8 additions & 2 deletions man/scale_gradient.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

20 changes: 16 additions & 4 deletions man/scale_size.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

78 changes: 78 additions & 0 deletions tests/figs/scales-breaks-and-labels/functional-limits.svg
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
22 changes: 21 additions & 1 deletion tests/testthat/test-scales-breaks-labels.r
Original file line number Diff line number Diff line change
Expand Up @@ -202,7 +202,6 @@ test_that("scale_breaks with explicit NA options (deprecated)", {
expect_error(scc$get_breaks())
})


test_that("breaks can be specified by names of labels", {
labels <- setNames(LETTERS[1:4], letters[1:4])

Expand Down Expand Up @@ -241,6 +240,12 @@ test_that("minor breaks are transformed by scales", {
expect_equal(sc$get_breaks_minor(), c(0, 1, 2))
})

test_that("continuous limits accepts functions", {
p <- ggplot(mpg, aes(class, hwy)) +
scale_y_continuous(limits = function(lims) (c(lims[1] - 10, lims[2] + 100)))

expect_equal(layer_scales(p)$y$get_limits(), c(range(mpg$hwy)[1] - 10, range(mpg$hwy)[2] + 100))
})

# Visual tests ------------------------------------------------------------

Expand Down Expand Up @@ -324,3 +329,18 @@ test_that("scale breaks can be removed", {
ggplot(dat, aes(x = 1, y = y, colour = x)) + geom_point() + scale_colour_continuous(breaks = NULL)
)
})

test_that("functional limits work for continuous scales", {
limiter <- function(by) {
function(limits) {
low <- floor(limits[1] / by) * by
high <- ceiling(limits[2] / by) * by
c(low, high)
}
}

expect_doppelganger(
"functional limits",
ggplot(mpg, aes(class)) + geom_bar(aes(fill = drv)) + scale_y_continuous(limits = limiter(50))
)
})