R Markdown, output test results in loop

Question

I'm looking for a nicely formated markdown output of test results that are produced within a for loop and structured with headings. For example

df <- data.frame(x = rnorm(1000),
           y = rnorm(1000),
           z = rnorm(1000))

for (v in c("y","z")) {
  cat("##", v, " (model 0)\n")
  summary(lm(x~1, df))

  cat("##", v, " (model 1)\n")
  summary(lm(as.formula(paste0("x~1+",v)), df))
}

whereas the output should be

y (model 0)

Call:
lm(formula = x ~ 1, data = df)

Residuals:
    Min      1Q  Median      3Q     Max 
-3.8663 -0.6969 -0.0465  0.6998  3.1648 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)
(Intercept) -0.05267    0.03293    -1.6     0.11

Residual standard error: 1.041 on 999 degrees of freedom

y (model 1)

Call:
lm(formula = as.formula(paste0("x~1+", v)), data = df)

Residuals:
    Min      1Q  Median      3Q     Max 
-3.8686 -0.6915 -0.0447  0.6921  3.1504 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)
(Intercept) -0.05374    0.03297  -1.630    0.103
y           -0.02399    0.03189  -0.752    0.452

Residual standard error: 1.042 on 998 degrees of freedom
Multiple R-squared:  0.0005668, Adjusted R-squared:  -0.0004346 
F-statistic: 0.566 on 1 and 998 DF,  p-value: 0.452

z (model 0)

and so on...

There are several results discussing parts of the question like here or here suggesting the asis-tag in combination with the cat-statement. This one includes headers.

Closest to me request seems to be this question from two years ago. However, even though highly appreciated, some of suggestions are deprecated like the asis_output or I can't get them to work in general conditions like the formattable suggestion (e.g. withlm-output). I just wonder -- as two years have past since then -- if there is a modern approach that facilitates what I'm looking for.

Answer 1

Solution Type 1

You could do a capture.output(cat(.)) approach with some lapply-looping. Send the output to a file and use rmarkdown::render(.).

This is the R code producing a *.pdf.

capture.output(cat("---
title: 'Test Results'
author: 'Tom & co.'
date: '11 10 2019'
output: pdf_document
---\n\n```{r setup, include=FALSE}\n
knitr::opts_chunk$set(echo = TRUE)\n
mtcars <- data.frame(mtcars)\n```\n"), file="_RMD/Tom.Rmd")  # here of course your own data

lapply(seq(mtcars), function(i) 
  capture.output(cat("# Model", i, "\n\n```{r chunk", i, ", comment='', echo=FALSE}\n\
                   print(summary(lm(mpg ~ ", names(mtcars)[i] ,", mtcars)))\n```\n"),
                 file="_RMD/Tom.Rmd", append=TRUE))

rmarkdown::render("_RMD/Tom.Rmd")

Produces:

Solution Type 2

When we want to automate the output of multiple model summaries in the rmarkdown itself, we could chose between 1. selecting chunk option results='asis' which would produce code output but e.g. # Model 1 headlines, or 2. to choose not to select it, which would produce Model 1 but destroys the code formatting. The solution is to use the option and combine it with inline code that we can paste() together with another sapply()-loop within the sapply() for the models.

In the main sapply we apply @G.Grothendieck's venerable solution to nicely substitute the Call: line of the output using do.call("lm", list(.)). We need to wrap an invisible(.) around it to avoid the unnecessary sapply() output [[1]] [[2]]... of the empty lists produced.

I included a ". " into the cat(), because leading white space like ` this` will be rendered to this in lines 6 and 10 of the summary outputs.

This is the rmarkdown script producing a *pdf that can also be executed ordinary line by line:

---
title: "Test results"
author: "Tom & co."
date: "15 10 2019"
output: pdf_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
# Overview

This is an example of an ordinary code block with output that had to be included.

```{r mtcars, fig.width=3, fig.height=3}
head(mtcars)
```
# Test results in detail

The test results follow fully automated in detail.

```{r mtcars2, echo=FALSE, message=FALSE, results="asis"}
invisible(sapply(tail(seq(mtcars), -2), function(i) {
  fo <- reformulate(names(mtcars)[i], response="mpg")
  s <- summary(do.call("lm", list(fo, quote(mtcars))))
  cat("\n## Model", i - 2, "\n")
  sapply(1:19, function(j) 
    cat(paste0("`", ". ", capture.output(s)[j]), "`  \n"))
  cat("  \n")
  }))
```

***Note:*** This is a concluding remark to show that we still can do other stuff afterwards.

Produces:

(Note: Site 3 omitted)

Answer 2

Context

I was hit by the same need as that of OP when trying to generate multiple plots in a loop, but one of them would apparently crash the graphical device (because of unpredictable bad input) even when called using try() and prevent all the remaining figures from being generated. I needed really independent code blocks, like in the proposed solution.

Solution

I've thought of preprocessing the source file before it was passed to knitr, preferably inside R, and found that the jinjar package was a good candidate. It uses a dynamic template syntax based on the Jinja2 templating engine from Python/Django. There are no syntax clashes with document formats accepted by R Markdown, but the tricky part was integrating it nicely with its machinery.

My hackish solution was to create a wrapper rmarkdown::output_format() that executes some code inside the rmarkdown::render() call environment to process the source file:

preprocess_jinjar <- function(base_format) {
    if (is.character(base_format)) {
        base_format <- rmarkdown:::create_output_format_function(base_format)
    }

    function(...) {
        # Find the markdown::render() environment.
        callers <- sapply(sys.calls(), function(x) deparse(as.list(x)[[1]]))
        target <- grep('^(rmarkdown::)?render$', callers)
        target <- target[length(target)]  # render may be called recursively
        render_envir <- sys.frames()[[target]]

        # Modify input with jinjar.
        input_paths <- evalq(envir = render_envir, expr = {
            original_knit_input <- sub('(\\.[[:alnum:]]+)$', '.jinjar\\1', knit_input)
            file.rename(knit_input, original_knit_input)
            input_lines <- jinjar::render(paste(input_lines, collapse = '\n'))
            writeLines(input_lines, knit_input)

            normalize_path(c(knit_input, original_knit_input))
        })

        # Add an on_exit hook to revert the modification.
        rmarkdown::output_format(
                knitr = NULL,
                pandoc = NULL,
                on_exit = function() file.rename(input_paths[2], input_paths[1]),
                base_format = base_format(...),
        )
    }
}

Then I can call, for example:

rmarkdown::render('input.Rmd', output_format = preprocess_jinjar('html_document'))

Or, more programatically, with the output format specified in the source file metadata as usual:

html_jinjar <- preprocess_jinjar('html_document')
rmarkdown::render('input.Rmd')

Here is a minimal example for input.Rmd:

---
output:
  html_jinjar:
    toc: false
---

{% for n in [1, 2, 3] %}
# Section {{ n }}

```{r block-{{ n }}}
print({{ n }}**2)
```
{% endfor %}

Caveats

1. It's a hack. This code depends on the internal logic of markdown::render() and likely there are edge cases where it won't work. Use at your own risk.
2. For this solution to work, the output format contructor must be called by render(). Therefore, evaluating it before passing it to render() will fail:

render('input.Rmd', output_format = 'html_jinja')  # works
render('input.Rmd', output_format = html_jinja)    # works
render('input.Rmd', output_format = html_jinja())  # fails

This second limitation could be circumvented by putting the preprocessing code inside the pre_knit() hook, but then it would only run after other output format hooks, like intermediates_generator() and other pre_knit() hooks of the format.