Apr 22, 2024 · Apr 22, 2024 · Apr 22, 2024 · Apr 22, 2024 · Apr 22, 2024
diff --git a/R/stat-density.R b/R/stat-density.R
 # using `density(..., warnWbw = FALSE)`.
 precompute_bw = function(x, bw = "nrd0") {
  bw <- bw[1]
  if (length(x) < 2) {
    cli::cli_abort("{.arg x} must contain at least 2 elements to select a \\
                   bandwidth automatically.")
  }
  if (is.character(bw)) {
    bw <- arg_match0(bw, c("nrd0", "nrd", "ucv", "bcv", "sj", "sj-ste", "sj-dpi"))
    bw <- switch(
diff --git a/R/stat-ydensity.R b/R/stat-ydensity.R
    }
    range <- range(data$y, na.rm = TRUE)
    modifier <- if (trim) 0 else 3
    bw <-calc_bw(data$y, bw)
    bw <-precompute_bw(data$y, bw)
    dens <- compute_density(
      data$y, data[["weight"]],
      from = range[1] - modifier * bw, to = range[2] + modifier * bw,

  dropped_aes = "weight"
 )

 calc_bw <- function(x, bw) {
  if (is.character(bw)) {
    if (length(x) < 2) {
      cli::cli_abort("{.arg x} must contain at least 2 elements to select a bandwidth automatically.")
    }

    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"),
      cli::cli_abort("{.var {bw}} is not a valid bandwidth rule.")
    )
  }
  bw
 }
diff --git a/tests/testthat/test-stat-ydensity.R b/tests/testthat/test-stat-ydensity.R
 test_that("calc_bw() requires at least two values and correct method", {
  expect_snapshot_error(calc_bw(1, "nrd0"))
  expect_silent(calc_bw(1:5, "nrd0"))
  expect_snapshot_error(calc_bw(1:5, "test"))
  expect_snapshot_error(precompute_bw(1, "nrd0"))
  expect_silent(precompute_bw(1:5, "nrd0"))
  expect_snapshot_error(precompute_bw(1:5, "test"))
 })

 test_that("`drop = FALSE` preserves groups with 1 observations", {
Original file line number	Diff line number	Diff line change
Expand Up		@@ -222,6 +222,10 @@ reflect_density <- function(dens, bounds, from, to) {
		# using `density(..., warnWbw = FALSE)`.
		precompute_bw = function(x, bw = "nrd0") {
		bw <- bw[1]
		if (length(x) < 2) {
		cli::cli_abort("{.arg x} must contain at least 2 elements to select a \\
		bandwidth automatically.")
		}
		if (is.character(bw)) {
		bw <- arg_match0(bw, c("nrd0", "nrd", "ucv", "bcv", "sj", "sj-ste", "sj-dpi"))
		bw <- switch(
Expand Down
Original file line number	Diff line number	Diff line change
Expand Up		@@ -96,7 +96,7 @@ StatYdensity <- ggproto("StatYdensity", Stat,
		}
		range <- range(data$y, na.rm = TRUE)
		modifier <- if (trim) 0 else 3
		bw <-calc_bw(data$y, bw)
		bw <-precompute_bw(data$y, bw)
		dens <- compute_density(
		data$y, data[["weight"]],
		from = range[1] - modifier * bw, to = range[2] + modifier * bw,
Expand DownExpand Up		@@ -151,24 +151,3 @@ StatYdensity <- ggproto("StatYdensity", Stat,

		dropped_aes = "weight"
		)

		calc_bw <- function(x, bw) {
		if (is.character(bw)) {
		if (length(x) < 2) {
		cli::cli_abort("{.arg x} must contain at least 2 elements to select a bandwidth automatically.")
		}

		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"),
		cli::cli_abort("{.var {bw}} is not a valid bandwidth rule.")
		)
		}
		bw
		}
Original file line number	Diff line number	Diff line change
		@@ -1,7 +1,7 @@
		test_that("calc_bw() requires at least two values and correct method", {
		expect_snapshot_error(calc_bw(1, "nrd0"))
		expect_silent(calc_bw(1:5, "nrd0"))
		expect_snapshot_error(calc_bw(1:5, "test"))
		expect_snapshot_error(precompute_bw(1, "nrd0"))
		expect_silent(precompute_bw(1:5, "nrd0"))
		expect_snapshot_error(precompute_bw(1:5, "test"))
		})

		test_that("`drop = FALSE` preserves groups with 1 observations", {
Expand Down