8

In Rmarkdown, it's possible to create tabs, for example:

---
output: html_document
---

# Tabs {.tabset}

## Tab 1

foo

## Tab 2

bar

I'm wondering if it's possible to create an arbitrary number of tags? How can I create a tab programatically?

The following code is a poor attempt to do this, but it results in a heading instead of a tab.

---
output: html_document
---

# Tabs {.tabset}

```{r echo=FALSE}
shiny::tags$h2("Tab 1")
```

foo

## Tab 2

bar

Solution

Thanks to @GGamba for providing a great solution. I needed to go one step further and be able to add tabs as part of a loop, so I needed to make two changes. First of all, I used this code to dynamically add tabs (the only difference here is that I force the evaluation of hrefCode inside the timeout because otherwise all timeouts called together will use the same value)

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

Secondly, to add tabs in a loop, you can do something like this:

tabsToAdd <- list("tab3" = "hello", "tab4" = "world")

shiny::tagList(lapply(names(tabsToAdd), function(x) {
  addToTabset(title = x, tabsetId = 'tbSet1',
              tabPanel(x, tabsToAdd[[x]]))
}))
DeanAttali
  • 25,268
  • 10
  • 92
  • 118

3 Answers3

11

There is also a simple rmarkdown solution to this problem that does not require shiny and/or custom javascript. Does not work for all kinds of R output (see below):

## 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")
}
```

A more involved method, that first creates a list of raw Rmarkdown code as a list of character vectors, which are then evaluated in a separate (inline) code chunk with knitr::knit(). This works for all kinds of output, not just base plots.

## Tabbed Example ggplot {.tabset}

```{r}
library(ggplot2)

template <- c(
    "### {{nm}}\n",
    "```{r, echo = FALSE}\n",
    "ggplot(iris[iris$Species == '{{nm}}', ], aes(x = Sepal.Length, y = Sepal.Width)) + geom_point()\n",
    "```\n",
    "\n"
  )

plots <- lapply(
  unique(iris$Species), 
  function(nm) knitr::knit_expand(text = template)
)
```

`r knitr::knit(text = unlist(plots))`
Stefan F
  • 2,573
  • 1
  • 17
  • 19
  • any idea how this could work with ggplot instead of base plotting? It tells me that `list` arguments (i.e. a ggplot object) cannot be handled by `cat`, if I replace your iris plot with one made with ggplot. – moman822 Jan 09 '20 at 20:10
  • 1
    See my edit, this should work for all output types :) it's a bit uglier though – Stefan F Jan 09 '20 at 20:59
  • really helpful, thanks. I was figuring there must be a way to output the literal code chunks and this is a good option. To make it a bit easier to read, I'm creating a wrapper function for my ggplot call (w/ all the extra stuff) which I'm then passing through the template call. – moman822 Jan 09 '20 at 21:56
  • the second approach should work for all kinds of outputs, including html widgets produced by `plotly::ggplotly()` – Stefan F May 23 '20 at 16:49
  • This is brilliant! thanks. I particularly like the first example because since it requires the least amount of ambiguity. FYI also, I was even able to nest the tabs with this technique. Many thanks! – Ahdee Jul 06 '20 at 00:26
  • This helps me a lot!! Thank you~ – KY Lu Jul 07 '21 at 17:04
5

As far as I know what you are trying to do is not possible in rmarkdown (but I'd love to stand corrected). But of course we can implement a function to do just that.

I based my answer on this answer by @KRohde, so all the credits goes to him. I just adapted it to work in a simpler markdown document.

The answer is mostly build with JS rather than R, but as the markdown is mostly an HTML I feel JS is a better tool.

Here is the code:

---
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);
                   ")
  ))
}

```

The code above should stay in a 'setup chunk', as it define an R function to call a JS function that mostly just add the right things to the DOM.

It can then be used when needed, passing the tabPanel title, the 'target' tabset and the normal tabPanel function.

```{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])) )

```
Community
  • 1
  • 1
GGamba
  • 13,140
  • 3
  • 38
  • 47
  • If shiny can't do it natively, that's a great workaround. Do you also have a solution for doing this in a loop, eg. `lapply(letters, function(letter) addToTabset(letter, 'tbSet1', tabPanel(letter, letter)))` ? I'm not great at advanced Rmd and how to get html to render properly – DeanAttali Mar 07 '17 at 08:21
  • Figured it out. Had to wrap the loop in a `tagList()`, and also needed a small fix in the javascript (see the question itself for my modified code) – DeanAttali Mar 08 '17 at 07:24
  • This is not working as of today, is it possible to update it, like create a Rmd that runs ? – statquant Aug 25 '21 at 11:51
0

This also appears to be a good way to also deal with the problem of dynamic tabsets with plotly graphics at https://github.com/ropensci/plotly/issues/273

I created the plots first and saved them in a list which I then extract and display with a simple code in the template variable below. This saves me from having to enclose the large code in quotes in the template file.

However, if I try this trick a second time in the same document, it complains with a "duplicate chunk label "unnamed-chunk-1"... error and will not compile.

This appears to be "fixable" by specifying options(knitr.duplicate.label = "allow") but are there any "consequences" to allowing duplicate labels that I need to be aware of? I read https://bookdown.org/yihui/rmarkdown-cookbook/duplicate-label.html and I think I'm ok but is there a better way than allowing duplicate chunk labels?

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