使用 knitr 通过循环创建部分

Question

查看这个可重现的示例：

---
title: "test"
output: html_document
---

## foo

```{r}
plot(1:3)
```

## bar

```{r}
plot(4:7)
```

## baz

```{r}
plot(8:12)
```

我希望能够自动创建这些部分，因为在进一步分析之前我不知道它们会有多少。

我的输入是：

my_list   <- list(foo = 1:3, bar = 4:7, baz = 8:12)
my_fun    <- plot
my_depth  <- 2

理想的答案（尽管我欢迎任何改进）将帮助我构建一个 mdapply 函数，以便我可以运行：

```{r}
mdapply(X = my_list, FUN = my_fun, title_depth = my_depth)
```

并获得相同的输出。

Answer 1

看来我找到了办法！

整个想法是将手动键入的内容作为字符串传递给内联代码中使用的knit(text=the_string)。

所以这个函数基本上是把一堆字符串粘贴在一起，加上一点substitute 的魔力，让这个函数感觉像是apply 家族的一部分。

• 参数depth决定你想要多少#。

• 参数options包含块选项，作为一个向量。

一个向量不应该能够同时包含逻辑和字符，但在这里没关系，因为无论如何它都会被强制转换为字符，所以c(echo= FALSE, results="hide") 很好。

我希望它很容易折断，但如果轻轻对待它似乎也能正常工作。

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

R 包pander 可以动态生成 Pandoc 的降价。

关键是使用块选项results='asis' 告诉R Markdown 将pander 的输出渲染为Markdown。 您只需要小心生成有效的 Markdown！

试试这个：

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

它看起来仍然很老套，但 Markdown 有其局限性......

Answer 3

我实际上会建议一个稍微不同的解决方案，即从 R 脚本创建 R-Markdown 文件，然后从同一个 R 脚本渲染它：

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

这里要提一件事：Rmd 文件中的缩进确实很重要，当您在此处复制代码时，请确保 R-Studio 按预期将其插入到 R 脚本中（因为通常不会）。

Answer 4

采用与@Georgery 类似的方法...但采用了某种过度设计的方式（也更通用？）。不管怎样，就这样吧。

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