ggplot2 在不关闭剪辑的情况下在绘图区域外添加小刻度线
ggplot2 add minor tick marks outside plotting area without turning clip off
我正在寻找一种在不使用 coord_cartesian(clip = "off") 的情况下向 ggplots 添加小刻度线的方法。或者一种可重现的方法将裁剪应用到 x 轴而不是 y 轴，反之亦然。
到目前为止，我一直在使用 annotation_ticks() 函数和这个优秀答案 中定义的 GeomTicks geom（进行一些小的修改以使其与 ggplot2 v3.3.0).不幸的是，要使刻度线注释出现在绘图的外部，必须使用 coord_cartesian(clip = "off")，这意味着位于绘图区域之外的任何其他内容也会暴露（请参见下面的 reprex）。
或者，也许有一种方法可以利用 ggplot2 v3.3.0 的任何新功能来绘制小刻度，而不是作为注释，而是作为 axis/plot 的实际部分，因此它是可以将它们绘制在绘图区域之外。
我不是软件开发人员，但也许可以使用 register_theme_elements 定义一个名为 axis.minor.ticks 的新主题元素，它的行为类似于 axis.ticks，但从panel_params$y$break_positions_minor 而不是 panel_params$y$break_positions。或者以某种方式使用新的 guide_x() S3 函数。
如有任何帮助，我们将不胜感激！
注解函数和ggproto对象
annotation_ticks() 函数（合并 this fix 用于分面问题）：
annotation_ticks <- function(sides = "b",
scale = "identity",
scaled = TRUE,
ticklength = unit(0.1, "cm"),
colour = "black",
size = 0.5,
linetype = 1,
alpha = 1,
color = NULL,
ticks_per_base = NULL,
data = data.frame(x = NA),
...) {
if (!is.null(color)) {
colour <- color
}
# check for invalid side
if (grepl("[^btlr]", sides)) {
stop(gsub("[btlr]", "", sides), " is not a valid side: b,t,l,r are valid")
}
# split sides to character vector
sides <- strsplit(sides, "")[[1]]
if (length(sides) != length(scale)) {
if (length(scale) == 1) {
scale <- rep(scale, length(sides))
} else {
stop("Number of scales does not match the number of sides")
}
}
base <- sapply(scale, function(x) switch(x, "identity" = 10, "log10" = 10, "log" = exp(1)), USE.NAMES = FALSE)
if (missing(ticks_per_base)) {
ticks_per_base <- base - 1
} else {
if ((length(sides) != length(ticks_per_base))) {
if (length(ticks_per_base) == 1) {
ticks_per_base <- rep(ticks_per_base, length(sides))
} else {
stop("Number of ticks_per_base does not match the number of sides")
}
}
}
delog <- scale %in% "identity"
layer(
data = data,
mapping = NULL,
stat = StatIdentity,
geom = GeomTicks,
position = PositionIdentity,
show.legend = FALSE,
inherit.aes = FALSE,
params = list(
base = base,
sides = sides,
scaled = scaled,
ticklength = ticklength,
colour = colour,
size = size,
linetype = linetype,
alpha = alpha,
ticks_per_base = ticks_per_base,
delog = delog,
...
)
)
}
ggproto 对象（现在可用于 ggplot2 v3.3.0）：
GeomTicks <- ggproto(
"GeomTicks", Geom,
extra_params = "",
handle_na = function(data, params) {
data
},
draw_panel = function(data,
panel_scales,
coord,
base = c(10, 10),
sides = c("b", "l"),
scaled = TRUE,
ticklength = unit(0.1, "cm"),
ticks_per_base = base - 1,
delog = c(x = TRUE, y = TRUE)) {
ticks <- list()
for (s in 1:length(sides)) {
if (grepl("[b|t]", sides[s])) {
# for ggplot2 < 3.3.0 use: xticks <- panel_params$x.minor
if (utils::packageVersion("ggplot2") >= "3.2.1.9000") {
x_minor_breaks <- panel_scales$x$break_positions_minor()
x_major_breaks <- panel_scales$x$break_positions()
} else {
x_minor_breaks <- panel_scales$x.minor
x_major_breaks <- panel_scales$x.major
}
xticks <- setdiff(x_minor_breaks, x_major_breaks)
# Make the grobs
if (grepl("b", sides[s])) {
ticks$x_b <- with(
data,
segmentsGrob(
x0 = unit(xticks, "npc"),
x1 = unit(xticks, "npc"),
y0 = unit(0, "npc"),
y1 = ticklength,
gp = gpar(
col = alpha(colour, alpha),
lty = linetype,
lwd = size * .pt
)
)
)
}
if (grepl("t", sides[s])) {
ticks$x_t <- with(
data,
segmentsGrob(
x0 = unit(xticks, "npc"),
x1 = unit(xticks, "npc"),
y0 = unit(1, "npc"),
y1 = unit(1, "npc") - ticklength,
gp = gpar(
col = alpha(colour, alpha),
lty = linetype,
lwd = size * .pt
)
)
)
}
}
if (grepl("[l|r]", sides[s])) {
# for ggplot2 < 3.3.0 use: yticks <- panel_params$y.minor
if (utils::packageVersion("ggplot2") >= "3.2.1.9000") {
y_minor_breaks <- panel_scales$y$break_positions_minor()
y_major_breaks <- panel_scales$y$break_positions()
} else {
y_minor_breaks <- panel_scales$y.minor
y_major_breaks <- panel_scales$y.major
}
yticks <- setdiff(y_minor_breaks, y_major_breaks)
# Make the grobs
if (grepl("l", sides[s])) {
ticks$y_l <- with(
data,
segmentsGrob(
y0 = unit(yticks, "npc"),
y1 = unit(yticks, "npc"),
x0 = unit(0, "npc"),
x1 = ticklength,
gp = gpar(
col = alpha(colour, alpha),
lty = linetype, lwd = size * .pt
)
)
)
}
if (grepl("r", sides[s])) {
ticks$y_r <- with(
data,
segmentsGrob(
y0 = unit(yticks, "npc"),
y1 = unit(yticks, "npc"),
x0 = unit(1, "npc"),
x1 = unit(1, "npc") - ticklength,
gp = gpar(
col = alpha(colour, alpha),
lty = linetype,
lwd = size * .pt
)
)
)
}
}
}
gTree(children = do.call("gList", ticks))
},
default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = 1)
)
图表 coord_cartesian(clip = "on")
线宽很粗的列看起来不错，但看不到刻度注释。
library(ggplot2)
library(grid)
ggplot(mpg, aes(x = class, y = displ, fill = class)) +
stat_summary(fun = mean, geom = "col", colour = "black", size = 1) +
theme_classic(base_size = 8) +
scale_y_continuous(limits = c(0, 8), expand = c(0, 0)) +
annotation_ticks(sides = "l", ticklength = -1 * unit(0.2, "cm")) +
coord_cartesian(clip = "on")
ggsave("clip_on.png", device = "png", width = 4, height = 3)
column plot with clip=on
图表 coord_cartesian(clip = "off")
刻度注释可见，但线条宽度非常粗的列显示在绘图区域之外。
ggplot(mpg, aes(x = class, y = displ, fill = class)) +
stat_summary(fun = mean, geom = "col", colour = "black", size = 1) +
theme_classic(base_size = 8) +
scale_y_continuous(limits = c(0, 8), expand = c(0, 0)) +
annotation_ticks(sides = "l", ticklength = -1 * unit(0.2, "cm")) +
coord_cartesian(clip = "off")
ggsave("clip_off.png", device = "png", width = 4, height = 3)
column plot with clip=off
我很早就觉得这段代码很熟悉，所以我想权衡一下。
是的，随着 ggplot v3.3.0 指南变得可扩展，但我怀疑它们会在很长一段时间内保持当前形式，因为通过小道消息我听说他们也想将指南切换到 ggproto 系统.
没有太多花哨的最便宜的方法来完成你的要求，就是调整指南的指南培训部分。由于这是一个 S3 方法，我们需要一个新指南 class 来编写自定义方法：
library(ggplot2)
library(rlang)
#> Warning: package 'rlang' was built under R version 3.6.3
library(glue)
guide_axis_minor <- function(
title = waiver(), check.overlap = FALSE, angle = NULL,
n.dodge = 1, order = 0, position = waiver()
) {
structure(list(title = title, check.overlap = check.overlap,
angle = angle, n.dodge = n.dodge, order = order, position = position,
available_aes = c("x", "y"), name = "axis"),
class = c("guide", "axis_minor", "axis"))
}
您会注意到上面的函数与 guide_axis() 相同，除了一个额外的 class。 classes 的顺序在这里很重要，因为我们正在对 axis class 进行子class，这样我们就可以偷懒，只使用已经存在的所有方法存在。
这给我们带来了训练，真正唯一需要调整的是。我已经在相关位发表了评论。大多数功能仍然与 guide_train.axis 内部功能相同。简而言之，我们将次要中断视为带有空标签的主要中断。
guide_train.axis_minor <- function(guide, scale, aesthetic = NULL) {
aesthetic <- aesthetic %||% scale$aesthetics[1]
# Seperately define major and minor breaks
major_breaks <- scale$get_breaks()
minor_breaks <- scale$get_breaks_minor()
# We set the actual breaks to be both major and minor
breaks <- union(major_breaks, minor_breaks)
# We keep track of what breaks were the major breaks
is_major <- breaks %in% major_breaks
empty_ticks <- ggplot2:::new_data_frame(
list(aesthetic = numeric(), .value = numeric(0), .label = character())
)
if (length(intersect(scale$aesthetics, guide$available_aes)) == 0) {
warn(glue("axis guide needs appropriate scales: ",
glue_collapse(guide$available_aes, ", ", last = " or ")))
guide$key <- empty_ticks
} else if (length(breaks) == 0) {
guide$key <- empty_ticks
} else {
mapped_breaks <- if (scale$is_discrete()) {
scale$map(breaks)
} else {
breaks
}
ticks <- ggplot2:::new_data_frame(setNames(list(mapped_breaks),
aesthetic))
ticks$.value <- breaks
ticks$.label <- scale$get_labels(breaks)
# Now this is the bit where we set minor breaks to have empty labls
ticks$.label[!is_major] <- ""
guide$key <- ticks[is.finite(ticks[[aesthetic]]), ]
}
guide$name <- paste0(guide$name, "_", aesthetic)
guide$hash <- digest::digest(list(guide$title, guide$key$.value,
guide$key$.label, guide$name))
guide
}
然后，因为我们对 axis class 进行了子class，所以为 class 编写的所有函数也将适用于我们的 axis_minor class，这样我们就完成了。现在您可以通过名称从任何连续位置标度调用指南：
ggplot(mpg, aes(x = class, y = displ, fill = class)) +
stat_summary(fun = mean, geom = "col") +
scale_y_continuous(limits = c(0, 8),
guide = "axis_minor")
由 reprex package (v0.3.0)
于 2020-04-07 创建
我正在寻找一种在不使用 coord_cartesian(clip = "off") 的情况下向 ggplots 添加小刻度线的方法。或者一种可重现的方法将裁剪应用到 x 轴而不是 y 轴，反之亦然。
到目前为止，我一直在使用 annotation_ticks() 函数和这个优秀答案 GeomTicks geom（进行一些小的修改以使其与 ggplot2 v3.3.0).不幸的是，要使刻度线注释出现在绘图的外部，必须使用 coord_cartesian(clip = "off")，这意味着位于绘图区域之外的任何其他内容也会暴露（请参见下面的 reprex）。
或者，也许有一种方法可以利用 ggplot2 v3.3.0 的任何新功能来绘制小刻度，而不是作为注释，而是作为 axis/plot 的实际部分，因此它是可以将它们绘制在绘图区域之外。
我不是软件开发人员，但也许可以使用 register_theme_elements 定义一个名为 axis.minor.ticks 的新主题元素，它的行为类似于 axis.ticks，但从panel_params$y$break_positions_minor 而不是 panel_params$y$break_positions。或者以某种方式使用新的 guide_x() S3 函数。
如有任何帮助，我们将不胜感激！
注解函数和ggproto对象
annotation_ticks() 函数（合并 this fix 用于分面问题）：
annotation_ticks <- function(sides = "b",
scale = "identity",
scaled = TRUE,
ticklength = unit(0.1, "cm"),
colour = "black",
size = 0.5,
linetype = 1,
alpha = 1,
color = NULL,
ticks_per_base = NULL,
data = data.frame(x = NA),
...) {
if (!is.null(color)) {
colour <- color
}
# check for invalid side
if (grepl("[^btlr]", sides)) {
stop(gsub("[btlr]", "", sides), " is not a valid side: b,t,l,r are valid")
}
# split sides to character vector
sides <- strsplit(sides, "")[[1]]
if (length(sides) != length(scale)) {
if (length(scale) == 1) {
scale <- rep(scale, length(sides))
} else {
stop("Number of scales does not match the number of sides")
}
}
base <- sapply(scale, function(x) switch(x, "identity" = 10, "log10" = 10, "log" = exp(1)), USE.NAMES = FALSE)
if (missing(ticks_per_base)) {
ticks_per_base <- base - 1
} else {
if ((length(sides) != length(ticks_per_base))) {
if (length(ticks_per_base) == 1) {
ticks_per_base <- rep(ticks_per_base, length(sides))
} else {
stop("Number of ticks_per_base does not match the number of sides")
}
}
}
delog <- scale %in% "identity"
layer(
data = data,
mapping = NULL,
stat = StatIdentity,
geom = GeomTicks,
position = PositionIdentity,
show.legend = FALSE,
inherit.aes = FALSE,
params = list(
base = base,
sides = sides,
scaled = scaled,
ticklength = ticklength,
colour = colour,
size = size,
linetype = linetype,
alpha = alpha,
ticks_per_base = ticks_per_base,
delog = delog,
...
)
)
}
ggproto 对象（现在可用于 ggplot2 v3.3.0）：
GeomTicks <- ggproto(
"GeomTicks", Geom,
extra_params = "",
handle_na = function(data, params) {
data
},
draw_panel = function(data,
panel_scales,
coord,
base = c(10, 10),
sides = c("b", "l"),
scaled = TRUE,
ticklength = unit(0.1, "cm"),
ticks_per_base = base - 1,
delog = c(x = TRUE, y = TRUE)) {
ticks <- list()
for (s in 1:length(sides)) {
if (grepl("[b|t]", sides[s])) {
# for ggplot2 < 3.3.0 use: xticks <- panel_params$x.minor
if (utils::packageVersion("ggplot2") >= "3.2.1.9000") {
x_minor_breaks <- panel_scales$x$break_positions_minor()
x_major_breaks <- panel_scales$x$break_positions()
} else {
x_minor_breaks <- panel_scales$x.minor
x_major_breaks <- panel_scales$x.major
}
xticks <- setdiff(x_minor_breaks, x_major_breaks)
# Make the grobs
if (grepl("b", sides[s])) {
ticks$x_b <- with(
data,
segmentsGrob(
x0 = unit(xticks, "npc"),
x1 = unit(xticks, "npc"),
y0 = unit(0, "npc"),
y1 = ticklength,
gp = gpar(
col = alpha(colour, alpha),
lty = linetype,
lwd = size * .pt
)
)
)
}
if (grepl("t", sides[s])) {
ticks$x_t <- with(
data,
segmentsGrob(
x0 = unit(xticks, "npc"),
x1 = unit(xticks, "npc"),
y0 = unit(1, "npc"),
y1 = unit(1, "npc") - ticklength,
gp = gpar(
col = alpha(colour, alpha),
lty = linetype,
lwd = size * .pt
)
)
)
}
}
if (grepl("[l|r]", sides[s])) {
# for ggplot2 < 3.3.0 use: yticks <- panel_params$y.minor
if (utils::packageVersion("ggplot2") >= "3.2.1.9000") {
y_minor_breaks <- panel_scales$y$break_positions_minor()
y_major_breaks <- panel_scales$y$break_positions()
} else {
y_minor_breaks <- panel_scales$y.minor
y_major_breaks <- panel_scales$y.major
}
yticks <- setdiff(y_minor_breaks, y_major_breaks)
# Make the grobs
if (grepl("l", sides[s])) {
ticks$y_l <- with(
data,
segmentsGrob(
y0 = unit(yticks, "npc"),
y1 = unit(yticks, "npc"),
x0 = unit(0, "npc"),
x1 = ticklength,
gp = gpar(
col = alpha(colour, alpha),
lty = linetype, lwd = size * .pt
)
)
)
}
if (grepl("r", sides[s])) {
ticks$y_r <- with(
data,
segmentsGrob(
y0 = unit(yticks, "npc"),
y1 = unit(yticks, "npc"),
x0 = unit(1, "npc"),
x1 = unit(1, "npc") - ticklength,
gp = gpar(
col = alpha(colour, alpha),
lty = linetype,
lwd = size * .pt
)
)
)
}
}
}
gTree(children = do.call("gList", ticks))
},
default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = 1)
)
图表 coord_cartesian(clip = "on")
线宽很粗的列看起来不错，但看不到刻度注释。
library(ggplot2)
library(grid)
ggplot(mpg, aes(x = class, y = displ, fill = class)) +
stat_summary(fun = mean, geom = "col", colour = "black", size = 1) +
theme_classic(base_size = 8) +
scale_y_continuous(limits = c(0, 8), expand = c(0, 0)) +
annotation_ticks(sides = "l", ticklength = -1 * unit(0.2, "cm")) +
coord_cartesian(clip = "on")
ggsave("clip_on.png", device = "png", width = 4, height = 3)
column plot with clip=on
图表 coord_cartesian(clip = "off")
刻度注释可见，但线条宽度非常粗的列显示在绘图区域之外。
ggplot(mpg, aes(x = class, y = displ, fill = class)) +
stat_summary(fun = mean, geom = "col", colour = "black", size = 1) +
theme_classic(base_size = 8) +
scale_y_continuous(limits = c(0, 8), expand = c(0, 0)) +
annotation_ticks(sides = "l", ticklength = -1 * unit(0.2, "cm")) +
coord_cartesian(clip = "off")
ggsave("clip_off.png", device = "png", width = 4, height = 3)
column plot with clip=off
我很早就觉得这段代码很熟悉，所以我想权衡一下。
是的，随着 ggplot v3.3.0 指南变得可扩展，但我怀疑它们会在很长一段时间内保持当前形式，因为通过小道消息我听说他们也想将指南切换到 ggproto 系统.
没有太多花哨的最便宜的方法来完成你的要求，就是调整指南的指南培训部分。由于这是一个 S3 方法，我们需要一个新指南 class 来编写自定义方法：
library(ggplot2)
library(rlang)
#> Warning: package 'rlang' was built under R version 3.6.3
library(glue)
guide_axis_minor <- function(
title = waiver(), check.overlap = FALSE, angle = NULL,
n.dodge = 1, order = 0, position = waiver()
) {
structure(list(title = title, check.overlap = check.overlap,
angle = angle, n.dodge = n.dodge, order = order, position = position,
available_aes = c("x", "y"), name = "axis"),
class = c("guide", "axis_minor", "axis"))
}
您会注意到上面的函数与 guide_axis() 相同，除了一个额外的 class。 classes 的顺序在这里很重要，因为我们正在对 axis class 进行子class，这样我们就可以偷懒，只使用已经存在的所有方法存在。
这给我们带来了训练，真正唯一需要调整的是。我已经在相关位发表了评论。大多数功能仍然与 guide_train.axis 内部功能相同。简而言之，我们将次要中断视为带有空标签的主要中断。
guide_train.axis_minor <- function(guide, scale, aesthetic = NULL) {
aesthetic <- aesthetic %||% scale$aesthetics[1]
# Seperately define major and minor breaks
major_breaks <- scale$get_breaks()
minor_breaks <- scale$get_breaks_minor()
# We set the actual breaks to be both major and minor
breaks <- union(major_breaks, minor_breaks)
# We keep track of what breaks were the major breaks
is_major <- breaks %in% major_breaks
empty_ticks <- ggplot2:::new_data_frame(
list(aesthetic = numeric(), .value = numeric(0), .label = character())
)
if (length(intersect(scale$aesthetics, guide$available_aes)) == 0) {
warn(glue("axis guide needs appropriate scales: ",
glue_collapse(guide$available_aes, ", ", last = " or ")))
guide$key <- empty_ticks
} else if (length(breaks) == 0) {
guide$key <- empty_ticks
} else {
mapped_breaks <- if (scale$is_discrete()) {
scale$map(breaks)
} else {
breaks
}
ticks <- ggplot2:::new_data_frame(setNames(list(mapped_breaks),
aesthetic))
ticks$.value <- breaks
ticks$.label <- scale$get_labels(breaks)
# Now this is the bit where we set minor breaks to have empty labls
ticks$.label[!is_major] <- ""
guide$key <- ticks[is.finite(ticks[[aesthetic]]), ]
}
guide$name <- paste0(guide$name, "_", aesthetic)
guide$hash <- digest::digest(list(guide$title, guide$key$.value,
guide$key$.label, guide$name))
guide
}
然后，因为我们对 axis class 进行了子class，所以为 class 编写的所有函数也将适用于我们的 axis_minor class，这样我们就完成了。现在您可以通过名称从任何连续位置标度调用指南：
ggplot(mpg, aes(x = class, y = displ, fill = class)) +
stat_summary(fun = mean, geom = "col") +
scale_y_continuous(limits = c(0, 8),
guide = "axis_minor")
由 reprex package (v0.3.0)
于 2020-04-07 创建