如何将`.Rmd`中的所有ggplot保存为`.rds`文件。

Question

我在我的分析中使用Markdown文档。我创建了很多图表，并使用knitr::opts_chunk$set(dev= c("png", "svg", "pdf")和rmarkdown::render(... , clean = FALSE)来获得png（用于Google幻灯片），svg（用于PowerPoint）和pdf（用于手动LaTeX报告）。然而，现在我想将不同分析的图表组合成图形面板，同时能够在不重新运行所有分析的情况下更改图表的大小和纵横比。

实现这一目标的一种方法是使用.rds文件保存ggplots，使用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"吗？

- jan-glx

Answer 1

你可以通过为ggplot对象设置一个knit_print方法来实现这一点。这里有一个简单的例子：

---
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在大约同一时间发布了一个更完整的解决方案；我建议在实际使用时使用他的解决方案，但我喜欢这个解决方案来说明简单代码的思路。

- user2554330

---

很好，你比我快！在我下面的自问自答中，我（1）使用了匿名函数来存储plotnum，并且（2）通过观察块标签来为每个块重置它。这样做的好处是全局环境保持清洁（通过1），而且文件名更加稳定（2）。如果我用我的回答替换你的回答，删除我的回答并接受你的回答，你觉得可以吗？ - undefined

不，你应该接受你自己的答案。我认为让人们看到两个答案会更好。 - undefined

你的比我的更不需要TLDR - undefined

Answer 2

解决方案实际上非常简单：正确的地方不是额外的设备或一些钩子，而是打印函数。knitr提供了knit_print S3 generic，它可以控制knitr如何打印R对象。我们可以简单地添加一个knit_print.ggplot，同时保存绘图。

我知道Yihui一定能做到这一点。

完整示例：

example_analysis.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 <-  ggplot2:::print.ggplot(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()
```

别的地方：

library(patchwork)
get_figure <- function(name, idx = 1) readRDS(paste0("example_analysis_files/figure-html/", name, "-", idx,".rds"))
(get_figure("petal-plot") + get_figure("petal-plot", 2))  / (get_figure("sepal-plot") + get_figure("sepal-plot", 2)) + plot_annotation(tag_levels="A")
#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

- jan-glx

---

看起来我们几乎同时找到了相同的解决方案。在我的解决方案中有一个主要缺陷，而在你的解决方案中只是一个小缺陷：即图表的编号。没有简单的方法可以找出knitr将使用的图表编号。你在每个代码块中进行了顺序计数。通常这是正确的，但我认为如果代码块中包含其他类型的图形，如基本图形、leaflet、plotly、rgl等，那么这些编号可能是错误的。 - undefined

Answer 3

一个替代方案是在每个块中包含以下内容。

plot_label = opts_current$get("label")
saveRDS(ggplot2::last_plot(), paste0(plot_label, ".rds")

将该绘图对象保存到给定的RDS文件中。

为了避免重复代码，你可以将其封装在一个函数中。

save_plot <- function() {
  plot_label = opts_current$get("label")
  saveRDS(ggplot2::last_plot(), paste0(plot_label, ".rds")
}

可能会看起来像这样

```{r petal-plot}
ggplot(iris, aes(Petal.Width, Petal.Length)) + geom_point()
save_plot()
```

然后，当你想要使用可用的图表时，可以使用你喜欢的方法加载它们，例如使用list.files(pattern = "*.rds")。

- mhovd

---

这种方法跟问题中的方式有什么不同或更好的地方？ - undefined

不一定更好，只是一种不依赖于钩子的替代解决方案。据我所知，没有RDS设备。 - undefined

这就是问题中的钩子解决方案所做的事情，而且还有一个额外的好处，就是你不需要在每个块中都添加那行代码。 - undefined

只要在每个图之后使用save_plot，这对于块中的所有图都适用。 - undefined

不对。第二个会覆盖第一个。（对不起，评论点赞的事情） - undefined