动态调整 ggplot2 图例的大小以适应 Quarto 中的文档类型

2023-12-30

我正在使用 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 and knitr::is_latex_output确定文档输出格式。 (对于更多输出变体,Quarto 的条件内容 https://quarto.org/docs/authoring/conditional.html可能用过了。

```{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输出



本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

动态调整 ggplot2 图例的大小以适应 Quarto 中的文档类型 的相关文章

随机推荐

  • 服务意图必须明确:意图

    我现在有一个应用程序 我在其中通过广播接收器 MyStartupIntentReceiver 调用服务 广播接收器中调用服务的代码是 public void onReceive Context context Intent intent I
  • 从 Razor 调用 ServiceStack 服务

    这里有一点边缘情况 我需要从 razor 同一网站 调用服务堆栈服务 现在我正在做 CheckIfConfiguredResponse aResponse new JsonServiceClient http localhost 2000
  • 在使用 AngularJS 的 Chrome 应用程序中,我可以直接将 ngSrc 指令用于内部图像吗?

    我正在使用 AngularJS 编写一个 Chrome 应用程序 我知道 当访问外部图像时 您必须执行跨源 XMLHttpRequest 并将它们作为 blob 提供 我有一堆内部图像 本地应用程序资源 它们遵循我想要在 ngRepeat
  • 选择容器后 JProfiler 远程进程列表为空

    我正在使用 JProfiler 12 并尝试通过 SSH 连接到 Docker 容器中的远程 JVM 进程 我已按照此处的说明进行操作 https www ej technologies com products jprofiler wha
  • 仅使用一元绑定语法表达 do 块

    据我所知 doHaskell 中的块只是一元绑定运算符的某种语法糖 例如 可以转换 main do f lt readFile foo txt print f print Finished to main readFile foo txt
  • uitableviewcell 的数据在滚动时相互重叠

    我有一个包含四个部分的表格视图 所有部分都有两个文本字段和一个位于不同行的标签 我添加了一些文本作为文本字段的占位符 最初 数据看起来很好 但是当我滚动表格视图时 单元格开始出现重叠的数据 My Code UITableViewCell t
  • 我如何检查是否已收到 Playwright 的回复?

    使用 Java 我试图等待对我正在等待的 Javascript 脚本之一的响应 我已经发现我可以使用等待响应 https playwright dev java docs api class page page wait for respo
  • React.js 中的 setState 与 refs

    我在反应中创建了选项卡 现在单击我必须更改选项卡的类 选项卡类可能如下 1 active2 上一个活动3 已选择 单击选项卡类后将变为active并在使用前检查是否已选择alreadySelected类和active最后一个活动选项卡中的类
  • 如何将多个 PNG 合并为一个大 PNG 文件?

    我有大约 6000 个 PNG 文件 256 256 像素 并希望将它们组合成一个大 PNG 以编程方式保存所有这些文件 最好 最快的方法是什么 目的是在纸上打印 因此使用某些网络技术不是一种选择 拥有一个单一的图片文件将消除许多使用错误
  • Go 中的 exec.Command() 与环境变量

    我想在 Go 中运行以下代码 out err exec Command echo PATH Output 结果是 PATH 而不是 PATH bin 的预期值 为什么 我怎样才能得到期望值 shell 没有解释您的命令 这就是预期的变量替换
  • {} + "" 与 "" + {} - 加法的一致性 [重复]

    这个问题在这里已经有答案了 前几天我在 Reddit 上偶然发现了这个 海报指出 等于0 而类似的 等于一个空 object Object 正常的数学规则告诉我这很奇怪 但为什么会这样呢 代币 语句的开头可能意味着对象文字的开始 也可能意味
  • 检索 Z3Py 中的值会产生意外结果

    我想找到一个表达式的最大间隔e对所有人来说都是如此x 编写这样的公式的方法应该是 Exists d ForAll x in d d e and ForAll x not in d d e 为了得到这样一个d 公式f在 Z3 中 看上面的 可
  • 从预先输入选择更新模型

    考虑我的正文中的以下内容html file div class container fluid div
  • Data::Dumper 中是否有相当于 Perls 的 Dumper() 方法的 C 语言?

    本质上 我正在寻找的是一个可以让我做这样的事情的函数 转储器 some obj 输出 some objs 的数据结构 Thanks C 不支持任何类型的开箱即用的反射 此外 它不是硬类型 因为一旦将其编译为机器代码 类型就不再存在 与某些高
  • ngrx - 有条件地停止/删除效果/操作

    我目前正在使用 Ionic2 和 ngrx 构建一个应用程序 如果没有网络连接 我会尝试停止某些操作 通过停止 我的意思是以某种方式使它们对其他效果和商店不可见 或阻止它们进一步 传播 有没有办法做这样的事情 Effect checkNet
  • Flutter、原生 Admob、广告加载失败:0

    https pub dev packages google mobile ads https pub dev packages google mobile ads 我复制了这个例子 除了 原生广告 之外 一切正常 当然 MainActivi
  • 如何从 CMSampleBufferRef 获取字节并通过网络发送

    Am 使用 AVFoundation 框架捕获视频 在 Apple 文档的帮助下http developer apple com library ios documentation AudioVideo Conceptual AVFound
  • cocos2d中如何填充纹理?

    我有一个形状和纹理图像 shape png texture png 我想在cocos2d 中将形状绘制为texture png 图案 形状尺寸比纹理图像大得多 因此自动填充整个形状的纹理图案 我试图认识路 找不到 有人有办法解决这个问题吗
  • “不变违规:requireNativeComponent:在 UIManager 中找不到“RNSScreen”。” React Native cli 出错

    我不断收到 RNSScreen 错误 我已遵循反应导航指南上的所有说明 但没有任何效果对我有用 看起来本机包不会自动链接 所以试试这个 Note 你的情况可以是 代替 因为我正在使用 Monorepo Podfile pod RNScree
  • 动态调整 ggplot2 图例的大小以适应 Quarto 中的文档类型

    我正在使用 R 生成包含图形和表格的四开本文档 应渲染此文档以创建 HTML 和 PDF 文件 大部分都工作得很好 然而 我有很多图例的人物 并且在生成情节时 一些图例被切到了侧面 我找到了调整图例大小的解决方案 以便所有图例都适合使用以下