Weighted ellipses

NEWS.md

@@ -267,6 +267,7 @@
 * Standardised the calculation of `width`, which are now implemented as
   aesthetics (@teunbrand, #2800).
 * Stricter check on `register_theme_elements(element_tree)` (@teunbrand, #6162)
+* Added `weight` aesthetic for `stat_ellipse()` (@teunbrand, #5272)
 
 # ggplot2 3.5.1
 

R/stat-ellipse.R

@@ -20,6 +20,7 @@
 #' @param segments The number of segments to be used in drawing the ellipse.
 #' @inheritParams layer
 #' @inheritParams geom_point
+#' @eval rd_aesthetics("stat", "ellipse")
 #' @export
 #' @examples
 #' ggplot(faithful, aes(waiting, eruptions)) +
@@ -76,6 +77,8 @@
 #' @export
 StatEllipse <- ggproto("StatEllipse", Stat,
   required_aes = c("x", "y"),
+  optional_aes = "weight",
+  dropped_aes = "weight",
 
   setup_params = function(data, params) {
     params$type <- params$type %||% "t"
@@ -96,6 +99,9 @@
   dfn <- 2
   dfd <- nrow(data) - 1
 
+  weight <- data$weight %||% rep(1, nrow(data))
+  weight <- weight / sum(weight)
+
   if (!type %in% c("t", "norm", "euclid")) {
     cli::cli_inform("Unrecognized ellipse type")
     ellipse <- matrix(NA_real_, ncol = 2)
@@ -104,11 +110,12 @@
     ellipse <- matrix(NA_real_, ncol = 2)
   } else {
     if (type == "t") {
-      v <- MASS::cov.trob(data[,vars])
+      # Prone to convergence problems when `sum(weight) != nrow(data)`
+      v <- MASS::cov.trob(data[,vars], wt = weight * nrow(data))
     } else if (type == "norm") {
-      v <- stats::cov.wt(data[,vars])
+      v <- stats::cov.wt(data[,vars], wt = weight)
     } else if (type == "euclid") {
-      v <- stats::cov.wt(data[,vars])
+      v <- stats::cov.wt(data[,vars], wt = weight)
       v$cov <- diag(rep(min(diag(v$cov)), 2))
     }
     shape <- v$cov