isolate bandwidth logic

Author: teunbrand

R/stat-density-2d.R

@@ -182,24 +182,7 @@ StatDensity2d <- ggproto("StatDensity2d", Stat,
   compute_group = function(data, scales, na.rm = FALSE, h = NULL, adjust = c(1, 1),
                            n = 100, ...) {
 
-    if (is.null(h)) {
-      # Note: MASS::bandwidth.nrd is equivalent to stats::bw.nrd * 4
-      h <- c(MASS::bandwidth.nrd(data$x), MASS::bandwidth.nrd(data$y))
-      # Handle case when when IQR == 0 and thus regular nrd bandwidth fails
-      if (h[1] == 0) {
-        h[1] <- bw.nrd0(data$x) * 4
-      }
-      if (h[2] == 0) {
-        h[2] <- bw.nrd0(data$y) * 4
-      }
-      h <- h * adjust
-    }
-    if (any(is.na(h) | h <= 0)) {
-      cli::cli_abort(c(
-        "The bandwidth argument {.arg h} must contain numbers larger than 0.",
-        i = "Please set the {.arg h} argument to stricly positive numbers manually."
-      ))
-    }
+    h <- precompute_2d_bw(data$x, data$y, h = h, adjust = adjust)
 
     # calculate density
     dens <- MASS::kde2d(
@@ -232,3 +215,27 @@ StatDensity2dFilled <- ggproto("StatDensity2dFilled", StatDensity2d,
   contour_type = "bands"
 )
 
+precompute_2d_bw <- function(x, y, h = NULL, adjust = 1) {
+
+  if (is.null(h)) {
+    # Note: MASS::bandwidth.nrd is equivalent to stats::bw.nrd * 4
+    h <- c(MASS::bandwidth.nrd(x), MASS::bandwidth.nrd(y))
+    # Handle case when when IQR == 0 and thus regular nrd bandwidth fails
+    if (h[1] == 0 && length(x) > 1) h[1] <- bw.nrd0(x) * 4
+    if (h[2] == 0 && length(y) > 1) h[2] <- bw.nrd0(y) * 4
+    h <- h * adjust
+  }
+
+  check_numeric(h)
+  check_length(h, 2L)
+
+  if (any(is.na(h) | h <= 0)) {
+    cli::cli_abort(c(
+      "The bandwidth argument {.arg h} must contain numbers larger than 0.",
+      i = "Please set the {.arg h} argument to stricly positive numbers manually."
+    ))
+  }
+
+  h
+}
+