两列 facet_grid,顶部有条形标签
Two column facet_grid with strip labels on top
facet_grid
和 facet_wrap
各有其局限性。
facet_wrap
没有 space = "free"
参数,导致绘图的 y 轴不吸引人(参见 代码)
facet_grid
受到侧面标签的限制(请参阅 了解代码)。
已提供将 facet_grid
标签移动到顶部的解决方案(参见 )。
是否可以使用 解决方案制作一个 2 列图形,例如使用带有 facet_wrap
的 ncol = 2
参数来创建,或者该解决方案是否可以完成使用 facet_wrap
本身?解决方案应如下所示,y 轴间距类似于上面的 facet_grid
示例。
要求是;顶部的标签,y 轴适当的间距,两个 x 轴使用相同的比例。
这是您要查找的输出吗?
library(tidyverse)
library(gtable)
library(grid)
library(gridExtra)
#>
#> Attaching package: 'gridExtra'
#> The following object is masked from 'package:dplyr':
#>
#> combine
p1 <- mtcars %>%
rownames_to_column() %>%
filter(carb %in% c(1, 3, 6)) %>%
ggplot(aes(x = disp, y = rowname)) +
geom_point() +
xlim(c(0, 450)) +
facet_grid(carb ~ ., scales = "free_y", space = "free_y") +
theme(panel.spacing = unit(1, 'lines'),
strip.text.y = element_text(angle = 0))
gt1 <- ggplotGrob(p1)
panels <-c(subset(gt1$layout, grepl("panel", gt1$layout$name), se=t:r))
for(i in rev(panels$t-1)) {
gt1 = gtable_add_rows(gt1, unit(0.5, "lines"), i)
}
panels <-c(subset(gt1$layout, grepl("panel", gt1$layout$name), se=t:r))
strips <- c(subset(gt1$layout, grepl("strip-r", gt1$layout$name), se=t:r))
stripText = gtable_filter(gt1, "strip-r")
for(i in 1:length(strips$t)) {
gt1 = gtable_add_grob(gt1, stripText$grobs[[i]]$grobs[[1]], t=panels$t[i]-1, l=5)
}
gt1 = gt1[,-6]
for(i in panels$t) {
gt1$heights[i-1] = unit(0.8, "lines")
gt1$heights[i-2] = unit(0.2, "lines")
}
p2 <- mtcars %>%
rownames_to_column() %>%
filter(carb %in% c(2, 4, 8)) %>%
ggplot(aes(x = disp, y = rowname)) +
geom_point() +
xlim(c(0, 450)) +
facet_grid(carb ~ ., scales = "free_y", space = "free_y") +
theme(panel.spacing = unit(1, 'lines'),
strip.text.y = element_text(angle = 0))
gt2 <- ggplotGrob(p2)
#> Warning: Removed 2 rows containing missing values (geom_point).
panels <-c(subset(gt2$layout, grepl("panel", gt2$layout$name), se=t:r))
for(i in rev(panels$t-1)) {
gt2 = gtable_add_rows(gt2, unit(0.5, "lines"), i)
}
panels <-c(subset(gt2$layout, grepl("panel", gt2$layout$name), se=t:r))
strips <- c(subset(gt2$layout, grepl("strip-r", gt2$layout$name), se=t:r))
stripText = gtable_filter(gt2, "strip-r")
for(i in 1:length(strips$t)) {
gt2 = gtable_add_grob(gt2, stripText$grobs[[i]]$grobs[[1]], t=panels$t[i]-1, l=5)
}
gt2 = gt2[,-6]
for(i in panels$t) {
gt2$heights[i-1] = unit(0.8, "lines")
gt2$heights[i-2] = unit(0.2, "lines")
}
grid.arrange(gt1, gt2, ncol = 2)
由 reprex package (v2.0.1)
于 2021-12-16 创建
如果不是,需要做哪些改变?
facet_grid
和 facet_wrap
各有其局限性。
facet_wrap
没有 space = "free"
参数,导致绘图的 y 轴不吸引人(参见
facet_grid
受到侧面标签的限制(请参阅
已提供将 facet_grid
标签移动到顶部的解决方案(参见
是否可以使用 facet_wrap
的 ncol = 2
参数来创建,或者该解决方案是否可以完成使用 facet_wrap
本身?解决方案应如下所示,y 轴间距类似于上面的 facet_grid
示例。
要求是;顶部的标签,y 轴适当的间距,两个 x 轴使用相同的比例。
这是您要查找的输出吗?
library(tidyverse)
library(gtable)
library(grid)
library(gridExtra)
#>
#> Attaching package: 'gridExtra'
#> The following object is masked from 'package:dplyr':
#>
#> combine
p1 <- mtcars %>%
rownames_to_column() %>%
filter(carb %in% c(1, 3, 6)) %>%
ggplot(aes(x = disp, y = rowname)) +
geom_point() +
xlim(c(0, 450)) +
facet_grid(carb ~ ., scales = "free_y", space = "free_y") +
theme(panel.spacing = unit(1, 'lines'),
strip.text.y = element_text(angle = 0))
gt1 <- ggplotGrob(p1)
panels <-c(subset(gt1$layout, grepl("panel", gt1$layout$name), se=t:r))
for(i in rev(panels$t-1)) {
gt1 = gtable_add_rows(gt1, unit(0.5, "lines"), i)
}
panels <-c(subset(gt1$layout, grepl("panel", gt1$layout$name), se=t:r))
strips <- c(subset(gt1$layout, grepl("strip-r", gt1$layout$name), se=t:r))
stripText = gtable_filter(gt1, "strip-r")
for(i in 1:length(strips$t)) {
gt1 = gtable_add_grob(gt1, stripText$grobs[[i]]$grobs[[1]], t=panels$t[i]-1, l=5)
}
gt1 = gt1[,-6]
for(i in panels$t) {
gt1$heights[i-1] = unit(0.8, "lines")
gt1$heights[i-2] = unit(0.2, "lines")
}
p2 <- mtcars %>%
rownames_to_column() %>%
filter(carb %in% c(2, 4, 8)) %>%
ggplot(aes(x = disp, y = rowname)) +
geom_point() +
xlim(c(0, 450)) +
facet_grid(carb ~ ., scales = "free_y", space = "free_y") +
theme(panel.spacing = unit(1, 'lines'),
strip.text.y = element_text(angle = 0))
gt2 <- ggplotGrob(p2)
#> Warning: Removed 2 rows containing missing values (geom_point).
panels <-c(subset(gt2$layout, grepl("panel", gt2$layout$name), se=t:r))
for(i in rev(panels$t-1)) {
gt2 = gtable_add_rows(gt2, unit(0.5, "lines"), i)
}
panels <-c(subset(gt2$layout, grepl("panel", gt2$layout$name), se=t:r))
strips <- c(subset(gt2$layout, grepl("strip-r", gt2$layout$name), se=t:r))
stripText = gtable_filter(gt2, "strip-r")
for(i in 1:length(strips$t)) {
gt2 = gtable_add_grob(gt2, stripText$grobs[[i]]$grobs[[1]], t=panels$t[i]-1, l=5)
}
gt2 = gt2[,-6]
for(i in panels$t) {
gt2$heights[i-1] = unit(0.8, "lines")
gt2$heights[i-2] = unit(0.2, "lines")
}
grid.arrange(gt1, gt2, ncol = 2)
由 reprex package (v2.0.1)
于 2021-12-16 创建如果不是,需要做哪些改变?