R Shiny : code output inside markdown table cell

Question

我正在尝试将 R 批量输出嵌入到 html 表格的单元格中。据我所知，这是:

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 表格单元格如下所示:

``` ## setosa ```

知道如何删除反引号和哈希符号吗？

Answer 1

工作工具链如下:

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

应用程序.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文档看起来好像没问题。
• 我的下一个想法是使用 includeMarkdown关于这个.md文件，但经过一番尝试和错误后，我发现无论出于何种原因，来自 .md 的翻译-> .html (这就是 includeMarkdown 的幕后发生的事情)不起作用，并且 markdown token ![plot](path/to/figure)根据 <img> 从未正确翻译为 teh标签。当我尝试使用 knit2html 时，发生了同样的情况。两者都依赖markdown::renderMarkdown并且此函数根本不会将 Markdown 图像标记转换为 HTML 图像标记如果嵌套在表格中。
• 研究独立版 rmarkdown文档，我看到他们使用 pandoc翻译 markdown文档发送至HTML格式。
• 经过更多的尝试和错误，我可以说服 pandoc产生结果:
  • 我添加了一些pandoc配置进入table.Rmd 。但是，由于这些无论如何都是默认值，您也可以安全地忽略它们。如果你想做一些更奇特的东西，你将需要他们调整方式 pandoc被称为。
  • shiny期望静态资源托管在www下文件夹。因此我们需要告诉knit使用此文件夹来存储数字(另一个选项是在 addResourcePath 一侧使用 shiny)。

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不喜欢表中的 block

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

---

更新

根据评论，如果您想确保 block 中生成的文件名是“唯一的”，您可以在 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)
   }
)

```