Silence new density() warning (#5281)

* precompute bandwidth

* Better code comment

* Add namespaces to bandwidth functions

Author: teunbrand

R/stat-density.R

@@ -1,7 +1,8 @@
 #' @param bw The smoothing bandwidth to be used.
 #'   If numeric, the standard deviation of the smoothing kernel.
 #'   If character, a rule to choose the bandwidth, as listed in
-#'   [stats::bw.nrd()].
+#'   [stats::bw.nrd()]. Note that automatic calculation of the bandwidth does
+#'   not take weights into account.
 #' @param adjust A multiplicate bandwidth adjustment. This makes it possible
 #'    to adjust the bandwidth while still using the a bandwidth estimator.
 #'    For example, `adjust = 1/2` means use half of the default bandwidth.
@@ -139,6 +140,7 @@ compute_density <- function(x, w, from, to, bw = "nrd0", adjust = 1,
     ))
   }
 
+  bw <- precompute_bw(x, bw)
   # Decide whether to use boundary correction
   if (any(is.finite(bounds))) {
     dens <- stats::density(x, weights = w, bw = bw, adjust = adjust,
@@ -214,3 +216,29 @@ reflect_density <- function(dens, bounds, from, to) {
 
   list(x = out_x, y = out_y)
 }
+
+# Similar to stats::density.default
+# Once R4.3.0 is the lowest supported version, this function can be replaced by
+# using `density(..., warnWbw = FALSE)`.
+precompute_bw = function(x, bw = "nrd0") {
+  bw <- bw[1]
+  if (is.character(bw)) {
+    bw <- arg_match0(bw, c("nrd0", "nrd", "ucv", "bcv", "sj", "sj-ste", "sj-dpi"))
+    bw <- switch(
+      to_lower_ascii(bw),
+      nrd0 = stats::bw.nrd0(x),
+      nrd  = stats::bw.nrd(x),
+      ucv  = stats::bw.ucv(x),
+      bcv  = stats::bw.bcv(x),
+      sj   = ,
+      `sj-ste` = stats::bw.SJ(x, method = "ste"),
+      `sj-dpi` = stats::bw.SJ(x, method = "dpi")
+    )
+  }
+  if (!is.numeric(bw) || bw <= 0 || !is.finite(bw)) {
+    cli::cli_abort(
+      "{.arg bw} must be a finite, positive number, not {obj_type_friendly(bw)}."
+    )
+  }
+  bw
+}

man/geom_density.Rd

@@ -5,3 +5,11 @@
     Caused by error in `setup_params()`:
     ! `stat_density()` requires an x or y aesthetic.
 
+# precompute_bandwidth() errors appropriately
+
+    `bw` must be one of "nrd0", "nrd", "ucv", "bcv", "sj", "sj-ste", or "sj-dpi", not "foobar".
+
+---
+
+    `bw` must be a finite, positive number, not `Inf`.
+

man/geom_violin.Rd

@@ -19,7 +19,7 @@ test_that("stat_density can make weighted density estimation", {
   df <- mtcars
   df$weight <- mtcars$cyl / sum(mtcars$cyl)
 
-  dens <- stats::density(df$mpg, weights = df$weight)
+  dens <- stats::density(df$mpg, weights = df$weight, bw = bw.nrd0(df$mpg))
   expected_density_fun <- stats::approxfun(data.frame(x = dens$x, y = dens$y))
 
   plot <- ggplot(df, aes(mpg, weight = weight)) + stat_density()
@@ -118,3 +118,10 @@ test_that("compute_density returns useful df and throws warning when <2 values",
   expect_equal(names(dens), c("x", "density", "scaled", "ndensity", "count", "n"))
   expect_type(dens$x, "double")
 })
+
+test_that("precompute_bandwidth() errors appropriately", {
+  expect_silent(precompute_bw(1:10))
+  expect_equal(precompute_bw(1:10, 5), 5)
+  expect_snapshot_error(precompute_bw(1:10, bw = "foobar"))
+  expect_snapshot_error(precompute_bw(1:10, bw = Inf))
+})