From 5935bb36baf19cced11c027dd27b597120d82ebf Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 21 Mar 2025 10:10:10 +0100 Subject: [PATCH 1/6] throw informative error --- R/stat-density-2d.R | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/R/stat-density-2d.R b/R/stat-density-2d.R index af2b10b14d..f383e41d6c 100644 --- a/R/stat-density-2d.R +++ b/R/stat-density-2d.R @@ -182,6 +182,12 @@ StatDensity2d <- ggproto("StatDensity2d", Stat, h <- c(MASS::bandwidth.nrd(data$x), MASS::bandwidth.nrd(data$y)) 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." + )) + } # calculate density dens <- MASS::kde2d( From d2bbdfeca725bbd3b9a7a05087493b6e5a4bfe10 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 21 Mar 2025 10:10:27 +0100 Subject: [PATCH 2/6] do not attempt to contour with empty data --- R/stat-density-2d.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/stat-density-2d.R b/R/stat-density-2d.R index f383e41d6c..bf6cdb04fd 100644 --- a/R/stat-density-2d.R +++ b/R/stat-density-2d.R @@ -141,6 +141,9 @@ StatDensity2d <- ggproto("StatDensity2d", Stat, check_installed("MASS", reason = "for calculating 2D density.") # first run the regular layer calculation to infer densities data <- ggproto_parent(Stat, self)$compute_layer(data, params, layout) + if (empty(data)) { + return(data_frame0()) + } # if we're not contouring we're done if (!isTRUE(params$contour %||% TRUE)) return(data) From 418d84d9f86dd2c80524364bfd653946a7931471 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 21 Mar 2025 10:14:56 +0100 Subject: [PATCH 3/6] add test --- tests/testthat/test-stat-density2d.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/tests/testthat/test-stat-density2d.R b/tests/testthat/test-stat-density2d.R index b5c41efd7d..43a99e9513 100644 --- a/tests/testthat/test-stat-density2d.R +++ b/tests/testthat/test-stat-density2d.R @@ -95,3 +95,10 @@ test_that("stat_density2d can produce contour and raster data", { # error on incorrect contouring variable expect_snapshot_error(ggplot_build(p + stat_density_2d(contour_var = "abcd"))) }) + +test_that("stat_density_2d handles faulty bandwidth", { + p <- ggplot(faithful, aes(eruptions, waiting)) + + stat_density_2d(h = c(0, NA)) + expect_snapshot_warning(b <- ggplot_build(p)) + expect_s3_class(layer_grob(b)[[1]], "zeroGrob") +}) From 7712c8d626633f47209c600b8152dbdda0f67ad9 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 21 Mar 2025 10:21:50 +0100 Subject: [PATCH 4/6] fallback for 0 IQR data --- R/stat-density-2d.R | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/R/stat-density-2d.R b/R/stat-density-2d.R index bf6cdb04fd..e6da37feab 100644 --- a/R/stat-density-2d.R +++ b/R/stat-density-2d.R @@ -181,8 +181,17 @@ 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)) { From d79623a083e7b84e4f31d5da009a9b131d08d1c6 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 21 Mar 2025 11:15:53 +0100 Subject: [PATCH 5/6] isolate bandwidth logic --- R/stat-density-2d.R | 43 +++++++++++++++++++++++++------------------ 1 file changed, 25 insertions(+), 18 deletions(-) diff --git a/R/stat-density-2d.R b/R/stat-density-2d.R index e6da37feab..69bef8430c 100644 --- a/R/stat-density-2d.R +++ b/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 +} + From f61e2f40a8ad38a5b65c7504b8690d894d9e2ba6 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 21 Mar 2025 11:16:00 +0100 Subject: [PATCH 6/6] accept snapshot --- tests/testthat/_snaps/stat-density2d.md | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/tests/testthat/_snaps/stat-density2d.md b/tests/testthat/_snaps/stat-density2d.md index a8840aaa76..03a875c63c 100644 --- a/tests/testthat/_snaps/stat-density2d.md +++ b/tests/testthat/_snaps/stat-density2d.md @@ -5,3 +5,10 @@ Caused by error in `compute_layer()`: ! `contour_var` must be one of "density", "ndensity", or "count", not "abcd". +# stat_density_2d handles faulty bandwidth + + Computation failed in `stat_density2d()`. + Caused by error in `precompute_2d_bw()`: + ! The bandwidth argument `h` must contain numbers larger than 0. + i Please set the `h` argument to stricly positive numbers manually. +