英文:
patchwork: how to have within-panel tags for a 3x3 combined plot?
问题
与这个问题类似 https://stackoverflow.com/questions/76524971/patchwork-align-tags-inside-panels-for-side-by-side-plots/76525099#76525099,我需要将标签移到面板边框内,但现在是一个3x3的网格。
library(devtools)
library(ggplot2)
library(patchwork)
d1 <- runif(500)
d2 <- rep(c("Treatment", "Control"), each = 250)
d3 <- rbeta(500, shape1 = 100, shape2 = 3)
d4 <- d3 + rnorm(500, mean = 0, sd = 0.1)
plotData <- data.frame(d1, d2, d3, d4)
str(plotData)
此代码用于确保每行显示一个合并的图例:
p1 <- ggplot(data = plotData) + geom_boxplot(aes(x = d2, y = d1, fill = d2)) + theme(legend.position = "none")
p2 <- ggplot(data = plotData) + geom_boxplot(aes(x = d2, y = d1, fill = d2)) + theme(legend.position = "none")
p3 <- ggplot(data = plotData) + geom_boxplot(aes(x = d2, y = d1, fill = d2)) + theme(legend.position = "right")
p4 <- ggplot(data = plotData) + geom_boxplot(aes(x = d2, y = d1, fill = d2)) + theme(legend.position = "none")
p5 <- ggplot(data = plotData) + geom_boxplot(aes(x = d2, y = d1, fill = d2)) + theme(legend.position = "none")
p6 <- ggplot(data = plotData) + geom_boxplot(aes(x = d2, y = d1, fill = d2)) + theme(legend.position = "right")
p7 <- ggplot(data = plotData) + geom_boxplot(aes(x = d2, y = d1, fill = d2)) + theme(legend.position = "none")
p8 <- ggplot(data = plotData) + geom_boxplot(aes(x = d2, y = d1, fill = d2)) + theme(legend.position = "none")
p9 <- ggplot(data = plotData) + geom_boxplot(aes(x = d2, y = d1, fill = d2)) + theme(legend.position = "right")
此代码生成一个带有标签的组合图,位于默认位置:
(((p1 + p2 + p3) /
(p4 + p5 + p6) /
(p7 + p8 + p9)) + guide_area()) & plot_annotation(tag_levels = "A")
添加 & plot_annotation(tag_levels = "A") + theme(legend.position = "right", plot.tag.position = c(.15, .95))
将移除标签。
感谢您的访问。
英文:
Similar to this problem <https://stackoverflow.com/questions/76524971/patchwork-align-tags-inside-panels-for-side-by-side-plots/76525099#76525099>, I need to move tags inside panel borders, but now for a 3x3 grid.
library(devtools)
library(ggplot2)
library(patchwork)
d1 <- runif(500)
d2 <- rep(c("Treatment","Control"),each=250)
d3 <- rbeta(500,shape1=100,shape2=3)
d4 <- d3 + rnorm(500,mean=0,sd=0.1)
plotData <- data.frame(d1,d2,d3,d4)
str(plotData)
This code is to make sure one combined legend is shown per row:
p1 <- ggplot(data=plotData) + geom_boxplot(aes(x=d2,y=d1,fill=d2)) + theme(legend.position = "none")
p2 <- ggplot(data=plotData) + geom_boxplot(aes(x=d2,y=d1,fill=d2)) + theme(legend.position = "none")
p3 <- ggplot(data=plotData) + geom_boxplot(aes(x=d2,y=d1,fill=d2)) + theme(legend.position = "right")
p4 <- ggplot(data=plotData) + geom_boxplot(aes(x=d2,y=d1,fill=d2)) + theme(legend.position = "none")
p5 <- ggplot(data=plotData) + geom_boxplot(aes(x=d2,y=d1,fill=d2)) + theme(legend.position = "none")
p6 <- ggplot(data=plotData) + geom_boxplot(aes(x=d2,y=d1,fill=d2)) + theme(legend.position = "right")
p7 <- ggplot(data=plotData) + geom_boxplot(aes(x=d2,y=d1,fill=d2)) + theme(legend.position = "none")
p8 <- ggplot(data=plotData) + geom_boxplot(aes(x=d2,y=d1,fill=d2)) + theme(legend.position = "none")
p9 <- ggplot(data=plotData) + geom_boxplot(aes(x=d2,y=d1,fill=d2)) + theme(legend.position = "right")
This code produced a combined plot with tags, at default locations
(((p1 + p2 + p3) /
(p4 + p5 + p6) /
(p7 + p8 + p9)) + guide_area()) & plot_annotation(tag_levels = "A")
Adding & plot_annotation(tag_levels = "A") + theme(legend.position = "right", plot.tag.position = c(.15, .95))
removed the tags.
Thanks for stopping by.
答案1
得分: 1
也许有一种更直接的方法来实现您期望的结果,但一个选项是使用 annotate
或 annotation_custom
来伪造您的内部标记,就像我在下面所做的那样,这意味着手动将 "标记" 添加为每个图的注释:
library(ggplot2)
library(patchwork)
plot_list <- lapply(1:9, \(x) {
legend_position <- if (x %% 3 == 0) {
"right"
} else {
"none"
}
ggplot(data = plotData) +
geom_boxplot(aes(x = d2, y = d1, fill = d2)) +
theme(legend.position = legend_position)
})
add_tag <- function(label, x = 1, y = 1, padding.x = unit(5, "pt"), padding.y = padding.x, hjust = 1, vjust = 1, size = 13) {
annotation_custom(
grid::textGrob(
x = unit(x, "npc") - padding.x,
y = unit(y, "npc") - padding.y,
hjust = hjust, vjust = vjust,
label = label, gp = grid::gpar(fontsize = size)
)
)
}
# 默认位置:右上角
lapply(
seq_along(plot_list), \(x) plot_list[[x]] + add_tag(LETTERS[x])
) |>
wrap_plots(ncol = 3)
<!-- -->
# 标记在 "左上角"
lapply(
seq_along(plot_list), \(x) plot_list[[x]] + add_tag(
LETTERS[x],
x = 0, y = 1,
hjust = 0, vjust = 1,
padding.x = -unit(5, "pt"), padding.y = unit(5, "pt")
)
) |>
wrap_plots(ncol = 3)
<!-- -->
英文:
Perhaps there is a more straightforward approach to achieve your desired result but one option would be to fake your inner tags using annotate
or annotation_custom
as I do below which means to manually add the "tags" as annotations to each plot:
library(ggplot2)
library(patchwork)
plot_list <- lapply(1:9, \(x) {
legend_position <- if (x %% 3 == 0) {
"right"
} else {
"none"
}
ggplot(data = plotData) +
geom_boxplot(aes(x = d2, y = d1, fill = d2)) +
theme(legend.position = legend_position)
})
add_tag <- function(label, x = 1, y = 1, padding.x = unit(5, "pt"), padding.y = padding.x, hjust = 1, vjust = 1, size = 13) {
annotation_custom(
grid::textGrob(
x = unit(x, "npc") - padding.x,
y = unit(y, "npc") - padding.y,
hjust = hjust, vjust = vjust,
label = label, gp = grid::gpar(fontsize = size)
)
)
}
# Default: topright corner
lapply(
seq_along(plot_list), \(x) plot_list[[x]] + add_tag(LETTERS[x])
) |>
wrap_plots(ncol = 3)
<!-- -->
# Tags in "topleft" corner
lapply(
seq_along(plot_list), \(x) plot_list[[x]] + add_tag(
LETTERS[x],
x = 0, y = 1,
hjust = 0, vjust = 1,
padding.x = -unit(5, "pt"), padding.y = unit(5, "pt")
)
) |>
wrap_plots(ncol = 3)
<!-- -->
答案2
得分: 1
感谢Stefan提供的提示。这段代码处理不同的子图。
# 列出子图
plot_list <- list(p1, p2, p3, p4, p5, p6, p7, p8, p9)
# 定义一个添加标签到图表的函数
add_tag <- function(label, x = 1, y = 1, padding.x = unit(5, "pt"), padding.y = padding.x, hjust = 1, vjust = 1, size = 13) {
annotation_custom(
grid::textGrob(
x = unit(x, "npc") - padding.x,
y = unit(y, "npc") - padding.y,
hjust = hjust, vjust = vjust,
label = label, gp = grid::gpar(fontsize = size)
)
)
}
# 向每个图表添加标签
plot_list <- lapply(
seq_along(plot_list),
\(x) plot_list[[x]] + add_tag(LETTERS[x], x = .15, y = .96)
)
# 将图表组合成一个网格
wrap_plots(plot_list, ncol = 3)
英文:
Many thanks to Stefan for the hints. This code handles unidentical subplots.
# List the subplots
plot_list <- list(p1, p2, p3,p4, p5, p6, p7, p8, p9)
# Define a function to add a tag to a plot
add_tag <- function(label, x = 1, y = 1, padding.x = unit(5, "pt"), padding.y = padding.x, hjust = 1, vjust = 1, size = 13) {
annotation_custom(
grid::textGrob(
x = unit(x, "npc") - padding.x,
y = unit(y, "npc") - padding.y,
hjust = hjust, vjust = vjust,
label = label, gp = grid::gpar(fontsize = size)
)
)
}
# Add a tag to each plot
plot_list <- lapply(
seq_along(plot_list),
\(x) plot_list[[x]] + add_tag(LETTERS[x], x = .15, y = .96)
)
# Combine the plots into a grid
wrap_plots(plot_list, ncol = 3)
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。
评论