R Markdown，循环输出测试结果

Question

我正在寻找一个漂亮格式的 Markdown 输出，用于显示在 for 循环中生成并使用标题结构化的测试结果。例如：

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))
}

输出应该是：

y（模型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（模型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（型号0）

等等……

有几篇结果讨论了部分问题，例如这里或这里，建议使用asis标签与cat语句结合使用。这个包括标题。

最接近我要求的似乎是两年前的这个问题。但是，尽管非常受欢迎，一些建议已经过时，比如asis_output，或者在一般条件下无法使用，比如formattable建议（例如使用lm-output）。我只是想知道——因为两年过去了——是否存在一种现代方法来实现我正在寻找的东西。

- Tom

---

你展示的输出格式是你想要的每个模型的输出格式吗？还是你想要为每个模型打印其他内容？ - camille

我希望能够得到一个简单的打印或打印摘要语句的统计测试对象的格式良好的输出。我不需要在此输出旁边打印其他信息。但是，我还有循环之前和之后的R代码，我也希望将其包含在渲染文档中。 - Tom

我找到了另一个解决方案@Tom，我认为这才是你真正想要的。 - jay.sf

Answer 1

解决方案类型1

您可以使用一些lapply循环和capture.output(cat(.))方法。将输出发送到文件并使用rmarkdown::render(.)。

这是产生*.pdf的R代码。

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")

产生：

解决方案类型2

当我们想要在rmarkdown本身中自动化输出多个模型摘要时，我们可以选择以下两种方式之一：1. 选择块选项results='asis'，它会生成代码输出，比如# Model 1标题，或者2.选择不选择它，这会生成Model 1但破坏了代码格式。解决方案是使用该选项，并将其与内联代码结合使用，我们可以通过另一个sapply()-循环将其paste()起来，放在模型的sapply()中。

在主要的sapply中，我们应用@G.Grothendieck崇高的解决方案，以优雅地替换输出的Call:行，使用do.call("lm", list(.))。我们需要将一个invisible(.)包装在它周围，以避免产生空列表的不必要的sapply()输出[[1]] [[2]]...。

我在cat()中包含了一个". "，因为前导空格，如` this`将在摘要输出的第6行和第10行呈现为this。

这是生成*pdf的rmarkdown脚本，也可以逐行执行：

---
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.

输出:

(注意: 站点3被省略)

- jay.sf

---

感谢您的答复。是否可能将此解决方案嵌入到更长的R脚本中，一方面可以通过rmarkdown呈现，另一方面可以在控制台逐步运行？ - Tom

@Tom 好的，没问题。唯一的影响就是它会生成两个文件（*.Rmd 和 *.pdf），你可以注释掉代码行来暂时阻止生成。 - jay.sf

非常感谢您提供的第二个扩展解决方案，这将很容易地融入到生产中。由于没有人提出更简单的方法来完成我正在寻找的事情，这个复杂的解决方案似乎反映了rmarkdown当前可能性的现状。您赢得了奖励。 - Tom

Answer 2

背景

当我尝试在循环中生成多个图时，遇到了与 OP 相同的需求，但其中一个图表显然会崩溃图形设备（因为不可预测的坏输入），即使使用 try() 调用也无法防止所有剩余图表的生成。我需要真正独立的代码块，就像所提出的解决方案一样。

解决方案

我考虑在将源文件传递给 knitr 之前，在 R 内部对其进行预处理，并发现 jinjar 包是一个很好的选择。它使用基于 Python/Django 的 Jinja2 模板引擎的动态模板语法。它与 R Markdown 接受的文档格式没有语法冲突，但棘手的部分是如何将其与其机制很好地集成。

我的 hackish 解决方案是创建一个包装器 rmarkdown::output_format()，该包装器在 rmarkdown::render() 调用环境中执行一些代码以处理源文件：

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(...),
        )
    }
}

那么我可以调用，例如：

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

或者更加程序化地，输出格式按照源文件元数据指定的方式进行，就像往常一样：

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

这是一个关于 input.Rmd 的最小示例：

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

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

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

注意事项

1. 这是一种hack。此代码依赖于markdown::render()的内部逻辑，并且可能存在某些边缘情况它无法正常工作。请自行承担风险。
2. 为了使此解决方案有效，输出格式构造函数必须由render()调用。因此，在将其传递给render()之前对其进行评估将会失败：

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

第二个限制可以通过将预处理代码放在pre_knit()钩子内来规避，但这样它只会在其他输出格式钩子（如intermediates_generator()和格式的其他pre_knit()钩子）之后运行。

- leogama

---

这也回答了至少这两个旧问题：https://dev59.com/lFwX5IYBdhLWcg3w4SzR 和 https://dev59.com/a6bja4cB1Zd3GeqPcjFq。但我在这里发布它，因为已经有一个令人满意的解决方案。 - leogama