I am trying to create position adjustments for ggplot2 that explicitly control the way points are spread out along the (x)-axis (rather than just adding a random jitter). I successfully used the examples position_jitter and position_jitterdodge to create simple variants that should for my purposes:
PositionSpread <- ggproto("PositionSpread", Position,
required_aes = c("x", "y"),
setup_params = function(self, data) {
list(
sep = self$sep %||% (resolution(data$x, zero = FALSE) * .05),
max_width = self$max_width %||% (resolution(data$x, zero = FALSE) * 0.4)
)
},
compute_layer = function(self, data, params, layout) {
f <- function(sep, i, n) {
m <- ceiling(max(n) / 2)
ifelse(
as.logical(n %% 2),
sep * c(0, rep(1:m, each = 2) * rep(c(-1, 1), m))[i],
sep * (rep(1:m, each = 2)[i] - 1 / 2) * rep(c(-1, 1), m)
)
}
trans_x <- if(params$max_width > 0) function(df) {
df |>
group_by(x, y) |>
mutate(
i = 1:n(),
n = n(),
sep = pmin(params$sep, 2 * params$max_width / n),
adj = f(sep, i, n)
) |>
magrittr::extract("adj")
}
x_aes <- intersect(ggplot2:::ggplot_global$x_aes, names(data))
y_aes <- intersect(ggplot2:::ggplot_global$y_aes, names(data))
x <- if (length(x_aes) == 0) 0 else data[[x_aes[1]]]
y <- if (length(y_aes) == 0) 0 else data[[y_aes[1]]]
dummy_data <- vctrs::new_data_frame(list(x = x, y = y), nrow(data))
x_adj <- trans_x(dummy_data)
# Apply jitter
transform_position(data, function(x) x + x_adj)
}
)
position_spread <- function(max_width = NULL, sep = NULL) {
ggproto(NULL, PositionSpread,
max_width = max_width,
sep = sep
)
}
and
position_spreaddodge <- function(spread.width = NULL, spread.sep = NULL,
dodge.width = 0.75) {
ggplot2::ggproto(NULL, PositionSpreaddodge,
spread.width = spread.width,
spread.sep = spread.sep,
dodge.width = dodge.width
)
}
PositionSpreaddodge <- ggproto("PositionSpreaddodge", Position,
spread.width = NULL,
spread.sep = NULL,
dodge.width = NULL,
required_aes = c("x", "y"),
setup_params = function(self, data) {
flipped_aes <- has_flipped_aes(data)
data <- flip_data(data, flipped_aes)
spread.width <- self$spread.width %||% (resolution(data$x, zero = FALSE) * 0.4)
# Adjust the x transformation based on the number of 'dodge' variables
dodgecols <- intersect(c("fill", "colour", "linetype", "shape", "size", "alpha"), colnames(data))
if (length(dodgecols) == 0) {
abort("`position_jitterdodge()` requires at least one aesthetic to dodge by")
}
ndodge <- lapply(data[dodgecols], levels) # returns NULL for numeric, i.e. non-dodge layers
ndodge <- length(unique(unlist(ndodge)))
list(
dodge.width = self$dodge.width,
spread.sep = self$spread.sep %||% (resolution(data$x, zero = FALSE) * .05),
spread.width = spread.width / (ndodge + 2),
flipped_aes = flipped_aes
)
},
compute_panel = function(data, params, scales) {
data <- flip_data(data, params$flipped_aes)
data <- ggplot2:::collide(data, params$dodge.width, "position_jitterdodge", ggplot2:::pos_dodge,
check.width = FALSE)
f <- function(sep, i, n) {
m <- ceiling(max(n) / 2)
ifelse(
as.logical(n %% 2),
sep * c(0, rep(1:m, each = 2) * rep(c(-1, 1), m))[i],
sep * (rep(1:m, each = 2)[i] - 1 / 2) * rep(c(-1, 1), m)
)
}
trans_x <- if(params$spread.width > 0) function(df) {
df |>
group_by(x, y) |>
mutate(
i = 1:n(),
n = n(),
sep = pmin(params$spread.sep, 2 * params$spread.width / n),
adj = f(sep, i, n)
) |>
magrittr::extract2("adj")
}
x_aes <- intersect(ggplot2:::ggplot_global$x_aes, names(data))
y_aes <- intersect(ggplot2:::ggplot_global$y_aes, names(data))
x <- if (length(x_aes) == 0) 0 else data[[x_aes[1]]]
y <- if (length(y_aes) == 0) 0 else data[[y_aes[1]]]
dummy_data <- vctrs::new_data_frame(list(x = x, y = y), nrow(data))
x_adj <- trans_x(dummy_data) |> unclass()
# Apply Spread
data <- transform_position(data, function(x) x + x_adj)
flip_data(data, params$flipped_aes)
}
)
These functions both appear to work fine. Now, I'm trying to add them to an internal package so that I have easy access to them across multiple projects, but I'm running into an issue with documentation. I've added Depends: ggplot2 (>= 3.0.0) in the DESCRIPTION file.
Using position_spreaddodge as example, I've added the following comments:
#' Simultaneously dodge and spread points
#'
#' This is primarily used for aligning points generated through
#' `geom_point()` with dodged boxplots (e.g., a `geom_boxplot()` with
#' a fill aesthetic supplied).
#'
#' @family position adjustments
#' @param spread.width degree of spread in x direction. Once points get spread to this amount, the space between points starts being compressed
#' @param spread.sep separation between points before compression.
#' @param dodge.width the amount to dodge in the x direction. Defaults to 0.75,
#' the default `position_dodge()` width.
#' @export
position_spreaddodge <- function(spread.width = NULL, spread.sep = NULL,
dodge.width = 0.75) {
ggplot2::ggproto(NULL, PositionSpreaddodge,
spread.width = spread.width,
spread.sep = spread.sep,
dodge.width = dodge.width
)
}
#' @format NULL
#' @usage NULL
#' @export
PositionSpreaddodge <- ggproto("PositionSpreaddodge", Position,
spread.width = NULL,
spread.sep = NULL,
dodge.width = NULL,
required_aes = c("x", "y"),
setup_params = function(self, data) {
flipped_aes <- has_flipped_aes(data)
data <- flip_data(data, flipped_aes)
spread.width <- self$spread.width %||% (resolution(data$x, zero = FALSE) * 0.4)
# Adjust the x transformation based on the number of 'dodge' variables
dodgecols <- intersect(c("fill", "colour", "linetype", "shape", "size", "alpha"), colnames(data))
if (length(dodgecols) == 0) {
abort("`position_jitterdodge()` requires at least one aesthetic to dodge by")
}
ndodge <- lapply(data[dodgecols], levels) # returns NULL for numeric, i.e. non-dodge layers
ndodge <- length(unique(unlist(ndodge)))
list(
dodge.width = self$dodge.width,
spread.sep = self$spread.sep %||% (resolution(data$x, zero = FALSE) * .05),
spread.width = spread.width / (ndodge + 2),
flipped_aes = flipped_aes
)
},
compute_panel = function(data, params, scales) {
data <- flip_data(data, params$flipped_aes)
data <- ggplot2:::collide(data, params$dodge.width, "position_jitterdodge", ggplot2:::pos_dodge,
check.width = FALSE)
f <- function(sep, i, n) {
m <- ceiling(max(n) / 2)
ifelse(
as.logical(n %% 2),
sep * c(0, rep(1:m, each = 2) * rep(c(-1, 1), m))[i],
sep * (rep(1:m, each = 2)[i] - 1 / 2) * rep(c(-1, 1), m)
)
}
trans_x <- if(params$spread.width > 0) function(df) {
df |>
group_by(x, y) |>
mutate(
i = 1:n(),
n = n(),
sep = pmin(params$spread.sep, 2 * params$spread.width / n),
adj = f(sep, i, n)
) |>
magrittr::extract2("adj")
}
x_aes <- intersect(ggplot2:::ggplot_global$x_aes, names(data))
y_aes <- intersect(ggplot2:::ggplot_global$y_aes, names(data))
x <- if (length(x_aes) == 0) 0 else data[[x_aes[1]]]
y <- if (length(y_aes) == 0) 0 else data[[y_aes[1]]]
dummy_data <- vctrs::new_data_frame(list(x = x, y = y), nrow(data))
x_adj <- trans_x(dummy_data) |> unclass()
# Apply Spread
data <- transform_position(data, function(x) x + x_adj)
flip_data(data, params$flipped_aes)
}
)
When trying to run document() with either of these functions in the package, I get the error "Error: _inherit must be a ggproto object." I cannot figure out what the error is trying to tell me, which makes it impossible to fix. It's clearly an issue with the documentation I've added, but I'm not sure what I'm missing.
Thanks!