diff --git a/R/stat-density-2d.R b/R/stat-density-2d.R index af2b10b14d..69bef8430c 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) @@ -178,10 +181,8 @@ StatDensity2d <- ggproto("StatDensity2d", Stat, compute_group = function(data, scales, na.rm = FALSE, h = NULL, adjust = c(1, 1), n = 100, ...) { - if (is.null(h)) { - h <- c(MASS::bandwidth.nrd(data$x), MASS::bandwidth.nrd(data$y)) - h <- h * adjust - } + + h <- precompute_2d_bw(data$x, data$y, h = h, adjust = adjust) # calculate density dens <- MASS::kde2d( @@ -214,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 +} + 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. + 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") +})