动态循环 htmlwidgets 并为 RMarkdown 添加 knit 格式

vry*_*ryb 3 r knitr r-markdown htmlwidgets

我正在尝试动态创建和循环,htmlwidgets例如DTplotly、 或rbokeh生成自动针织报告。有没有办法将knitr格式(例如 )添加到此 github 问题https://github.com/ramnathv/htmlwidgets/pull/110tabset中概述的方法中?我也在那里发布了这个问题。tagList

下面是我的想法的一些示例代码,但它不太有效。我想做的是创建 10 个选项卡,每个选项卡都有一个从plot_list. 现在发生的事情是所有绘图都进入最后一个选项卡。在实践中,plot_list会有不同的图/表。

#' ---
#' 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")
Run Code Online (Sandbox Code Playgroud)

之前,我使用嵌套 for 循环成功地完成了类似的操作,但是一旦我尝试使用具有 HTML 依赖项的数字,这些数字当然不会呈现,因为它们不再是顶级表达式。可以knitr这样循环吗?

我的后续问题是:假设我想将这些选项卡嵌套到以相同方式创建的另一组选项卡中,这可能吗?我的意思是问,我可以使用类似嵌套 for 循环的方法动态嵌套选项卡吗?

我仍在学习如何使用knitr,非常感谢任何帮助!谢谢你!

tim*_*lio 5

我将复制我对下面 Github 问题的回复。

好问题,我认为这次讨论会对其他人有所帮助。最简单的方法可能是从头开始构建类似您提议的内容,而无需借助rmarkdown.

手动构建

# 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()
    )
  )
)
Run Code Online (Sandbox Code Playgroud)

在 rmarkdown 中

可能有更好的方法来完成这项工作,但是在有人纠正我之前,我们可以采用上面的方法并将其用于rmarkdown. 不幸的是,这仍然是非常手动的。如需更多参考,这里是RStudio用于构建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()
    )
  )
```
Run Code Online (Sandbox Code Playgroud)