From afcf92101d247fdec3d039caa0860c19a96808ce Mon Sep 17 00:00:00 2001 From: Jan Gleixner Date: Thu, 30 Nov 2023 21:55:22 +0100 Subject: [PATCH] remove whitespace (source formating) --- R/geom_pointdensity.R | 225 +++++++++++++++++++++--------------------- 1 file changed, 111 insertions(+), 114 deletions(-) diff --git a/R/geom_pointdensity.R b/R/geom_pointdensity.R index ce1d74f..296d6e1 100644 --- a/R/geom_pointdensity.R +++ b/R/geom_pointdensity.R @@ -51,126 +51,123 @@ stat_pointdensity <- function(mapping = NULL, #' @usage NULL #' @export StatPointdensity <- ggproto("StatPointdensity", Stat, - default_aes = aes(color = stat(density)), - required_aes = c("x", "y"), - - compute_layer = function(self, data, params, layout) { - # This function mostly copied from ggplot2's Stat - ggplot2:::check_required_aesthetics( - self$required_aes, - c(names(data), names(params)), - ggplot2:::snake_class(self) - ) - - # Make sure required_aes consists of the used set of aesthetics in case of - # "|" notation in self$required_aes - required_aes <- intersect( - names(data), - unlist(strsplit(self$required_aes, "|", fixed = TRUE)) - ) - - data <- ggplot2:::remove_missing(data, params$na.rm, - c(required_aes, self$non_missing_aes), - ggplot2:::snake_class(self), - finite = FALSE # Note that in ggplot2's Stat this is TRUE - ) - - # Trim off extra parameters - params <- params[intersect(names(params), self$parameters())] - - args <- c(list(data = quote(data), scales = quote(scales)), params) - 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)), - error = function(cnd) { - cli::cli_warn("Computation failed in {.fn {ggplot2:::snake_class(self)}}", parent = cnd) - ggplot2:::data_frame0() - } - ) - }) - }, - - setup_params = function(data, params) { - if (identical(params$method, "auto")) { - # Use default nn correction for small datasets, kde2d for - # larger. Based on size of the _largest_ group. - max_group <- max(table(interaction(data$group, data$PANEL, drop = TRUE))) - if (max_group > 20000) { - message(paste0("geom_pointdensity using method='kde2d' ", - "due to large number of points (>20k)")) - params$method <- "kde2d" - } else { - params$method <- "default" - } - } - - params - }, - - compute_group = function(data, scales, adjust = 1, method = "auto", - method.args = list()) { - - 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 - - # since x and y may be on different scales, we need a - # factor to weight x and y distances accordingly: - xy <- xrange / yrange - - # counting the number of neighbors around each point, - # this will be used to color the points - data$density <- count_neighbors( - data$x, data$y, r2 = r2, xy = xy) - - - } else if (identical(method, "kde2d")) { - - finites <- is.finite(data$x) & is.finite(data$y) - ddata <- data[finites,] - base.args <- list( - x = ddata$x, - y = ddata$y, - lims = c(scales$x$dimension(), scales$y$dimension())) - if (!is.element("n", names(method.args))) { - 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 - } - - dens <- do.call(MASS::kde2d, c(base.args, method.args)) - # credits to Kamil Slowikowski: - ix <- findInterval(data$x, dens$x) - iy <- findInterval(data$y, dens$y) - ii <- cbind(ix, iy) - data$density[finites] <- dens$z[ii] - data$density[!finites] <- min(dens$z) - } else { - - if (is.character(method)) { - method <- match.fun(method) - } - data$density <- do.call(method, c(method.args)) - - } + default_aes = aes(color = stat(density)), + required_aes = c("x", "y"), + + compute_layer = function(self, data, params, layout) { + # This function mostly copied from ggplot2's Stat + ggplot2:::check_required_aesthetics( + self$required_aes, + c(names(data), names(params)), + ggplot2:::snake_class(self) + ) + # Make sure required_aes consists of the used set of aesthetics in case of + # "|" notation in self$required_aes + required_aes <- intersect( + names(data), + unlist(strsplit(self$required_aes, "|", fixed = TRUE)) + ) - data$ndensity <- data$density/max(data$density) + data <- ggplot2:::remove_missing(data, params$na.rm, + c(required_aes, self$non_missing_aes), + ggplot2:::snake_class(self), + finite = FALSE # Note that in ggplot2's Stat this is TRUE + ) - data - } + # Trim off extra parameters + params <- params[intersect(names(params), self$parameters())] + + args <- c(list(data = quote(data), scales = quote(scales)), params) + 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)), + error = function(cnd) { + cli::cli_warn("Computation failed in {.fn {ggplot2:::snake_class(self)}}", parent = cnd) + ggplot2:::data_frame0() + } + ) + }) + }, + + setup_params = function(data, params) { + if (identical(params$method, "auto")) { + # Use default nn correction for small datasets, kde2d for + # larger. Based on size of the _largest_ group. + max_group <- max(table(interaction(data$group, data$PANEL, drop = TRUE))) + if (max_group > 20000) { + message(paste0("geom_pointdensity using method='kde2d' ", + "due to large number of points (>20k)")) + params$method <- "kde2d" + } else { + params$method <- "default" + } + } + + params + }, + + compute_group = function(data, scales, adjust = 1, method = "auto", + method.args = list()) { + + 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 + + # since x and y may be on different scales, we need a + # factor to weight x and y distances accordingly: + xy <- xrange / yrange + + # counting the number of neighbors around each point, + # this will be used to color the points + data$density <- count_neighbors( + data$x, data$y, r2 = r2, xy = xy) + + + } else if (identical(method, "kde2d")) { + + finites <- is.finite(data$x) & is.finite(data$y) + ddata <- data[finites,] + base.args <- list( + x = ddata$x, + y = ddata$y, + lims = c(scales$x$dimension(), scales$y$dimension())) + if (!is.element("n", names(method.args))) { + 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 + } + + dens <- do.call(MASS::kde2d, c(base.args, method.args)) + # credits to Kamil Slowikowski: + ix <- findInterval(data$x, dens$x) + iy <- findInterval(data$y, dens$y) + ii <- cbind(ix, iy) + data$density[finites] <- dens$z[ii] + data$density[!finites] <- min(dens$z) + } else { + + if (is.character(method)) { + method <- match.fun(method) + } + data$density <- do.call(method, c(method.args)) + + } + + + data$ndensity <- data$density/max(data$density) + + data + } ) - - - #' A cross between a scatter plot and a 2D density plot #' #' The pointdensity geom is used to create scatterplots where each point is