Create sections through a loop with knitr - r

Question

See this reproducible example :
---
title: "test"
output: html_document
---
## foo
```{r}
plot(1:3)
```
## bar
```{r}
plot(4:7)
```
## baz
```{r}
plot(8:12)
```
I want to be able to automate the creation of these sections as I can't know how many they will be before going further in my analysis.
My input to get this would be :
my_list <- list(foo = 1:3, bar = 4:7, baz = 8:12)
my_fun <- plot
my_depth <- 2
And the ideal answer (though I'm welcoming any improvement) would help me build a mdapply function so that I could just run:
```{r}
mdapply(X = my_list, FUN = my_fun, title_depth = my_depth)
```
And get the same output.

Answer 1

R package pander can generate Pandoc's markdown on the fly.
The key is to use the chunk option results='asis' to tell R Markdown to render pander's output as Markdown.
You just need to be careful to generate valid Markdown!
Try this:
---
title: "Test sections"
output: html_document
---
## A function that generates sections
```{r}
library(pander)
create_section <- function() {
# Inserts "## Title (auto)"
pander::pandoc.header('Title (auto)', level = 2)
# Section contents
# e.g. a random plot
plot(sample(1000, 10))
# a list, formatted as Markdown
# adding also empty lines, to be sure that this is valid Markdown
pander::pandoc.p('')
pander::pandoc.list(letters[1:3])
pander::pandoc.p('')
}
```
## Generate sections
```{r, results='asis'}
n_sections <- 3
for (i in seq(n_sections)) {
create_section()
}
```
It still looks hackish, but Markdown has its limits...

Answer 2

It seems like I found a way!
The whole idea is to pass what would be typed by hand as a string inside of knit(text=the_string) used in inline code.
So the function basically pastes a bunch of strings together, with a bit of substitute magic to have a function that feels like it's part of the apply family.
Parameter depth decides how many # you want.
Parameter options contains the chunk options, as a vector.
A vector shouldn't be able to contain logical and characters together but here it doesn't matter as it will all be coerced to character anyway, so c(echo= FALSE, results="hide") is fine.
I expect that it's easy to break but seems to work fine when treated gently.
---
title: "test"
output: html_document
---
```{r setup, include = FALSE}
library(knitr)
mdapply <- function(X, FUN, depth, options=""){
FUN <- as.character(substitute(FUN))
list_name <- as.character(substitute(X))
if(options != "")
options <- paste(",",names(options),"=",options,collapse="")
build_chunk <- function(nm)
{
paste0(
paste0(rep("#",depth), collapse=""),
" ",
nm,
"\n\n```{r", options, "}\n",
FUN,
"(", list_name, "[['", nm, "']])\n```")
}
parts <- sapply(names(X), build_chunk)
whole <- paste(parts, collapse="\n\n")
knit(text=whole)
}
```
```{r code}
my_list <- list(foo = 1:3, bar = 4:7, baz = 8:12)
```
`r mdapply(my_list, plot, 2, c(echo=FALSE))`

Answer 3

I would actually suggest a solution that works a little bit different, i.e. create the R-Markdown file from an R-script and then render it from the same R-script:
# function that creates the markdown header
rmd_header <- function(title){
paste0(
"---
title: \"", title, "\"
output: html_document
---
"
)
}
# function that creates the Rmd code for the plots
rmd_plot <- function(my_list, my_fun){
paste0(
"
## ", names(my_list), "
```{r}
", deparse(substitute(my_fun)), "(", deparse(substitute(my_list)), "[[", seq_along(my_list), "]])
```
"
)
}
# your objects
my_list <- list(foo = 1:3, bar = 4:7, baz = 8:12)
my_fun <- plot
my_depth <- 2 # I actually don't get what this is for
# now write everything into an rmd file
cat(rmd_header("Your Title")
, rmd_plot(my_list, plot)
, file = "test.rmd")
# and then create the html from that
rmarkdown::render("test.rmd", output_file = "test.html")
One thing to mention here: the indentation in the Rmd file does matter and when you copy the code here, make sure that R-Studio inserts it in the R-script as intended (because often it doesn't).

Answer 4

Taking a similar approach to #Georgery... but in a somewhat over-engineered fashion (also somewhat more general?). Anyway, here it goes.
make_template <- function(my_list, my_fun, my_depth, my_title, my_output_type, my_template_file){
require(glue)
n <- length(my_list)
# --- Rmd header ---
make_header <- function(my_title, my_output_type){
#
my_header <- glue(
"---", "\n",
"title: ", deparse({my_title}), "\n",
"output: ", deparse({my_output_type}), "\n",
"---", "\n",
"\n",
"\n"
)
return(my_header)
}
# --- one section only ---
make_section <- function(i){
one_section <- glue(
"\n",
"\n",
paste0(rep("#", times = {my_depth}), collapse = ""), " ", names({my_list})[[i]], "\n",
"\n",
"```{{r}}", "\n",
paste0({my_fun}, "(", deparse({my_list}[[i]]), ")"), "\n",
"```", "\n",
"\n",
"\n"
)
return(one_section)
}
# --- produce whole template ---
my_header <- make_header(my_title, my_output_type)
all_my_sections <- ""
for (i in seq_along(my_list)) {
all_my_sections <- paste0(all_my_sections, make_section(i))
}
my_template <- paste0(my_header, "\n", "\n", all_my_sections)
# --- write out
cat(my_template, file = my_template_file)
}
# --- try it
make_template(my_list = list(foo = 1:3, bar = 4:7, baz = 8:12, glop = 1:7),
my_fun = "plot",
my_depth = 4,
my_title = "super cool title",
my_output_type = "html_document",
my_template_file = "my_template_file.Rmd"
)