我正在尝试为ggplot2创建位置调整，以明确控制点沿 (x) 轴分布的方式（而不仅仅是添加随机抖动）。我成功地使用了这些示例position_jitter并position_jitterdodge创建了适合我的目的的简单变体：
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
)
}
和
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)
}
)
这些功能似乎都可以正常工作。现在，我正在尝试将它们添加到内部包中，以便在多个项目中轻松访问它们，但我遇到了文档问题。我已经Depends: ggplot2 (>= 3.0.0)在DESCRIPTION文件中添加了。
以position_spreaddodge示例为例，我添加了以下注释：
#' 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)
}
)
尝试document()使用包中的任何一个函数运行时，我收到错误“错误：_inherit必须是 ggproto 对象”。我无法弄清楚错误试图告诉我什么，这使得无法修复。这显然是我添加的文档的问题，但我不确定我错过了什么。
谢谢！