diff --git a/NEWS.md b/NEWS.md index 61af1b3..600ff4e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,7 @@ ggridges 0.5.6.9000 ---------------------------------------------------------------- - +- Add support for weighted density estimates in `stat_density_ridges()` by + allowing the use of the `weight` aesthetic (@joranE, #90) ggridges 0.5.6 ---------------------------------------------------------------- diff --git a/R/geoms.R b/R/geoms.R index 7a6775c..4f22d9b 100644 --- a/R/geoms.R +++ b/R/geoms.R @@ -390,6 +390,7 @@ GeomRidgeline <- ggproto("GeomRidgeline", Geom, #' #' * **`x`** #' * **`y`** +#' * `weight` Optional case weights passed to `stats::density` to calculate a weighted density estimate #' * `group` Defines the grouping. Not needed if a categorical variable is mapped onto `y`, but needed otherwise. Will typically be the same #' variable as is mapped to `y`. #' * `height` The height of each ridgeline at the respective x value. Automatically calculated and @@ -475,7 +476,7 @@ GeomDensityRidges <- ggproto("GeomDensityRidges", GeomRidgeline, required_aes = c("x", "y", "height"), - optional_aes = c("point_color", "vline_color", "vline_size", "vline_width"), + optional_aes = c("point_color", "vline_color", "vline_size", "vline_width", "weight"), extra_params = c("na.rm", "panel_scaling"), diff --git a/R/stats.R b/R/stats.R index 9532bd9..b09fdb2 100644 --- a/R/stats.R +++ b/R/stats.R @@ -99,7 +99,9 @@ stat_density_ridges <- function(mapping = NULL, data = NULL, geom = "density_rid StatDensityRidges <- ggproto("StatDensityRidges", Stat, required_aes = "x", - default_aes = aes(height = after_stat(density)), + default_aes = aes(height = after_stat(density), weight = NULL), + + dropped_aes = "weight", calc_panel_params = function(data, params) { if (is.null(params$bandwidth)) { @@ -166,8 +168,15 @@ StatDensityRidges <- ggproto("StatDensityRidges", Stat, } panel_id <- as.numeric(panel) + if (is.null(data$weight)) { + weights <- NULL + } else { + weights <- data$weight / sum(data$weight) + } + d <- stats::density( data$x, + weights = weights, bw = bandwidth[panel_id], from = from[panel_id], to = to[panel_id], na.rm = TRUE, n = n ) diff --git a/man/geom_density_ridges.Rd b/man/geom_density_ridges.Rd index d13a4c7..3fcc33c 100644 --- a/man/geom_density_ridges.Rd +++ b/man/geom_density_ridges.Rd @@ -96,6 +96,7 @@ Required aesthetics are in bold. \itemize{ \item \strong{\code{x}} \item \strong{\code{y}} +\item \code{weight} Optional case weights passed to \code{stats::density} to calculate a weighted density estimate \item \code{group} Defines the grouping. Not needed if a categorical variable is mapped onto \code{y}, but needed otherwise. Will typically be the same variable as is mapped to \code{y}. \item \code{height} The height of each ridgeline at the respective x value. Automatically calculated and diff --git a/tests/testthat/test_stat_density_ridges.R b/tests/testthat/test_stat_density_ridges.R index c3dd623..22c8dc2 100644 --- a/tests/testthat/test_stat_density_ridges.R +++ b/tests/testthat/test_stat_density_ridges.R @@ -110,3 +110,23 @@ test_that("alternative quantile function can be provided", { expect_setequal(out$datatype, c("ridgeline", "vline")) expect_equal(out$x[out$datatype=="vline"], mean(df$x)) }) + +test_that("unweighted densities are calculated correctly", { + df <- data.frame(x = rnorm(100), wts = runif(100)) + df$wts <- df$wts / sum(df$wts) + + gg_no_wts <- layer_data(ggplot(df, aes(x = x, y = 0)) + stat_density_ridges()) + d_no_wts <- stats::density(df$x) + + expect_equal(gg_no_wts$density, d_no_wts$y) +}) + +test_that("weighted densities are calculated correctly", { + df <- data.frame(x = rnorm(100), wts = runif(100)) + df$wts <- df$wts / sum(df$wts) + + gg_wts <- layer_data(ggplot(df, aes(x = x, y = 0, weight = wts)) + stat_density_ridges()) + d_wts <- stats::density(df$x, weights = df$wts) + + expect_equal(gg_wts$density, d_wts$y) +})