R Shiny：markdown table 单元格内的代码输出

Question

我正在尝试将 R 批量输出嵌入到 html table 的单元格中。据我所知：

app.R

require(shiny)
require(knitr)
require(ggplot2)

d = iris

ui = fluidPage(
  uiOutput('markdown')
)

server = function(input, output, session) {
  output$markdown <- renderUI({
    HTML(knit(text = paste(readLines('table.html'), collapse='\n')))
  })
}

shinyApp(ui, server)

table.html

<table class='table'>
<tr> <th>text field</th> <th>sparkline</th> </tr>
<tr>
  <td>Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat.</td>
  <td>
```{r, echo=FALSE, include=TRUE}
# message("setosa") # uncomment to test console output
qplot(Sepal.Length, Sepal.Width, data = d[d == "setosa",], geom="line")
```
  </td>
</tr>

<tr>
  <td>Sed ut perspiciatis unde omnis iste natus error sit voluptatem accusantium doloremque laudantium, totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae dicta sunt explicabo.</td>
  <td>
```{r, echo=FALSE, include=TRUE}
# message("versicolor")
qplot(Sepal.Length, Sepal.Width, data = d[d == "versicolor",], geom="line")
```
  </td>
</tr>

<tr>
  <td>Neque porro quisquam est, qui dolorem ipsum quia dolor sit amet, consectetur, adipisci velit, sed quia non numquam eius modi tempora incidunt ut labore et dolore magnam aliquam quaerat voluptatem.</td>
  <td>
```{r, echo=FALSE, include=TRUE}
# message("virginica")
qplot(Sepal.Length, Sepal.Width, data = d[d == "virginica",], geom="line")
```
  </td>
</tr>
</table>

输出如下：

knit 正在将图形输出到文件。有没有办法让他们直接渲染？ 我可能做错了，但尚未确定等效的 {rmarkdown} 工作流程..

---

作为相关点，当使用 message(...) 输出而不是 qplot 进行测试时，html table 单元格如下所示：

``` ## setosa ```

知道如何删除反引号和井号吗？

Answer 1

一个可用的工具链如下：

table.Rmd

<!--pandoc
t: html
o: table.html
-->

```{r, echo = FALSE, include = FALSE}
opts_knit$set(base.dir = "www")
```
<table class='table'>
  <tr>
    <th>text field</th>
    <th>sparkline</th>
  </tr>
  <tr>
    <td>
       Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt.
    </td>
    <td>
      ```{r, echo = FALSE, include = TRUE}
      qplot(Sepal.Length, Sepal.Width, data = d[d$Species == "setosa", ], geom = "line")
      ```
    </td>
  </tr>
</table>

app.R

library(shiny)
library(knitr)
library(ggplot2)

d <- iris
ui <- fluidPage(
   uiOutput("markdown")
)

server <- function(input, output, session) {
   output$markdown <- renderUI({
      tmp <- knit("table.Rmd", quiet = TRUE) ## could combine these...
      pandoc(tmp)                            ## ...two lines also in `knit2pandoc`
      includeHTML("table.html")
   })
}

shinyApp(ui, server)

然后你可以 运行 runApp("app.R") 你会得到以下输出：

一些评论

这比我想象的要棘手，我绝不是 pandoc/knit/markdown 专家，所以我什至不确定我的命名是否正确，但我可以分享我的发现：

• 我将您的 table.html 更改为 table.Rmd，因为它实际上是 RMarkdown 而不是（纯）HTML 文件。如果我们想要（如在我的示例中）使用文件名而不是 readLines，这对于帮助 knit 使用正确的分隔符也是必要的。
• 我运行knit("table.Rmd")看看markdown文档的样子，好像没问题。
• 我的下一个想法是在这个 .md 文件上使用 includeMarkdown，但经过反复试验，我发现无论出于何种原因，来自 [=27 的 t运行slation =] -> .html（这就是 includeMarkdown 背后发生的事情）不起作用，降价标记 ![plot](path/to/figure) 从来没有正确地 t运行 根据 <img> 标签。当我尝试使用 knit2html 时也发生了同样的情况。两者都依赖于 markdown::renderMarkdown 并且此函数根本不会 t运行 将降价图像标记转换为 HTML 图像标记 如果嵌套在 table.
• 查看独立的 rmarkdown 文档，我发现他们使用 pandoc 将 markdown 文档转换为 HTML 格式.
• 经过更多的尝试和错误后，我可以说服 pandoc 产生结果：
  • 我在 table.Rmd 中添加了一些 pandoc 配置。但是，由于这些无论如何都是默认值，您也可以安全地忽略它们。如果你想做一些更花哨的事情，你需要他们调整 pandoc 的调用方式。
  • shiny 期望静态资源托管在 www 文件夹下。因此，我们需要告诉 knit 使用此文件夹来存储图形（另一种选择是在 shiny 侧使用 addResourcePath）。

TL;DR

以下工具链将起作用：

table.Rmd -> table.md via knit -> table.html via pandoc -> shiny via inclueHTML

或等价地

table.Rmd -> table.html via knit2pandoc -> shiny via includeHTML

---

renderMarkdown 不喜欢 table

中的块

does_translate <- "```{r}\nggplot2::qplot(1, 2)\n```"
does_not_translate <- "<table><tr><td>\n```{r}\nggplot2::qplot(1, 2)\n```\n</td></tr></table>"

cat(knit2html(text = does_translate, fragment.only = TRUE))
# vs.
cat(knit2html(text = does_not_translate, fragment.only = TRUE))

---

更新

根据评论，如果您想确保在块中生成的文件名是“唯一的”，您可以在 Rmd 中使用以下代码块（受 this article 启发） :

```{r, echo = FALSE, include = FALSE}
opts_knit$set(base.dir = "www")

knitr::opts_chunk$set(
   fig.process = function(filename) {
      wd <- dirname(filename)
      ext <- file_ext(filename)
      new_filename <- tempfile(tmpdir = wd, fileext = paste0(".", ext))
      file.copy(filename, new_filename)
      unlink(filename)
      ifelse(file.exists(new_filename), new_filename, filename)
   }
)

```