如何延长刻面网格 ggplot 中的特定刻度线？
How to lengthen specific tick marks in facet gridded ggplot?
对于那些在分面网格中带有标签的标记，我想要更长的刻度线。所以我研究了 this attempt 并尝试使其适应像这样的小平面网格图：
定义中断和标签，次要和主要：
range.f <- range(unique(df1$weeks))
minor.f <- 1 # every 1 week, NOTE: range.f[2] should be divisible by minor.f!
major.f <- 5 # every 5 weeks
breaks.f <- seq(range.f[1], range.f[2], minor.f)
every_nth.lt <- function (x, nth) {x[1:nth != 1] <- ""; x}
# (lite version of
# works better for me than `insert_minor()`)
labels.f <- every_nth.lt(sequence(range.f[2]), major.f)
n_minor.f <- major.f / minor.f - 1
正常剧情：
library(ggplot2)
p.f <- ggplot(df1, aes(weeks, births)) +
geom_bar(stat="identity", fill="#F48024") + theme_bw() +
scale_x_continuous(breaks=breaks.f, labels=labels.f) +
coord_cartesian(xlim=range.f) +
facet_wrap(year ~ .) +
theme(panel.grid = element_blank(),
axis.text.x = element_text(margin=margin(t=5, unit="pt")))
操纵剧情：
g.f <- ggplotGrob(p.f)
xaxis.f <- g.f$grobs[grep("^axis-b", g.f$layout$name)] # get x-axes
ticks.f <- do.call(c, lapply(lapply(xaxis.f, "["),
function(x) x$children[[2]])) # get ticks
marks.f <- ticks.f$grobs[[1]] # get tick marks
# editing y-positions of tick marks
marks.f$y <- unit.c(unit.c(unit(1, "npc") - unit(6, "pt"),
unit(1, "npc"),
rep(unit.c(unit(1, "npc") - unit(3, "pt"),
unit(1, "npc")), n_minor.f)))
# putting tick marks back into plot
ticks.f$grobs[[1]] <- marks.f
for(i in seq_along(xaxis.f)) {
xaxis.f[[i]]$children[[2]]$grob <- ticks.f[[i]]
}
g.f$grobs[grep("^axis-b", g.f$layout$name)] <- xaxis.f
绘制剧情：
library(grid)
grid.newpage()
grid.draw(g.f)
产量：
我按照链接答案的所有步骤进行了操作，只是适应了grob中有列表的情况。但是，较长的刻度线不会出现。
有人看到我做错了吗？
或者，也许有另一种方法可以延长那些带有标签的轴刻度的轴刻度吗？
预期输出：
最后所有三个图的刻度线应如下所示：
数据：
tmp <- data.frame(date=as.Date(sample(1:1095, 10000, replace=TRUE),
origin="2014-01-01"),
births=sample(0:10, 10000, replace=TRUE))
tmp$year <- factor(substr(tmp$date, 1, 4))
df1 <- aggregate(births ~ date + year, tmp, sum)
rm(tmp) # remove tmp
df1$weeks <- as.integer(strftime(lubridate::floor_date(as.Date(df1$date,
format="%m/%d/%Y"),
unit="week"), "%W")) + 1
我相信您可以对此进行改进。我刚刚完成它，把东西正确地拉出来，然后放回去。主要是通过将它与一个图进行比较，然后让它循环遍历一个 grobs 列表。
范围和间隔可能需要更改，因为它们在这里都是一样的，但不同 x-axes 您可以适当地自定义间隔。
tmp <- data.frame(date=as.Date(sample(1:1095, 10000, replace=TRUE),
origin="2014-01-01"),
births=sample(0:10, 10000, replace=TRUE))
tmp$year <- factor(substr(tmp$date, 1, 4))
df1 <- aggregate(births ~ date + year, tmp, sum)
rm(tmp) # remove tmp
df1$weeks <- as.integer(strftime(lubridate::floor_date(as.Date(df1$date,
format="%m/%d/%Y"),
unit="week"), "%W")) + 1
# breaks and labels, minor and major
range.f <- 1:(max(unique(df1$weeks)))
minor.f <- 1 # every 1 week, NOTE: range.f[2] should be divisible by minor.f!
major.f <- 5 # every 5 weeks
breaks.f <- seq(min(range.f), max(range.f), minor.f)
every_nth.lt <- function (x, nth) {x[1:nth != 1] <- ""; x}
# (lite version of
labels.f <- every_nth.lt(range.f, major.f)
n_minor.f <- major.f / minor.f - 1
# plot
library(ggplot2)
library(grid)
p.f <- ggplot(df1, aes(weeks, births)) +
geom_bar(stat="identity", fill="#F48024") + theme_bw() +
scale_x_continuous(breaks=breaks.f, labels=labels.f) +
coord_cartesian(xlim=range.f) +
facet_wrap(year ~ .) +
theme(panel.grid = element_blank(),
axis.text.x = element_text(margin=margin(t=5, unit="pt")))
# manipulating plot
g.f <- ggplotGrob(p.f)
xaxis.f <- g.f$grobs[grep("^axis-b", g.f$layout$name)] # get x-axes
ticks.f <- c()
for(i in seq_along(xaxis.f)) {
ticks.f[[i]] <- xaxis.f[[i]]$children[[2]]
}
marks.f <- c()
for(i in seq_along(ticks.f)) {
marks.f[[i]] <- ticks.f[[i]][1]$grobs
}
# editing y-positions of tick marks
for(i in seq_along(marks.f)) {
marks.f[[i]][[1]]$y <- unit.c(unit.c(unit(1, "npc") - unit(6, "pt"),
unit(1, "npc"),
rep(unit.c(unit(1, "npc") - unit(3, "pt"),
unit(1, "npc")), n_minor.f)))
}
# putting tick marks back into plot
for(i in seq_along(ticks.f)) {
ticks.f[[i]]$grobs[[1]] <- marks.f[[i]][[1]]
}
for(i in seq_along(xaxis.f)) {
xaxis.f[[i]]$children[[2]] <- ticks.f[[i]]
}
g.f$grobs[grep("^axis-b", g.f$layout$name)] <- xaxis.f
# plot
grid.newpage()
grid.draw(g.f)
这是我开始时修改后的代码，少了几个 for 循环。
# Defining breaks and labels, minor and major:
range.f <- range(unique(df1$weeks))
minor.f <- 1 # every 1 week, NOTE: range.f[2] should be divisible by minor.f!
major.f <- 5 # every 5 weeks
breaks.f <- seq(range.f[1], range.f[2], minor.f)
every_nth.lt <- function (x, nth) {x[1:nth != 1] <- ""; x}
# (lite version of
# works better for me than `insert_minor()`)
labels.f <- every_nth.lt(sequence(range.f[2]), major.f)
n_minor.f <- major.f / minor.f - 1
# Normal plot:
library(ggplot2)
p.f <- ggplot(df1, aes(weeks, births)) +
geom_bar(stat="identity", fill="#F48024") + theme_bw() +
scale_x_continuous(breaks=breaks.f, labels=labels.f) +
coord_cartesian(xlim=range.f) +
facet_wrap(year ~ .) +
theme(panel.grid = element_blank(),
axis.text.x = element_text(margin=margin(t=5, unit="pt")))
# Manipulating plot:
g.f <- ggplotGrob(p.f)
xaxis.f <- g.f$grobs[grep("^axis-b", g.f$layout$name)] # get x-axes
ticks.f <- lapply(lapply(xaxis.f, "["),
function(x) x$children[[2]]) # get ticks
marks.f <- lapply(lapply(ticks.f, "["),
function(x) x[1]$grobs) # get ticks
# editing y-positions of tick marks
library(grid)
marks.f <- lapply(marks.f, function(x) {
x[[1]]$y <- unit.c(unit.c(unit(1, "npc") - unit(6, "pt"),
unit(1, "npc"),
rep(unit.c(unit(1, "npc") - unit(3, "pt"),
unit(1, "npc")), n_minor.f)))
x
})
# putting tick marks back into plot
for(i in seq_along(ticks.f)) {
ticks.f[[i]]$grobs[[1]] <- marks.f[[i]][[1]]
}
for(i in seq_along(xaxis.f)) {
xaxis.f[[i]]$children[[2]] <- ticks.f[[i]]
}
g.f$grobs[grep("^axis-b", g.f$layout$name)] <- xaxis.f
# Drawing the plot:
grid.newpage()
grid.draw(g.f)
数据
tmp <- data.frame(date=as.Date(sample(1:1095, 10000, replace=TRUE),
origin="2014-01-01"),
births=sample(0:10, 10000, replace=TRUE))
tmp$year <- factor(substr(tmp$date, 1, 4))
df1 <- aggregate(births ~ date + year, tmp, sum)
rm(tmp) # remove tmp
df1$weeks <- as.integer(strftime(lubridate::floor_date(as.Date(df1$date,
format="%m/%d/%Y"),
unit="week"), "%W")) + 1
对于那些在分面网格中带有标签的标记，我想要更长的刻度线。所以我研究了 this attempt 并尝试使其适应像这样的小平面网格图：
定义中断和标签，次要和主要：
range.f <- range(unique(df1$weeks))
minor.f <- 1 # every 1 week, NOTE: range.f[2] should be divisible by minor.f!
major.f <- 5 # every 5 weeks
breaks.f <- seq(range.f[1], range.f[2], minor.f)
every_nth.lt <- function (x, nth) {x[1:nth != 1] <- ""; x}
# (lite version of
# works better for me than `insert_minor()`)
labels.f <- every_nth.lt(sequence(range.f[2]), major.f)
n_minor.f <- major.f / minor.f - 1
正常剧情：
library(ggplot2)
p.f <- ggplot(df1, aes(weeks, births)) +
geom_bar(stat="identity", fill="#F48024") + theme_bw() +
scale_x_continuous(breaks=breaks.f, labels=labels.f) +
coord_cartesian(xlim=range.f) +
facet_wrap(year ~ .) +
theme(panel.grid = element_blank(),
axis.text.x = element_text(margin=margin(t=5, unit="pt")))
操纵剧情：
g.f <- ggplotGrob(p.f)
xaxis.f <- g.f$grobs[grep("^axis-b", g.f$layout$name)] # get x-axes
ticks.f <- do.call(c, lapply(lapply(xaxis.f, "["),
function(x) x$children[[2]])) # get ticks
marks.f <- ticks.f$grobs[[1]] # get tick marks
# editing y-positions of tick marks
marks.f$y <- unit.c(unit.c(unit(1, "npc") - unit(6, "pt"),
unit(1, "npc"),
rep(unit.c(unit(1, "npc") - unit(3, "pt"),
unit(1, "npc")), n_minor.f)))
# putting tick marks back into plot
ticks.f$grobs[[1]] <- marks.f
for(i in seq_along(xaxis.f)) {
xaxis.f[[i]]$children[[2]]$grob <- ticks.f[[i]]
}
g.f$grobs[grep("^axis-b", g.f$layout$name)] <- xaxis.f
绘制剧情：
library(grid)
grid.newpage()
grid.draw(g.f)
产量：
我按照链接答案的所有步骤进行了操作，只是适应了grob中有列表的情况。但是，较长的刻度线不会出现。
有人看到我做错了吗？
或者，也许有另一种方法可以延长那些带有标签的轴刻度的轴刻度吗？
预期输出：
最后所有三个图的刻度线应如下所示：
数据：
tmp <- data.frame(date=as.Date(sample(1:1095, 10000, replace=TRUE),
origin="2014-01-01"),
births=sample(0:10, 10000, replace=TRUE))
tmp$year <- factor(substr(tmp$date, 1, 4))
df1 <- aggregate(births ~ date + year, tmp, sum)
rm(tmp) # remove tmp
df1$weeks <- as.integer(strftime(lubridate::floor_date(as.Date(df1$date,
format="%m/%d/%Y"),
unit="week"), "%W")) + 1
我相信您可以对此进行改进。我刚刚完成它，把东西正确地拉出来，然后放回去。主要是通过将它与一个图进行比较，然后让它循环遍历一个 grobs 列表。
范围和间隔可能需要更改，因为它们在这里都是一样的，但不同 x-axes 您可以适当地自定义间隔。
tmp <- data.frame(date=as.Date(sample(1:1095, 10000, replace=TRUE),
origin="2014-01-01"),
births=sample(0:10, 10000, replace=TRUE))
tmp$year <- factor(substr(tmp$date, 1, 4))
df1 <- aggregate(births ~ date + year, tmp, sum)
rm(tmp) # remove tmp
df1$weeks <- as.integer(strftime(lubridate::floor_date(as.Date(df1$date,
format="%m/%d/%Y"),
unit="week"), "%W")) + 1
# breaks and labels, minor and major
range.f <- 1:(max(unique(df1$weeks)))
minor.f <- 1 # every 1 week, NOTE: range.f[2] should be divisible by minor.f!
major.f <- 5 # every 5 weeks
breaks.f <- seq(min(range.f), max(range.f), minor.f)
every_nth.lt <- function (x, nth) {x[1:nth != 1] <- ""; x}
# (lite version of
labels.f <- every_nth.lt(range.f, major.f)
n_minor.f <- major.f / minor.f - 1
# plot
library(ggplot2)
library(grid)
p.f <- ggplot(df1, aes(weeks, births)) +
geom_bar(stat="identity", fill="#F48024") + theme_bw() +
scale_x_continuous(breaks=breaks.f, labels=labels.f) +
coord_cartesian(xlim=range.f) +
facet_wrap(year ~ .) +
theme(panel.grid = element_blank(),
axis.text.x = element_text(margin=margin(t=5, unit="pt")))
# manipulating plot
g.f <- ggplotGrob(p.f)
xaxis.f <- g.f$grobs[grep("^axis-b", g.f$layout$name)] # get x-axes
ticks.f <- c()
for(i in seq_along(xaxis.f)) {
ticks.f[[i]] <- xaxis.f[[i]]$children[[2]]
}
marks.f <- c()
for(i in seq_along(ticks.f)) {
marks.f[[i]] <- ticks.f[[i]][1]$grobs
}
# editing y-positions of tick marks
for(i in seq_along(marks.f)) {
marks.f[[i]][[1]]$y <- unit.c(unit.c(unit(1, "npc") - unit(6, "pt"),
unit(1, "npc"),
rep(unit.c(unit(1, "npc") - unit(3, "pt"),
unit(1, "npc")), n_minor.f)))
}
# putting tick marks back into plot
for(i in seq_along(ticks.f)) {
ticks.f[[i]]$grobs[[1]] <- marks.f[[i]][[1]]
}
for(i in seq_along(xaxis.f)) {
xaxis.f[[i]]$children[[2]] <- ticks.f[[i]]
}
g.f$grobs[grep("^axis-b", g.f$layout$name)] <- xaxis.f
# plot
grid.newpage()
grid.draw(g.f)
这是我开始时修改后的代码，少了几个 for 循环。
# Defining breaks and labels, minor and major:
range.f <- range(unique(df1$weeks))
minor.f <- 1 # every 1 week, NOTE: range.f[2] should be divisible by minor.f!
major.f <- 5 # every 5 weeks
breaks.f <- seq(range.f[1], range.f[2], minor.f)
every_nth.lt <- function (x, nth) {x[1:nth != 1] <- ""; x}
# (lite version of
# works better for me than `insert_minor()`)
labels.f <- every_nth.lt(sequence(range.f[2]), major.f)
n_minor.f <- major.f / minor.f - 1
# Normal plot:
library(ggplot2)
p.f <- ggplot(df1, aes(weeks, births)) +
geom_bar(stat="identity", fill="#F48024") + theme_bw() +
scale_x_continuous(breaks=breaks.f, labels=labels.f) +
coord_cartesian(xlim=range.f) +
facet_wrap(year ~ .) +
theme(panel.grid = element_blank(),
axis.text.x = element_text(margin=margin(t=5, unit="pt")))
# Manipulating plot:
g.f <- ggplotGrob(p.f)
xaxis.f <- g.f$grobs[grep("^axis-b", g.f$layout$name)] # get x-axes
ticks.f <- lapply(lapply(xaxis.f, "["),
function(x) x$children[[2]]) # get ticks
marks.f <- lapply(lapply(ticks.f, "["),
function(x) x[1]$grobs) # get ticks
# editing y-positions of tick marks
library(grid)
marks.f <- lapply(marks.f, function(x) {
x[[1]]$y <- unit.c(unit.c(unit(1, "npc") - unit(6, "pt"),
unit(1, "npc"),
rep(unit.c(unit(1, "npc") - unit(3, "pt"),
unit(1, "npc")), n_minor.f)))
x
})
# putting tick marks back into plot
for(i in seq_along(ticks.f)) {
ticks.f[[i]]$grobs[[1]] <- marks.f[[i]][[1]]
}
for(i in seq_along(xaxis.f)) {
xaxis.f[[i]]$children[[2]] <- ticks.f[[i]]
}
g.f$grobs[grep("^axis-b", g.f$layout$name)] <- xaxis.f
# Drawing the plot:
grid.newpage()
grid.draw(g.f)
数据
tmp <- data.frame(date=as.Date(sample(1:1095, 10000, replace=TRUE),
origin="2014-01-01"),
births=sample(0:10, 10000, replace=TRUE))
tmp$year <- factor(substr(tmp$date, 1, 4))
df1 <- aggregate(births ~ date + year, tmp, sum)
rm(tmp) # remove tmp
df1$weeks <- as.integer(strftime(lubridate::floor_date(as.Date(df1$date,
format="%m/%d/%Y"),
unit="week"), "%W")) + 1