geotheory
geotheory

Reputation: 23630

R Shiny: code output inside markdown table cell

I'm trying to embed R lot output inside the cells of an html table. This is as far as I've got:

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>

This outputs as follows: enter image description here

knit is outputting the graphics to file. Is there a way to get them to render directly instead? I may be going about this wrong but have not identified an equivalent {rmarkdown} workflow..


As a related point when testing with the message(...) output instead of qplot the html table cell looks like this:

``` ## setosa ```

Any idea how to remove the backticks and hash symbols?

Upvotes: 2

Views: 203

Answers (1)

thothal
thothal

Reputation: 20329

A working toolchain is as follows:

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)

Then you can run runApp("app.R") and you get the following output:

RMD in Shiny

Some remarks

This was trickier than I thought and I am by no means a pandoc/knit/markdown expert, so not even sure whether I get the nomenclature right, but I can share what I found out:

  • I changed your table.html into a table.Rmd, because, well, it is in fact an RMarkdown and not a (pure) HTML file. If we want (as in my example) work with file names rather than readLines this is also necessary to help knit to use the right delimiter tokens.
  • I ran knit("table.Rmd") to see how the markdown document looked like and it seemed to be OK.
  • My next thought was to use includeMarkdown on this .md file but after some trial and error, I found out that for whatever reason the translation from .md -> .html (that's what happens under the hood for includeMarkdown) did not work and the markdown token ![plot](path/to/figure) was never properly translated to teh according <img> tag. The same happened when I tried to use knit2html. Both rely on markdown::renderMarkdown and this function simply does not translate the markdown image token to an HTML image token if nested in a table.
  • Looking into standalone rmarkdown docs, I see that they make use of pandoc to translate the markdown document to an HTML format.
  • After some more trial and error I could convince pandoc to produce the results:
    • I added some pandoc configuration into the table.Rmd. However, since these are anyways the defaults you can also safely ignore them. If you want to do some more fancy stuff, you will need them to tweak the way pandoc is called.
    • shiny expects static resources to be hosted under the www folder. Thus we need to tell knit to use this folder to store the figures (another option would be to use addResourcePath on the shiny side).

TL;DR

The following toolchain will work:

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

or equiavlently

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

renderMarkdown does not like chunks in a 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))


Update

As per the comments, if you want to ensure that the file names generated in teh chunks are "unique" you can use the following code chunk in your Rmd (inspired by 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)
   }
)

```

Upvotes: 2

Related Questions