[英]Adding minor tick marks to the x axis in ggplot2 (with no labels)
下面是一个情节的示例代码,它几乎完全符合我的要求。 根据下面定义的 minor_breaks,我唯一想添加的是 x 轴上的刻度线(与主要刻度相同的大小)。
df <- data.frame(x = c(1900,1950,2000), y = c(50,75,60))
p <- ggplot(df, aes(x=x, y=y))
p + geom_line() +
scale_x_continuous(minor_breaks = seq(1900,2000,by=10), breaks = seq(1900,2000,by=50), limits = c(1900,2000), expand = c(0,0)) +
scale_y_continuous(breaks = c(20,40,60,80), limits = c(0,100)) +
theme(legend.position="none", panel.background = element_blank(),
axis.line = element_line(color='black'), panel.grid.minor = element_blank())
提前致谢,--JT
这将在精确的情况下做到这一点:
scale_x_continuous(breaks= seq(1900,2000,by=10),
labels = c(1900, rep("",4), 1950, rep("",4), 2000),
limits = c(1900,2000), expand = c(0,0)) +
这是一个不是防弹的函数,但可以在开始和结束主要标签与at
参数的开始和停止值对齐时插入空白标签:
insert_minor <- function(major_labs, n_minor) {labs <-
c( sapply( major_labs, function(x) c(x, rep("", 4) ) ) )
labs[1:(length(labs)-n_minor)]}
测试:
p <- ggplot(df, aes(x=x, y=y))
p + geom_line() +
scale_x_continuous(breaks= seq(1900,2000,by=10),
labels = insert_minor( seq(1900, 2000, by=50), 4 ),
limits = c(1900,2000), expand = c(0,0)) +
scale_y_continuous(breaks = c(20,40,60,80), limits = c(0,100)) +
theme(legend.position="none", panel.background = element_blank(),
axis.line = element_line(color='black'), panel.grid.minor = element_blank())
尽管上面的响应能够添加中断,但这些实际上不是 minor_breaks,为此您可以使用annotation_ticks
函数,其工作方式类似于annotation_logticks
。
annotation_ticks <- function(sides = "b",
scale = "identity",
scaled = TRUE,
short = unit(0.1, "cm"),
mid = unit(0.2, "cm"),
long = unit(0.3, "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,
short = short,
mid = mid,
long = long,
colour = colour,
size = size,
linetype = linetype,
alpha = alpha,
ticks_per_base = ticks_per_base,
delog = delog,
...
)
)
}
#' Base ggproto classes for ggplot2
#'
#' If you are creating a new geom, stat, position, or scale in another package,
#' you'll need to extend from ggplot2::Geom, ggplot2::Stat, ggplot2::Position, or ggplot2::Scale.
#'
#' @seealso \code{\link[ggplot2]{ggplot2-ggproto}}
#' @usage NULL
#' @format NULL
#' @rdname ggplot2-ggproto
#' @export
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,
short = unit(0.1, "cm"),
mid = unit(0.2, "cm"),
long = unit(0.3, "cm"),
ticks_per_base = base - 1,
delog = c(x = TRUE, y = TRUE)) {
ticks <- list()
# Convert these units to numbers so that they can be put in data frames
short <- convertUnit(short, "cm", valueOnly = TRUE)
mid <- convertUnit(mid, "cm", valueOnly = TRUE)
long <- convertUnit(long, "cm", valueOnly = TRUE)
for (s in 1:length(sides)) {
if (grepl("[b|t]", sides[s])) {
# Get positions of x tick marks
xticks <- calc_ticks(
base = base[s],
minpow = floor(panel_scales$x.range[1]),
maxpow = ceiling(panel_scales$x.range[2]),
majorTicks = panel_scales$x.major_source,
start = 0,
shortend = short,
midend = mid,
longend = long,
ticks_per_base = ticks_per_base[s],
delog = delog[s]
)
if (scaled) {
if (!delog[s]) {
xticks$value <- log(xticks$value, base[s])
}
}
names(xticks)[names(xticks) == "value"] <- "x" # Rename to 'x' for coordinates$transform
xticks <- coord$transform(xticks, panel_scales)
# Make the grobs
if (grepl("b", sides[s])) {
ticks$x_b <- with(
data,
segmentsGrob(
x0 = unit(xticks$x, "native"),
x1 = unit(xticks$x, "native"),
y0 = unit(xticks$start, "cm"),
y1 = unit(xticks$end, "cm"),
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$x, "native"),
x1 = unit(xticks$x, "native"),
y0 = unit(1, "npc") - unit(xticks$start, "cm"),
y1 = unit(1, "npc") - unit(xticks$end, "cm"),
gp = gpar(
col = alpha(colour, alpha),
lty = linetype,
lwd = size * .pt
)
)
)
}
}
if (grepl("[l|r]", sides[s])) {
yticks <- calc_ticks(
base = base[s],
minpow = floor(panel_scales$y.range[1]),
maxpow = ceiling(panel_scales$y.range[2]),
majorTicks = panel_scales$y.major_source,
start = 0,
shortend = short,
midend = mid,
longend = long,
ticks_per_base = ticks_per_base[s],
delog = delog[s]
)
if (scaled) {
if (!delog[s]) {
yticks$value <- log(yticks$value, base[s])
}
}
names(yticks)[names(yticks) == "value"] <- "y" # Rename to 'y' for coordinates$transform
yticks <- coord$transform(yticks, panel_scales)
# Make the grobs
if (grepl("l", sides[s])) {
ticks$y_l <- with(
data,
segmentsGrob(
y0 = unit(yticks$y, "native"),
y1 = unit(yticks$y, "native"),
x0 = unit(yticks$start, "cm"),
x1 = unit(yticks$end, "cm"),
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$y, "native"),
y1 = unit(yticks$y, "native"),
x0 = unit(1, "npc") - unit(yticks$start, "cm"),
x1 = unit(1, "npc") - unit(yticks$end, "cm"),
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)
)
# Calculate the position of log tick marks Returns data frame with: - value: the
# position of the log tick on the data axis, for example 1, 2, ..., 9, 10, 20, ...
# - start: on the other axis, start position of the line (usually 0) - end: on the
# other axis, end position of the line (for example, .1, .2, or .3)
calc_ticks <- function(base = 10,
ticks_per_base = base - 1,
minpow = 0,
maxpow = minpow + 1,
majorTicks = 0,
start = 0,
shortend = 0.1,
midend = 0.2,
longend = 0.3,
delog = FALSE) {
# Number of blocks of tick marks
reps <- maxpow - minpow
# For base 10: 1, 2, 3, ..., 7, 8, 9, 1, 2, ...
ticknums <- rep(seq(1, base - 1, length.out = ticks_per_base), reps)
# For base 10: 1, 1, 1, ..., 1, 1, 1, 2, 2, ... (for example)
powers <- rep(seq(minpow, maxpow - 1), each = ticks_per_base)
ticks <- ticknums * base ^ powers
ticks <- c(ticks, base ^ maxpow) # Add the last tick mark
# Set all of the ticks short
tickend <- rep(shortend, length(ticks))
# Get the position within each cycle, 0, 1, 2, ..., 8, 0, 1, 2. ...
cycleIdx <- ticknums - 1
# Set the 'major' ticks long
tickend[cycleIdx == 0] <- longend
# Where to place the longer tick marks that are between each base For base 10, this
# will be at each 5
longtick_after_base <- floor(ticks_per_base / 2)
tickend[cycleIdx == longtick_after_base] <- midend
if (delog) {
ticksCopy <- ticks
regScale <- log(ticks, base)
majorTicks <- sort(
unique(
c(
minpow,
regScale[which(regScale %in% majorTicks)],
maxpow,
majorTicks
)
)
)
expandScale <- c()
if (length(majorTicks) > 1) {
for (i in 1:(length(majorTicks) - 1)) {
expandScale <- c(
expandScale,
seq(majorTicks[i], majorTicks[i + 1], length.out = (ticks_per_base + 1))
)
}
ticks <- unique(expandScale)
# Set all of the ticks short
tickend <- rep(shortend, length(ticks))
# Set the 'major' ticks long
tickend[which(ticks %in% majorTicks)] <- longend
}
}
tickdf <- data.frame(value = ticks, start = start, end = tickend)
tickdf
}
上面的功能非常好。
我发现一个更简单或更容易理解的解决方案是简单地以您想要的主要和次要中断的增量指定主轴中断 - 因此,如果您希望主要以 10 为增量,次要以 5 为增量,不过,您应该以 5 步为单位指定主要增量。
然后,在主题中,您需要为轴文本指定颜色。 您可以给它一个颜色列表,而不是选择一种颜色 - 指定您想要长轴编号的任何颜色,然后为短轴颜色指定 NA。 这将为您提供主要标记上的文本,但在“次要”标记上没有任何内容。 同样,对于进入绘图内部的网格,您可以指定线条大小的列表,以便绘图中的主要和次要网格线的粗细仍然存在差异,即使您将次要网格线指定为主要网格线。 作为您可以放入主题的示例:
panel.grid.major.x = element_line(colour = c("white"), size = c(0.33, 0.2)),
panel.grid.major.y = element_line(colour = c("white"), size = c(0.33, 0.2)),
axis.text.y = element_text(colour = c("black", NA), family = "Gill Sans"),
axis.text.x = element_text(colour = c("black", NA), family = "Gill Sans"),
我怀疑您可以以完全相同的方式更改外部刻度线的大小,尽管我还没有尝试过。
现在可以使用很棒的ggh4x
包来完成。
library(ggh4x)
#> Loading required package: ggplot2
df <- data.frame(x = c(1900, 1950, 2000), y = c(50, 75, 60))
ggplot(df, aes(x, y)) +
geom_line() +
scale_x_continuous(
minor_breaks = seq(1900, 2000, by = 10),
breaks = seq(1900, 2000, by = 50), limits = c(1900, 2000),
guide = "axis_minor" # this is added to the original code
) +
theme(ggh4x.axis.ticks.length.minor = rel(1)) # add this to get the same length
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.