A ggplot jitter function based on Gaussian noise: position_jitter_gaussian()

position_jitter_gaussian.R

#
# provides function position_jitter_gaussian() for ggplot2
#
# Use parameters width and height for scaling of dispersion
#
# Example:
#df <- data.frame(
#  x = rep(c(1,3,2,5,5,5,5),5),
#  y = rep(c(1,3,2,5,5,5,5),5)
#)
#
#ggplot(df, aes(x, y)) +
#  geom_point() +
#  geom_text(aes(label = y), position = 
#              position_jitter_gaussian())


"%||%" <- function(a, b) {
  if (!is.null(a)) a else b
}

with_seed_null <- function(seed, code) {
  if (is.null(seed)) {
    code
  } else {
    withr::with_seed(seed, code)
  }
}

position_jitter_gaussian <- function(width = NULL, height = NULL, seed = NA) {
  if (!is.null(seed) && is.na(seed)) {
    seed <- sample.int(.Machine$integer.max, 1L)
  }
  cat("PROTO!")
  ggproto(NULL, PositionJitterGaussian,
          width = width,
          height = height,
          seed = seed
  )
}

jitter_gaussian <- function(x, factor = 1, amount = NULL)
{
  r <- rnorm(n=length(x),mean=0, sd=amount)
 # cat(paste0(r)+"\n")
  return( x+r)
}

#' @rdname ggplot2-ggproto
#' @format NULL
#' @usage NULL
#' @export
PositionJitterGaussian <- ggproto("PositionJitter", Position,
                          required_aes = c("x", "y"),
                          
                          setup_params = function(self, data) {
                            list(
                              width = self$width %||% (resolution(data$x, zero = FALSE) * 0.4),
                              height = self$height %||% (resolution(data$y, zero = FALSE) * 0.4),
                              seed = self$seed
                            )
                          },
                          
                          compute_layer = function(data, params, panel) {
                            trans_x <- if (params$width > 0) function(x) jitter_gaussian(x, amount = params$width)
                            trans_y <- if (params$height > 0) function(x) jitter_gaussian(x, amount = params$height)
                            
                            with_seed_null(params$seed, transform_position(data, trans_x, trans_y))
                          }
)


#
# Example Run
#

df <- data.frame(
  x = rep(c(1,3,2,5,5,5,5),5),
  y = rep(c(1,3,2,5,5,5,5),5)
)

ggplot(df, aes(x, y)) +
  geom_point() +
  geom_text(aes(label = y), position = 
              position_jitter_gaussian())