在Rmarkdown中,可以创建标签,例如:
---
output: html_document
---
# Tabs {.tabset}
## Tab 1
foo
## Tab 2
bar
我想知道是否可以创建任意数量的标签?如何以编程方式创建选项卡?
以下代码执行此操作的尝试很差,但它会生成标题而不是标签。
---
output: html_document
---
# Tabs {.tabset}
```{r echo=FALSE}
shiny::tags$h2("Tab 1")
```
foo
## Tab 2
bar
感谢@GGamba提供了一个很好的解决方案。我需要更进一步,并能够添加选项卡作为循环的一部分,所以我需要做两个更改。首先,我使用此代码动态添加选项卡(这里唯一的区别是我强制在超时内部评估hrefCode
,因为否则所有超时调用将使用相同的值)
(function(hrefCode){setTimeout(function(){
var tabContent = document.createElement('div');
var tabContainerTarget = document.getElementsByClassName('tab-content')[0];
tabContent.setAttribute('id', 'tab-' + hrefCode);
tabContent.setAttribute('class', 'tab-pane')
tabContent.innerHTML = '", gsub('\n', '', Panel, fixed = TRUE), "';
tabContainerTarget.appendChild(tabContent);
}, 100);
})(hrefCode);
其次,要在循环中添加制表符,您可以执行以下操作:
tabsToAdd <- list("tab3" = "hello", "tab4" = "world")
shiny::tagList(lapply(names(tabsToAdd), function(x) {
addToTabset(title = x, tabsetId = 'tbSet1',
tabPanel(x, tabsToAdd[[x]]))
}))
答案 0 :(得分:2)
据我所知,你想要做的事情在rmarkdown中是不可能的(但我很乐意纠正)。但是我们当然可以实现一个功能来做到这一点。
我的回答是基于this来自@KRohde的答案,所以所有的积分归他所有。我只是将它改编成了一个更简单的降价文档。
答案主要是使用JS
而不是R
构建的,但由于降价主要是HTML
,我认为JS
是更好的工具。
以下是代码:
---
output: html_document
---
```{r echo=FALSE, results='asis'}
library(shiny)
addToTabset <- function(title, tabsetId, Panel) {
tags$script(HTML(paste0("
/* Getting the right tabsetPanel */
var tabsetTarget = document.getElementById('", tabsetId, "');
/* Creating 6-digit tab ID and check, whether it was already assigned. */
hrefCode = Math.floor(Math.random()*100000);
/* Creating node in the navigation bar */
var navNode = document.createElement('li');
var linkNode = document.createElement('a');
linkNode.appendChild(document.createTextNode('", title, "'));
linkNode.setAttribute('data-toggle', 'tab');
linkNode.setAttribute('data-value', '", title, "');
linkNode.setAttribute('href', '#tab-' + hrefCode);
navNode.appendChild(linkNode);
tabsetTarget.appendChild(navNode);
setTimeout(function(){
var tabContent = document.createElement('div');
var tabContainerTarget = document.getElementsByClassName('tab-content')[0];
tabContent.setAttribute('id', 'tab-' + hrefCode);
tabContent.setAttribute('class', 'tab-pane')
tabContent.innerHTML = '", gsub('\n', '', Panel, fixed = T), "';
tabContainerTarget.appendChild(tabContent);
}, 100);
")
))
}
```
上面的代码应该保留在'setup chunk'中,因为它定义了一个R
函数来调用JS
函数,该函数主要只是向DOM添加正确的东西。
然后可以在需要时使用它,传递tabPanel
标题,'目标'tabset
和普通tabPanel
函数。
```{r results='asis', echo=FALSE}
shiny::tabsetPanel(id = 'tbSet1',
shiny::tabPanel('Tab 1', 'foo'),
shiny::tabPanel('Tab 2', 'bar')
)
```
```{r results='asis', echo=FALSE}
addToTabset(title = 'Tab 3',
tabsetId = 'tbSet1',
tabPanel(
h1('This is a title'),
actionButton('btn',label = 'Clicky button'),
radioButtons('asd', LETTERS[1:5], LETTERS[1:5])) )
```
答案 1 :(得分:0)
对于此问题,还有一个简单的rmarkdown解决方案,不需要闪亮的和/或自定义的javascript:
## Tabbed Example {.tabset}
```{r, results = 'asis'}
for (nm in unique(iris$Species)){
cat("### ", nm, "\n")
cat(knitr::knit_print(plot(iris[iris$Species == nm, ])))
cat("\n")
}
```
答案 2 :(得分:0)
这似乎也是处理 https://github.com/ropensci/plotly/issues/273 处带有绘图图形的动态标签集问题的好方法
我首先创建了这些图并将它们保存在一个列表中,然后我将其提取出来并在下面的模板变量中使用简单的代码进行显示。这使我不必在模板文件中用引号将大代码括起来。
但是,如果我在同一个文档中第二次尝试这个技巧,它会抱怨“重复的块标签“unnamed-chunk-1”......错误并且不会编译。
通过指定选项(knitr.duplicate.label = "allow") 这似乎是“可修复的”,但是否有任何“后果”允许我需要注意的重复标签?我读了 https://bookdown.org/yihui/rmarkdown-cookbook/duplicate-label.html 并且我认为我没问题,但有没有比允许重复块标签更好的方法?
---
title: "Tabsets for plotly graphs"
output:
html_document:
number_sections: yes
toc: yes
toc_depth: 4
---
## Tabbed Set 1 {.tabset}
```{r}
options(knitr.duplicate.label = "allow")
library(plotly)
plotlist <- plyr::dlply(iris, "Species", function(iris.part){
plot_ly(data=iris.part, x = ~Sepal.Length, y = ~Sepal.Width)
})
template <- c(
"### First {{nm}}\n",
"```{r, echo = FALSE}\n",
"plotlist[[{{nm}}]] \n",
"```\n",
"\n"
)
plots <- lapply(1:length(plotlist), function(nm) {knitr::knit_expand(text = template)})
```
`r knitr::knit(text = unlist(plots))`
## Tabbed set 2 {.tabset}
```{r}
library(plotly)
template <- c(
"### Second {{nm}}\n",
"```{r, echo = FALSE}\n",
"plotlist[[{{nm}}]] \n",
"```\n",
"\n"
)
plots <- lapply(1:length(plotlist), function(nm) {knitr::knit_expand(text = template)})
```
`r knitr::knit(text = unlist(plots))`