如何将`.Rmd`的所有ggplots保存为`.rds`

Question

我使用 Markdown 文档进行分析。我创建了大量的绘图并使用 knitr::opts_chunk$set(dev= c("png", "svg", "pdf")并rmarkdown::render(... , clean = FALSE)获取 png（用于谷歌幻灯片）、svg（用于 powerpoint）和 pdf（包含在手动乳胶报告中）。但是，我现在想将不同分析的绘图合并到图形面板中，同时能够更改绘图大小和纵横比，而无需每次重新运行所有分析。

实现此目的的一种方法是将 ggplots 保存在分析笔记本中.rds使用的文件中以及生成图形面板的单独脚本中。这可以使用钩子部分自动化：saveRDS(ggplot2::last_plot(), "figure_1.rds")library(patchwork); readRDS("figure_1.rds") / readRDS("figure_2.rds")

example_analysis.Rmd

```{r setup}
knitr::opts_chunk$set(dev= c("png", "svg", "pdf")
knitr::knit_hooks$set(hook_save_plot_as_rds = function(before, options, envir, name) {
  if(before) return() # run only after chunk
  if(length(knitr:::get_plot_files())==0) return() # only run if 
  saveRDS(ggplot2::last_plot(), knitr::fig_chunk(knitr::opts_chunk$get("label"), ext = "rds"))
})
```
Here we do some heavy analysis
```{r sepal-plot}
ggplot(iris, aes(Sepal.Width, Sepal.Length)) + geom_point()
```

Here we do some more heavy analysis
```{r petal-plot}
ggplot(iris, aes(Petal.Width, Petal.Length)) + geom_point()
```

别的地方：

library(patchwork)
get_figure <- function(name) readRDS(paste0("example_analysis_files/figure-html/", name, "-1.rds"))
get_figure("petal-plot") / get_figure("sepal-plot") + plot_annotation(tag_levels="A")

但这仅适用于每个块的最后一个 ggplot。有没有一种方法适用于所有块图？可能有隐藏的吗device="rds"？

Answer 1

解决方案实际上非常简单：执行此操作的正确位置不是额外的设备或某些挂钩，而是打印功能。knitr 提供了knit_printS3 泛型，可以控制 knitr 打印 R 对象的方式。人们只需添加一个knit_print.ggplot也可以保存情节。

我知道宜辉一定让这一切成为可能。

完整示例：

示例_分析.Rmd

---
title: "example_analysis"
output: 
  html_document:
    keep_md: yes
---

```{r setup}
local({ # to keep global environment uncluttered
  counter <- NA
  previous_label <- NA
  print_and_save.ggplot <- function(x, ...) {
    ret <-  print(x, ...)
    current_label <- knitr::opts_current$get("label")
    if(isTRUE(previous_label==current_label)) {
      counter <<- counter+1 # keep track of plot number
    } else { # reset plot number for each new chunk
      previous_label <<- current_label
      counter <<- 1
    }
    dir.create(knitr::opts_current$get("fig.path"), recursive = TRUE, showWarnings = FALSE)
    saveRDS(ret, knitr::fig_path(suffix = "rds", number = counter))
    invisible(ret)
  }
  library(knitr)
  registerS3method("knit_print", "ggplot", print_and_save.ggplot)
})
library(ggplot2)
```

Here we do some heavy analysis
```{r sepal-plot}
ggplot(iris, aes(Sepal.Width, Sepal.Length, fill= Species)) + geom_point()
ggplot(iris, aes(Sepal.Length, fill= Species)) + geom_histogram() + coord_flip()
```

Here we do some more heavy analysis
```{r petal-plot}
ggplot(iris, aes(Petal.Width, Petal.Length, fill= Species)) + geom_point()
ggplot(iris, aes(Petal.Length, fill= Species)) + geom_histogram() + coord_flip()
```

别的地方：

---
title: "example_analysis"
output: 
  html_document:
    keep_md: yes
---

```{r setup}
local({ # to keep global environment uncluttered
  counter <- NA
  previous_label <- NA
  print_and_save.ggplot <- function(x, ...) {
    ret <-  print(x, ...)
    current_label <- knitr::opts_current$get("label")
    if(isTRUE(previous_label==current_label)) {
      counter <<- counter+1 # keep track of plot number
    } else { # reset plot number for each new chunk
      previous_label <<- current_label
      counter <<- 1
    }
    dir.create(knitr::opts_current$get("fig.path"), recursive = TRUE, showWarnings = FALSE)
    saveRDS(ret, knitr::fig_path(suffix = "rds", number = counter))
    invisible(ret)
  }
  library(knitr)
  registerS3method("knit_print", "ggplot", print_and_save.ggplot)
})
library(ggplot2)
```

Here we do some heavy analysis
```{r sepal-plot}
ggplot(iris, aes(Sepal.Width, Sepal.Length, fill= Species)) + geom_point()
ggplot(iris, aes(Sepal.Length, fill= Species)) + geom_histogram() + coord_flip()
```

Here we do some more heavy analysis
```{r petal-plot}
ggplot(iris, aes(Petal.Width, Petal.Length, fill= Species)) + geom_point()
ggplot(iris, aes(Petal.Length, fill= Species)) + geom_histogram() + coord_flip()
```

Answer 2

knit_print您可以通过为对象设置方法来做到这一点ggplot。这是一个简单的例子：

---
title: "Untitled"
date: "2023-11-28"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)

# You can't see the knitr plot numbers, because they aren't determined until
# all the plotting is done.  We'll just use a simple sequential numbering.

plotnum <- 0

knit_print.ggplot <- function(x, options) {
  # Get a new plot number
  plotnum <<- plotnum + 1

  # Save the ggplot object to a file based on the chunk label and plot number

  saveRDS(x, paste0(options$label,"-", plotnum, ".rds"))

  # Now do the regular print method.
  print(x)
}
```

```{r}
library(ggplot2)
ggplot(iris, aes(Sepal.Width, Sepal.Length)) + 
  geom_point() + ggtitle("First")
ggplot(iris, aes(Sepal.Width, Sepal.Length)) + 
  geom_point() + ggtitle("Second")
```

编辑添加：

@jan-glx 大约在同一时间发布了一个更完整的解决方案；我推荐他的解决方案而不是实际使用的这个解决方案，但我喜欢这个用简单的代码来说明这一想法的解决方案。