Dynamically loop through htmlwidgets and add knitr formatting for RMarkdown

问题

I am trying to dynamically create and loop through htmlwidgets such as DT, plotly, or rbokeh to generate an automated knitr report. Is there a way to add knitr formatting, such as the tabset, into the tagList approach outlined in this github question https://github.com/ramnathv/htmlwidgets/pull/110? I have also posted this question there.

Below is some example code of what I am thinking, but it does not quite work. What I am trying to do is create 10 tabs, each with a copy of the plot generated from plot_list. What happens right now is all of the plots go into the last tab. In practice, plot_list would have different plots/tables.

#' ---
#' title: htmltools::tagList test
#' output:
#'    html_document
#' ---

#' # {.tabset}
#+ results='asis', echo=FALSE
library(plotly)
library(printr)

plot_list = lapply(1:10, 
                   function(i){ 
                     as.widget(plot_ly(iris, 
                                       x = iris[["Sepal.Length"]],
                                       y = iris[["Sepal.Width"]], 
                                       mode = "markers")) 
                    } 
                  )

htmltools::tagList( lapply(1:10, 
                            function(i) {
                              pandoc.header(paste0("Tab",i,' {.tabset}'), 2)
                              plot_list[[i]]
                            } 
                          )
                   )

# rmarkdown::render("your_path/htmltoolsTagList_test.r")

Before, I was successfully doing something like this with nested for-loops, but once I tried using figures with HTML dependencies, the figures of course do not render as they are no longer top level expressions. Is it possible in knitr to loop like this?

A follow up question I have is: suppose I wanted to nest these tabs into another set of tabs created the same way, is that possible? What I mean to ask is, can I nest tabs dynamically using a method like this, analogous to a nested for-loop?

I am still learning how to use knitr, and would appreciate any help! Thank you!

回答1:

I'll copy my response to the Github issue below.

Good question, and I think others will be helped by this discussion. It might be easiest to start by building something like what you propose from scratch without the aid of rmarkdown.

manually build

# https://github.com/ramnathv/htmlwidgets/pull/110#issuecomment-216562703

library(plotly)
library(htmltools)
library(markdown)
library(shiny)

browsable(
  attachDependencies(
    tagList(
      tags$div(
        class="tabs",
        tags$ul(
          class="nav nav-tabs",
          role="tablist",
          tags$li(
            tags$a(
              "data-toggle"="tab",
              href="#tab-1",
              "Iris"
            )
          ),
          tags$li(
            tags$a(
              "data-toggle"="tab",
              href="#tab-2",
              "Cars"
            )
          )
        ),
        tags$div(
          class="tab-content",
          tags$div(
            class="tab-pane active",
            id="tab-1",
            as.widget(
              plot_ly(
                iris,
                x = iris[["Sepal.Length"]],
                y = iris[["Sepal.Width"]], 
                mode = "markers"
              )
            )
          ),
          tags$div(
            class="tab-pane",
            id="tab-2",
            as.widget(
              plot_ly(
                cars,
                x = speed,
                y = dist, 
                mode = "markers"
              )
            )
          )
        )
      )
    ),
    # attach dependencies
    #  see https://github.com/rstudio/rmarkdown/blob/master/R/html_document.R#L235
    list(
      rmarkdown::html_dependency_jquery(),
      shiny::bootstrapLib()
    )
  )
)

in rmarkdown

There is probably a better way to make this work, but until someone sets me straight, we can take the approach from above and use it in rmarkdown. Unfortunately, this is still very manual. For more reference, here is the code that RStudio uses to build tabsets.

---
title: "tabs and htmlwidgets"
author: "Kent Russell"
date: "May 3, 2016"
output: html_document
---

```{r echo=FALSE, message=FALSE, warning=FALSE}
library(plotly)
library(htmltools)
library(magrittr)

# make a named list of plots for demonstration
#  the names will be the titles for the tabs
plots <- list(
  "iris" = plot_ly(
    iris,
    x = iris[["Sepal.Length"]],
    y = iris[["Sepal.Width"]], 
    mode = "markers"
  ),
  "cars" = plot_ly(
    cars,
    x = speed,
    y = dist, 
    mode = "markers"
  )
)

# create our top-level div for our tabs
tags$div(
  # create the tabs with titles as a ul with li/a
  tags$ul(
    class="nav nav-tabs",
    role="tablist",
    lapply(
      names(plots),
      function(p){
        tags$li(
          tags$a(
            "data-toggle"="tab",
            href=paste0("#tab-",p),
            p
          )
        )
      }
    )
  ),
  # fill the tabs with our plotly plots
  tags$div(
    class="tab-content",
    lapply(
      names(plots),
      function(p){
         tags$div(
          #  make the first tabpane active
          class=ifelse(p==names(plots)[1],"tab-pane active","tab-pane"),
          #  id will need to match the id provided to the a href above
          id=paste0("tab-",p),
          as.widget(plots[[p]])
        )
      }
    )
  )
) %>%
  # attach the necessary dependencies
  #  since we are manually doing what rmarkdown magically does for us
  attachDependencies(
    list(
      rmarkdown::html_dependency_jquery(),
      shiny::bootstrapLib()
    )
  )
```

来源：https://stackoverflow.com/questions/37008600/dynamically-loop-through-htmlwidgets-and-add-knitr-formatting-for-rmarkdown

标签

knitr

r-markdown

htmlwidgets