问题
I try to find an elegant way to insert minor ticks on plots created with ggplot2. I found a function which does almost exactly what I want: https://rdrr.io/github/hrbrmstr/ggalt/src/R/annotation_ticks.r
There is only one drawback: the ticks, like in annotation_logticks, are drawn inside the plot region. I need them to be on the outside.
A solution could be to use negative values for the tick-length. When I do so, the ticks disappear. I assume, that this is due to the default clipping action of ggplot2, which supresses plotting outside the plot region (?) (see also log ticks on the outer side of axes (annotation_logticks), where the clipping is turned off which - unfortunately - leads to ticks exceeding the plot-range).
So: is there an option to modify the annotation_ticks - function in order to produce ticks outside of the plot region, only covering the range of the plot? Ideally, this functionality should by incorporated in the annotate_ticks - function (I don't want to save and then re-arrange the plot; I'd rather build my final plot in one step).
回答1:
I've found a sort of satisfactory solution to adapting the annotation_ticks function. If we'd simply copy-paste the code from the link you've posted, we can make the following small adjustment near the end in the GeomTicks ggproto object:
GeomTicks <- ggproto(
"GeomTicks", Geom,
# ...
# all the rest of the code
# ...
gTree(children = do.call("gList", ticks), cl = "ticktrimmer") # Change this line
},
default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = 1)
)
Then we can write a small function that simply clips the ticks that are outside the range that gets triggered just before drawing by hijacking the S3 generic makeContent in the grid package:
library(grid)
makeContent.ticktrimmer <- function(x) {
# Loop over segment grobs
x$children <- lapply(x$children, function(m) {
# convert positions to values
x0 <- convertX(m$x0, "npc", valueOnly = T)
x1 <- convertX(m$x1, "npc", valueOnly = T)
y0 <- convertY(m$y0, "npc", valueOnly = T)
y1 <- convertY(m$y1, "npc", valueOnly = T)
# check if values are outside 0-1
if (length(unique(x0)) == 1) {
keep <- y0 >= 0 & y0 <= 1 & y1 >= 0 & y1 <= 1
} else if (length(unique(y0)) == 1) {
keep <- x0 >= 0 & x0 <= 1 & x1 >= 0 & x1 <= 1
} else {
keep <- TRUE
}
# Trim the segments
m$x0 <- m$x0[keep]
m$y0 <- m$y0[keep]
m$x1 <- m$x1[keep]
m$y1 <- m$y1[keep]
m
})
x
}
And now we can plot:
g <- ggplot(iris, aes(Sepal.Width, Sepal.Length)) +
geom_point(aes(colour = Species)) +
annotation_ticks(long = -1 * unit(0.3, "cm"),
mid = -1 * unit(0.2, "cm"),
short = -1 * unit(0.1, "cm")) +
coord_cartesian(clip = "off")
Besides the first tick on the left being slightly weirdly placed, this seems to work reasonably.
EDIT: Here is a quick refactoring of the code to work with the native minor breaks instead of calculating minor breaks de novo. The user function:
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,
...) {
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.frame(x = NA),
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,
...
)
)
}
The ggproto object:
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])) {
xticks <- panel_scales$x.minor
# 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])) {
yticks <- panel_scales$y.minor
# 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)
)
Plotting:
ggplot(iris, aes(Sepal.Width, Sepal.Length)) +
geom_point(aes(colour = Species)) +
annotation_ticks(ticklength = -1 * unit(0.1, "cm"),
side = "b") +
coord_cartesian(clip = "off")
回答2:
This is indeed a very elegant solution, however, if you are working with facets the annotation minor ticks will be repeated in every plot. I've changed the original tick sizes to make it more evident, see the example below:
ggplot(iris, aes(Sepal.Width, Sepal.Length)) +
geom_point(aes(colour = Species)) +
facet_wrap (~Species, dir='v') +
annotation_ticks(ticklength = -1 * unit(0.1, "cm"),
side = "b") +
coord_cartesian(clip = "off") +
theme (axis.ticks.length.x=unit(.5, "cm"))
Is there a way to prevent it from happening?
来源：https://stackoverflow.com/questions/58485334/ggplot2-annotation-ticks-on-the-outside-of-the-plot-region