Reputation: 835
I'd like to change the fig.cap
chunk option within a chunk for a knitr document. I tend to write a lot of reporting code that looks like the following to take a plot out of a tibble and use the associated caption with it.
```{r fig, fig.cap=d_plot$caption}
d_plot <- [load the plotting tibble from prior work]
knit_print(d_plot$figure[[1]])
```
Something similar to what I'd like to do is the following, but where the caption actually shows up. And, better yet would be if it would modify fig.cap and fig.scap with the possibility of having multiple knit_print()
calls with multiple sets of figures.
---
title: "Untitled"
author: "William Denney"
date: '2022-04-19'
output: pdf_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo=FALSE, warning=FALSE, error=FALSE)
library(tidyverse)
library(knitr)
```
# Test
```{r functions, include=FALSE}
knit_print.fig_n_cap <- function(x) {
lapply(x$figure, knit_print)
opts_chunk$set(fig.cap=x$caption)
}
as_fig_n_cap <- function(x) {
stopifnot(is.data.frame(x))
stopifnot("figure" %in% names(x))
stopifnot("caption" %in% names(x))
class(x) <- c("fig_n_cap", class(x))
x
}
p <- ggplot(data.frame(x=1:3, y=1:3), aes(x=x, y=y)) + geom_line()
d <- as_fig_n_cap(tibble(figure=list(p), caption="My caption"))
```
```{r}
knit_print(d)
```
Upvotes: 1
Views: 105
Reputation: 8886
I think it may be better to use a custom output chunk hook here to post-process the output as opposed to a custom knit_print because the hook route will allow knitr to do a lot of heavy lifting for which it is already programmed such as saving temporary figures, linking to them, and setting figure sizes.
Here is an example R Markdown document with the custom hook.
Note, this has only be subjected to limited testing but does seem to be working.
---
title: "Knitr Chunk Output Hook Example"
output: pdf_document
date: "2024-04-25"
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
local({
hook_old <- knitr::knit_hooks$get("chunk")
knitr::knit_hooks$set(chunk = function(x, options) {
fig_n_cap_regex <- stringr::regex(
'```\\n## \\$figure\\n.+?## \\[1\\] "fig_n_cap"\\n```',
multiline = TRUE,
dotall = TRUE
)
x <- stringr::str_replace_all(x, fig_n_cap_regex, function(fig_n_cap_out) {
cap_txt <- stringr::str_extract(fig_n_cap_out, '## \\[1\\] "(.+)"\\n', 1)
if(knitr::is_html_output()) {
img_md <- stringr::str_extract(fig_n_cap_out, "\\!.+\\)")
if(!is.na(img_md)) {
stringr::str_replace(
img_md,
"\\!\\[.*?\\]",
paste0("![", cap_txt, "]")
)
} else {
img_htm <- stringr::str_extract(fig_n_cap_out, "<img.+/>")
cap_htm <- sprintf('<p class="caption">%s</p>', cap_txt)
paste(img_htm, cap_htm, sep = "\n")
}
} else if(knitr::is_latex_output()) {
img_md <- stringr::str_extract(fig_n_cap_out, "\\!.+\\)")
if(!is.na(img_md)) {
stringr::str_replace(
img_md,
"\\!\\[.*?\\]",
paste0("![", cap_txt, "]")
)
} else {
include_tex <- stringr::str_extract(
fig_n_cap_out,
"\\\\includegraphics\\[.+?\\}"
)
label <- stringr::str_extract(
include_tex,
"figure-latex/(.+?-\\d+-\\d+)",
1
)
paste(
"\\begin{figure}",
sprintf(
"%s \\caption{%s}\\label{fig:%s}",
include_tex,
cap_txt,
label
),
"\\end{figure}",
sep = "\n"
)
}
} else {
fig_n_cap_out
}
})
hook_old(x, options)
})
})
```
```{r}
gg_scatter_plot <- function(data) {
data |> ggplot2::ggplot(ggplot2::aes(x, y)) + ggplot2::geom_point()
}
d_plot <- tibble::tibble(
figure = list(
data.frame(x = rnorm(1000), y = rnorm(1000)) |> gg_scatter_plot(),
data.frame(x = runif(1000), y = runif(1000)) |> gg_scatter_plot()
),
caption = c(
"This is a caption.",
"This is another caption."
)
)
as_fig_n_cap <- function(x) {
stopifnot(is.data.frame(x))
stopifnot("figure" %in% names(x))
stopifnot("caption" %in% names(x))
class(x) <- "fig_n_cap"
x
}
d_plot[1, ] |> as_fig_n_cap()
d_plot[2, ] |> as_fig_n_cap()
```
Upvotes: 1