Skip to content

Commit

Permalink
Update stat_ecdf to work either on the x or the y aesthetic. (#4005)
Browse files Browse the repository at this point in the history
* Update stat_ecdf to work either on the x or the y aesthetic, whatever is provided.

* Undo breaking change of renaming the stats result and go back to y.

* Add bullet to NEWS.md

* Fix typo in comments.

* Improve comment.

* Document

Co-authored-by: GitHub Actions <actions@github.com>
  • Loading branch information
jgjl and actions-user committed Aug 4, 2020
1 parent f0e561e commit ca24e27
Show file tree
Hide file tree
Showing 4 changed files with 52 additions and 10 deletions.
2 changes: 2 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,5 +1,7 @@
# ggplot2 (development version)

* Extended `stat_ecdf()` to calculate the cdf from either x or y instead from y only (@jgjl, #4005).

* Fixed a bug in `labeller()` so that `.default` is passed to `as_labeller()`
when labellers are specified by naming faceting variables. (@waltersom, #4031)

Expand Down
37 changes: 28 additions & 9 deletions R/stat-ecdf.r
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,11 @@
#' The downside is that it requires more training to accurately interpret,
#' and the underlying visual tasks are somewhat more challenging.
#'
#' The statistic relies on the aesthetics assignment to guess which variable to
#' use as the input and which to use as the output. Either x or y must be provided
#' and one of them must be unused. The ECDF will be calculated on the given aesthetic
#' and will be output on the unused one.
#'
#' @inheritParams layer
#' @inheritParams geom_point
#' @param na.rm If `FALSE` (the default), removes missing values with
Expand All @@ -17,7 +22,6 @@
#' and (Inf, 1)
#' @section Computed variables:
#' \describe{
#' \item{x}{x in data}
#' \item{y}{cumulative density corresponding x}
#' }
#' @export
Expand Down Expand Up @@ -67,7 +71,24 @@ stat_ecdf <- function(mapping = NULL, data = NULL,
#' @usage NULL
#' @export
StatEcdf <- ggproto("StatEcdf", Stat,
compute_group = function(data, scales, n = NULL, pad = TRUE) {
required_aes = c("x|y"),

default_aes = aes(y = after_stat(y)),

setup_params = function(data, params) {
params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = FALSE, main_is_continuous = TRUE)

has_x <- !(is.null(data$x) && is.null(params$x))
has_y <- !(is.null(data$y) && is.null(params$y))
if (!has_x && !has_y) {
abort("stat_ecdf() requires an x or y aesthetic.")
}

params
},

compute_group = function(data, scales, n = NULL, pad = TRUE, flipped_aes = FALSE) {
data <- flip_data(data, flipped_aes)
# If n is NULL, use raw values; otherwise interpolate
if (is.null(n)) {
x <- unique(data$x)
Expand All @@ -78,13 +99,11 @@ StatEcdf <- ggproto("StatEcdf", Stat,
if (pad) {
x <- c(-Inf, x, Inf)
}
y <- ecdf(data$x)(x)

new_data_frame(list(x = x, y = y), n = length(x))
},

default_aes = aes(y = after_stat(y)),
data_ecdf <- ecdf(data$x)(x)

required_aes = c("x")
df_ecdf <- new_data_frame(list(x = x, y = data_ecdf), n = length(x))
df_ecdf$flipped_aes <- flipped_aes
flip_data(df_ecdf, flipped_aes)
}
)

7 changes: 6 additions & 1 deletion man/stat_ecdf.Rd

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

16 changes: 16 additions & 0 deletions tests/testthat/test-stat-ecdf.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,16 @@
context("stat_ecdf")

test_that("stat_ecdf works in both directions", {
p <- ggplot(mpg, aes(hwy)) + stat_ecdf()
x <- layer_data(p)
expect_false(x$flipped_aes[1])

p <- ggplot(mpg, aes(y = hwy)) + stat_ecdf()
y <- layer_data(p)
expect_true(y$flipped_aes[1])

x$flipped_aes <- NULL
y$flipped_aes <- NULL
expect_identical(x, flip_data(y, TRUE)[,names(x)])
})

0 comments on commit ca24e27

Please sign in to comment.