Skip to content

Commit

Permalink
use plot range instead of data range to determine bandwith or radius
Browse files Browse the repository at this point in the history
  • Loading branch information
@jan-glx
jan-glx committed Nov 30, 2023
1 parent afcf921 commit 3d75d67
Showing 1 changed file with 13 additions and 8 deletions.
21 changes: 13 additions & 8 deletions R/geom_pointdensity.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -82,7 +82,7 @@ StatPointdensity <- ggproto("StatPointdensity", Stat,
ggplot2:::dapply(data, "PANEL", function(data) {
scales <- layout$get_scales(data$PANEL[1])
rlang::try_fetch(
rlang::inject(self$compute_panel(data = data, scales = scales, !!!params)),
rlang::inject(self$compute_panel(data = data, scales = scales, !!!params, coord = layout$coord)),
error = function(cnd) {
cli::cli_warn("Computation failed in {.fn {ggplot2:::snake_class(self)}}", parent = cnd)
ggplot2:::data_frame0()
Expand All @@ -109,18 +109,19 @@ StatPointdensity <- ggproto("StatPointdensity", Stat,
},

compute_group = function(data, scales, adjust = 1, method = "auto",
method.args = list()) {
method.args = list(), coord) {
scale_views <- coord$setup_panel_params(scales$x, scales$y)
dx <- diff(xrange <- scale_views$x.range)
dy <- diff(yrange <- scale_views$y.range)

if (identical(method, "default")) {

# find an appropriate bandwidth (radius), pretty ad-hoc:
xrange <- diff(scales$x$get_limits()) * adjust
yrange <- diff(scales$y$get_limits()) * adjust
r2 <- (xrange + yrange) / 70
r2 <- (dx + dy) / 70 * adjust

# since x and y may be on different scales, we need a
# factor to weight x and y distances accordingly:
xy <- xrange / yrange
xy <- dx / dy

# counting the number of neighbors around each point,
# this will be used to color the points
Expand All @@ -140,8 +141,12 @@ StatPointdensity <- ggproto("StatPointdensity", Stat,
method.args["n"] <- 100
}
if (!is.element("h", names(method.args))) {
h <- c(MASS::bandwidth.nrd(ddata$x), MASS::bandwidth.nrd(ddata$y))
method.args$h <- h * adjust
bandwidth_std <- c(x=MASS::bandwidth.nrd(ddata$x), y=MASS::bandwidth.nrd(ddata$y))
#alternative bandwidth calculation based on plot size that tries to match above
bandwidth_limits <- 4 * 1.06 * c(dx, dy) / (2*qnorm(1/nrow(ddata)/2, lower.tail = FALSE)) * nrow(ddata)^(-1/5)
bandwidth <- pmax(bandwidth_limits, bandwidth_std) #

method.args$h <- bandwidth * adjust
}

dens <- do.call(MASS::kde2d, c(base.args, method.args))
Expand Down

1 comment on commit 3d75d67

@jan-glx
Copy link
Contributor Author

@jan-glx jan-glx commented on 3d75d67 May 16, 2024 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

get_limits returns the scale limits(e.g. xlim) or the data range if unset:

https://github.com/tidyverse/ggplot2/blob/9af5d810164c05b7f7abaea357a664433470b48d/R/scale-.R#L540

scale_views$x.range returns the coord limits i.e. after expansion:

  setup_panel_params = function(self, scale_x, scale_y, params = list()) {
    c(
      view_scales_from_scale(scale_x, self$limits$x, self$expand),
      view_scales_from_scale(scale_y, self$limits$y, self$expand)
    )
  },

https://github.com/tidyverse/ggplot2/blob/9af5d810164c05b7f7abaea357a664433470b48d/R/coord-cartesian-.R#L101-L106

view_scales_from_scale <- function(scale, coord_limits = NULL, expand = TRUE) {
  expansion <- default_expansion(scale, expand = expand)
  limits <- scale$get_limits()
  continuous_range <- expand_limits_scale(scale, expansion, limits, coord_limits = coord_limits)
  aesthetic <- scale$aesthetics[1]


  view_scales <- list(
    view_scale_primary(scale, limits, continuous_range),
    sec = view_scale_secondary(scale, limits, continuous_range),
    range = continuous_range
  )
  names(view_scales) <- c(aesthetic, paste0(aesthetic, ".", names(view_scales)[-1]))


  view_scales
}

https://github.com/tidyverse/ggplot2/blob/9af5d810164c05b7f7abaea357a664433470b48d/R/coord-cartesian-.R#L101-L106

https://github.com/tidyverse/ggplot2/blob/9af5d810164c05b7f7abaea357a664433470b48d/R/scale-expansion.R#L133

Please sign in to comment.