动态调整 ggplot2 图例的大小以适应 Quarto 中的文档类型
Gar*_*yDe 7 plot r legend ggplot2 quarto
我正在使用 R 生成包含图形和表格的四开本文档。应渲染此文档以创建 HTML 和 PDF 文件。大部分都工作得很好。然而，我有很多图例的人物，并且在生成情节时，一些图例被切到了侧面。
我找到了调整图例大小的解决方案，以便所有图例都适合使用以下命令：
theme(legend.text = element_text(size = 6),
legend.title = element_text(size = 11))
这在 HTML 文档中给出了一个很好的图：
但是，当我尝试渲染 PDF 文档时，该图如下所示：
当然，我可以找到图形高度的解决方案，但我没有在我创建的可重现示例中包含该代码。不过，可以看出，传说还是被删减了。
这是四开文档的可复制示例：
---
title: "Reproducible Example"
format:
html:
toc: true
pdf:
toc: true
---
This is a reproducible example to present my problem.
```{r}
library(tidyverse)
library(cowplot)
library(ggnewscale)
library(ggtext)
```
## Create data
```{r}
species_df <- tibble(fish_species = factor(x = c("Rainbow trout<br />(<i>Oncorhynchus mykiss</i>)", "Brown trout<br />(<i>Salmo trutta fario</i>)", "Whitefish<br />(<i>Coregonus sp.</i>)", "Grayling<br />(<i>Thymallus sp.</i>)", "Other salmonid<br />(other <i>Salmonidae</i>)", "Common perch<br />(<i>Perca fluviatilis</i>)", "Pikeperch<br />(<i>Sander lucioperca</i>)", "Other percid<br />(other <i>Percidae</i>)", "Koi<br />(<i>Cyprinus carpio</i>)", "Other carp<br />(other <i>Cyprinidae</i>)", "Freshwater ornamental fish<br />(diverse species)", "Saltwater ornamental fish<br />(diverse species)", "Crayfish<br />(<i>Crustacea</i>)", "Missing data"),
levels = c("Rainbow trout<br />(<i>Oncorhynchus mykiss</i>)", "Brown trout<br />(<i>Salmo trutta fario</i>)", "Whitefish<br />(<i>Coregonus sp.</i>)", "Grayling<br />(<i>Thymallus sp.</i>)", "Other salmonid<br />(other <i>Salmonidae</i>)", "Common perch<br />(<i>Perca fluviatilis</i>)", "Pikeperch<br />(<i>Sander lucioperca</i>)", "Other percid<br />(other <i>Percidae</i>)", "Koi<br />(<i>Cyprinus carpio</i>)", "Other carp<br />(other <i>Cyprinidae</i>)", "Freshwater ornamental fish<br />(diverse species)", "Saltwater ornamental fish<br />(diverse species)", "Crayfish<br />(<i>Crustacea</i>)", "Missing data"))) |>
mutate(family = factor(x = case_when(fish_species %in% c("Rainbow trout<br />(<i>Oncorhynchus mykiss</i>)", "Brown trout<br />(<i>Salmo trutta fario</i>)", "Whitefish<br />(<i>Coregonus sp.</i>)", "Grayling<br />(<i>Thymallus sp.</i>)", "Other salmonid<br />(other <i>Salmonidae</i>)") ~ "Salmonid<br />(<i>Salmonidae</i>)",
fish_species %in% c("Common perch<br />(<i>Perca fluviatilis</i>)", "Pikeperch<br />(<i>Sander lucioperca</i>)", "Other percid<br />(other <i>Percidae</i>)") ~ "Percid<br />(<i>Percidae</i>)",
fish_species %in% c("Koi<br />(<i>Cyprinus carpio</i>)", "Other carp<br />(other <i>Cyprinidae</i>)") ~ "Cyprinid<br />(<i>Cyprinidae</i>)",
fish_species %in% c("Freshwater ornamental fish<br />(diverse species)", "Saltwater ornamental fish<br />(diverse species)") ~ "Ornamental fish",
fish_species %in% c("Crayfish<br />(<i>Crustacea</i>)") ~ "Crayfish<br />(<i>Crustacea</i>)",
TRUE ~ "Other"),
levels = c("Salmonid<br />(<i>Salmonidae</i>)", "Percid<br />(<i>Percidae</i>)", "Cyprinid<br />(<i>Cyprinidae</i>)", "Ornamental fish", "Crayfish<br />(<i>Crustacea</i>)", "Other")),
family_sober = factor(x = word(string = family,
sep = "<br />"),
levels = word(string = levels(family),
sep = "<br />")))
quartal <- paste("Quartal", 1:4)
year <- 2020:2022
quartal_df <- crossing(quartal, year) |>
mutate(quartal_year = factor(x = paste(year, quartal, sep = " - "),
levels = sort(paste(year, quartal, sep = " - ")))) |>
arrange(quartal_year) |>
mutate(quartal_num = seq_len(n())) |>
slice_tail(n = 9)
df <- species_df |>
crossing(quartal_df) |>
mutate(number = sample(x = 1:20, size = n(), replace = TRUE))
```
## Create plot
```{r}
# Prepare x axis breaks for ticks
quartal_breaks <- df |>
distinct(quartal_year, year) |>
group_by(year) |>
summarise(n_quartals = n()) |>
mutate(breaks = NA)
for (i in seq_len(nrow(quartal_breaks))) {
quartal_breaks$breaks[i] <- 1 + sum(quartal_breaks$n_quartals[seq_len(i - 1)])
}
#Prepare colours
n_groups <- df |> distinct(family) |> nrow()
colour_group <- RColorBrewer::brewer.pal(name = "Dark2", n = n_groups)
colours <- c()
j <- 0
for (i in seq_len(n_groups)) {
j <- j + 1
n_in_group <- df |> filter(family == levels(df$family)[i]) |> distinct(fish_species) |> nrow()
group_palette <- colorRampPalette(colors = c(colour_group[j], "#FFFFFF"))
group_colours <- group_palette(n_in_group + 1) |> head(-1)
colours <- append(colours, group_colours)
}
colours <- setNames(colours, df |> distinct(fish_species) |> pull(fish_species) |> sort())
#Create plot
fig <- ggplot(data = df) +
geom_line(aes(x = quartal_num, y = number, colour = fish_species))
j <- 0
for (i in df |> distinct(family) |> arrange(family) |> pull()) {
j <- j + 1
fig <- fig +
geom_line(aes(x = quartal_num, y = number, colour = fish_species)) +
scale_colour_manual(aesthetics = "colour",
values = colours,
labels = df |> filter(family == i) |> distinct(fish_species) |> pull(fish_species),
breaks = df |> filter(family == i) |> distinct(fish_species) |> pull(fish_species),
name = i,
guide = guide_legend(title.position = "top", direction = "vertical", order = j)) +
new_scale_colour()
}
fig <- fig +
facet_wrap(vars(family_sober)) +
scale_x_continuous(breaks = quartal_breaks$breaks,
labels = quartal_breaks$year,
minor_breaks = c(1:9)) +
xlab("Time") +
ylab("Number") +
guides(color = guide_legend(override.aes = list(size = 0.8))) +
theme(legend.position = "bottom",
legend.text = element_markdown(size = 6),
legend.key.height = unit(1.8, units = "char"),
legend.margin = margin(t = 0, r = 0, b = 0, l = 0, unit='cm'),
legend.spacing = unit(0.5, units = "char"),
legend.title = element_markdown(size = 11),
axis.text.x=element_text(angle=45, hjust=1, size = 7))
#Prepare plot to print
# fig_legend <- get_legend(fig)
#
# fig_nolegend <- fig +
# theme(legend.position = "none")
#
# fig_print <- plot_grid(fig_nolegend,
# fig_legend,
# ncol = 1,
# rel_heights = c(3, 1))
print(fig)
# print(fig_print)
```
我尝试使用cowplot中的get_legend来提取图例，然后组合1）没有图例的图（theme(legend.position = "none")）和2）单独的图例（cowplot::get_legend()）（参见可重现示例末尾的代码），但问题是在图例的提取过程会创建一个虚拟图，提取的图例将根据所使用的渲染版本进行剪切，如下所示：
我已经在网上找到了很多材料，通过更改图例中的文本大小和/或其他选项来调整图例的大小，但它们都需要为每个图形和每个渲染选项手动执行此操作。
为了避免这种情况，我正在寻找另一种方法来在打印绘图之前提取整个图例（侧面没有任何剪切），以便能够将其单独组合到生成的没有图例的图形中，以便适应大小应打印的材料的图例。
在此先感谢您的帮助！
一种方法是使用 if-else 逻辑将不同ggplot组件的大小值存储在列表中，然后在 ggplot 对象中使用该列表而不是硬编码值。我们可以使用knitr::is_html_output和knitr::is_latex_output来确定文档输出格式。（对于更多输出变体，可以使用四开的条件内容。
```{r}
if(knitr::is_html_output()) {
size_list <- list(
legend_text = 7,
legend_title = 11,
legend_space = 0.7,
fig_height = 6,
fig_width = 8
)
} else if (knitr::is_latex_output()) {
size_list <- list(
legend_text = 7,
legend_title = 10,
legend_space = 0.5,
fig_height = 6,
fig_width = 8
)
}
```
```{r}
#| fig-height: !expr size_list$fig_height
#| fig-width: !expr size_list$fig_width
fig <- fig +
facet_wrap(vars(family_sober)) +
scale_x_continuous(breaks = quartal_breaks$breaks,
labels = quartal_breaks$year,
minor_breaks = c(1:9)) +
xlab("Time") +
ylab("Number") +
guides(color = guide_legend(override.aes = list(size = 0.8))) +
theme(legend.position = "bottom",
legend.text = element_markdown(size = size_list$legend_text),
legend.key.height = unit(1.8, units = "char"),
legend.margin = margin(t = 0, r = 0, b = 0, l = 0, unit='cm'),
legend.spacing = unit(size_list$legend_space, units = "char"),
legend.title = element_markdown(size = size_list$legend_title),
axis.text.x=element_text(angle=45, hjust=1, size = 7))
print(fig)
```
（我已经发布了相关代码的最后一部分，其中进行了必要的更改）
pdf输出
html输出
- 谢谢，这是一个很好的解决方法。然而，这意味着必须通过反复试验为每个图和每种输出格式找到正确的值，这非常耗时。此外，如果这是在给定时间段后实现的报告，您应该每次检查它是否仍在工作，因为添加新类别可能会导致同样的问题。我会等着看是否有人提出另一个解决方案，如果没有，我会接受你的答案。 (3认同)
| 归档时间： |
|
| 查看次数： |
585 次 |
| 最近记录： |