7

I would like to create dynamic tabs, where each time the user clicks a button, a new tab would be created. Each tab has the same content, with a variety of widgets that the user can use to select which sets of data to be plotted.

Currently, I am using the solution here to dynamically create my tabs, but with the change that lapply is calling a function that calls tabPanel and adds content to the tabs

`

renderUI({
some_data <- # Dataframe that data is extracted goes here
createTabs <- function(tabNum, some_data)
    {
      tabPanel(title = paste("Map", tabNum, sep=" "), 
               fluidRow(
                 column(
                   width = 3,
                   wellPanel(
                     #widgets are added here
    }
 mTabs <- lapply(0:input$map, createTabs, some_data)
 do.call(tabsetPanel, mTabs)
})

`

And the methods of for loops posted here to create the plots on each tab.

However, it seems like instead of creating a new tab, the 2 solutions above both re-create all the existing tabs. So if there are currently 10 tabs open, all 10 tabs get re-created. Unfortunately, this also resets all the user settings on each tab (in addition to slowing down the app), and extra provisions must be taken as shown here , which further slows down the app because of the large number of input objects that must be created.

I saw a solution for menu items that seems to solve this problem by simply storing all the menu items in a list, and each time a new menu item is generated, it is simply added to the list so that all the other existing items don't need to be created. Is something like this possible for tabs and rendering plots as well?

This is the code:

 newTabs <- renderMenu({
    menu_list <- list(
      menu_vals$menu_list)
    sidebarMenu(.list = menu_list)
  })

  menu_vals = reactiveValues(menu_list = NULL)
  observeEvent(eventExpr = input$placeholder,
               handlerExpr = {
                 menu_vals$menu_list[[input$placeholder]] <- menuSubItem(paste("Saved Simulation", length(menu_vals$menu_list) + 1, sep = " "),
                                                                                    tabName = paste("saved_sim", length(menu_vals$menu_list) + 1)) 
               })

If someone can explain to me what menu_list <- list(menu_vals$menu_list) is doing , why Rstudio says it must be inside a reactive expression, and why a new list called menu_vals is created with menu_list = null, it would be greatly appreciated as well :)

Edit: I think I was able to prevent the plots from being re-created each time a new tab is created and also bypass the need for a max number of plots using

observeEvent(eventExpr = input$map,
                 handlerExpr = {
                   output[[paste0("outputComparePlot",simNum,"-",input$map)]] <- outputComparePlot(sessionEnv, config, react, input, simNum, input$map) #This function contains the call to renderPlot

                 })

However, I still cannot figure out how to use this for creating tabs. I tried the same method but it didnt work.

Phil
  • 7,287
  • 3
  • 36
  • 66
ruisen
  • 305
  • 3
  • 11
  • so the menu_list in reactiveValues is related to the one in renderMenu? What about the menu_list in menu_vals$menu_list? Did they simply choose the same name, or are they declaring a list inside itself? – ruisen Jan 27 '16 at 17:29

2 Answers2

16

I would like to present a solution that adds a feature to shiny which should have been implemented into shiny base long ago. A function to append tabPanels to existing tabsetPanels. I already tried similar stuff here and here, but this time, I feel like this solution is way more stable and versatile.

For this feature, you need to insert 4 parts of code into your shiny app. Then you can add any set of tabPanels each having any content to an existing tabsetPanel by calling addTabToTabset. Its arguments are a tabPanel (or a list of tabPanels) and the name (id) of your target tabsetPanel. It even works for navbarPage, if you just want to add normal tabPanels.

The code which should be copy-pasted, is inside the "Important!" comments.

My comments will probably not be enough to grasp what's really happening (and why, of course). So if you want to get more into detail, please leave a message and I will try to elaborate.

Copy-Paste-Run-Play!

library(shiny)

ui <- shinyUI(fluidPage(

  # Important! : JavaScript functionality to add the Tabs
  tags$head(tags$script(HTML("
    /* In coherence with the original Shiny way, tab names are created with random numbers. 
       To avoid duplicate IDs, we collect all generated IDs.  */
    var hrefCollection = [];

    Shiny.addCustomMessageHandler('addTabToTabset', function(message){
      var hrefCodes = [];
      /* Getting the right tabsetPanel */
      var tabsetTarget = document.getElementById(message.tabsetName);

      /* Iterating through all Panel elements */
      for(var i = 0; i < message.titles.length; i++){
        /* Creating 6-digit tab ID and check, whether it was already assigned. */
        do {
          hrefCodes[i] = Math.floor(Math.random()*100000);
        } 
        while(hrefCollection.indexOf(hrefCodes[i]) != -1);
        hrefCollection = hrefCollection.concat(hrefCodes[i]);

        /* Creating node in the navigation bar */
        var navNode = document.createElement('li');
        var linkNode = document.createElement('a');

        linkNode.appendChild(document.createTextNode(message.titles[i]));
        linkNode.setAttribute('data-toggle', 'tab');
        linkNode.setAttribute('data-value', message.titles[i]);
        linkNode.setAttribute('href', '#tab-' + hrefCodes[i]);

        navNode.appendChild(linkNode);
        tabsetTarget.appendChild(navNode);
      };

      /* Move the tabs content to where they are normally stored. Using timeout, because
         it can take some 20-50 millis until the elements are created. */ 
      setTimeout(function(){
        var creationPool = document.getElementById('creationPool').childNodes;
        var tabContainerTarget = document.getElementsByClassName('tab-content')[0];

        /* Again iterate through all Panels. */
        for(var i = 0; i < creationPool.length; i++){
          var tabContent = creationPool[i];
          tabContent.setAttribute('id', 'tab-' + hrefCodes[i]);

          tabContainerTarget.appendChild(tabContent);
        };
      }, 100);
    });
    "))),
  # End Important

  tabsetPanel(id = "mainTabset", 
    tabPanel("InitialPanel1", "Some Text here to show this is InitialPanel1", 
      actionButton("goCreate", "Go create a new Tab!"),
      textOutput("creationInfo")
    ),
    tabPanel("InitialPanel2", "Some Text here to show this is InitialPanel2 and not some other Panel")
  ),

  # Important! : 'Freshly baked' tabs first enter here.
  uiOutput("creationPool", style = "display: none;")
  # End Important

  ))

server <- function(input, output, session){

  # Important! : creationPool should be hidden to avoid elements flashing before they are moved.
  #              But hidden elements are ignored by shiny, unless this option below is set.
  output$creationPool <- renderUI({})
  outputOptions(output, "creationPool", suspendWhenHidden = FALSE)
  # End Important

  # Important! : This is the make-easy wrapper for adding new tabPanels.
  addTabToTabset <- function(Panels, tabsetName){
    titles <- lapply(Panels, function(Panel){return(Panel$attribs$title)})
    Panels <- lapply(Panels, function(Panel){Panel$attribs$title <- NULL; return(Panel)})

    output$creationPool <- renderUI({Panels})
    session$sendCustomMessage(type = "addTabToTabset", message = list(titles = titles, tabsetName = tabsetName))
  }
  # End Important 

  # From here: Just for demonstration
  output$creationInfo <- renderText({
    paste0("The next tab will be named NewTab", input$goCreate + 1)
  })

  observeEvent(input$goCreate, {
    nr <- input$goCreate

    newTabPanels <- list(
      tabPanel(paste0("NewTab", nr), 
        actionButton(paste0("Button", nr), "Some new button!"), 
        textOutput(paste0("Text", nr))
      ), 
      tabPanel(paste0("AlsoNewTab", nr), sliderInput(paste0("Slider", nr), label = NULL, min = 0, max = 1, value = 1))
    )

    output[[paste0("Text", nr)]] <- renderText({
      if(input[[paste0("Button", nr)]] == 0){
        "Try pushing this button!"
      } else {
        paste("Button number", nr , "works!")
      }
    })

    addTabToTabset(newTabPanels, "mainTabset")
  })
}

shinyApp(ui, server)
Community
  • 1
  • 1
K. Rohde
  • 9,439
  • 1
  • 31
  • 51
  • Very nice, thanks for sharing the code! Is there a way to clear all the newTabPanels? – Jorge Sepulveda Feb 06 '17 at 17:23
  • @JorgeSepulveda The newly created tabPanels are not different to the ones you draw on initial program start in the shinyUI. So you're asking, if tabPanels **in general** can be dynamically deleted? – K. Rohde Feb 08 '17 at 07:23
  • @k-rohde I was asking if there is a way to make the "creationPool" panels disappear (or be replaced with new ones, based on an input list). I tried `removeUI('creationPool')` but it does not work. Making `newTabPanels <- NULL` and running `addTabToTabset(newTabPanels, "mainTabset")` does not do it either. Thanks for your help! – Jorge Sepulveda Feb 08 '17 at 16:47
  • @JorgeSepulveda The creationPool is not where the elements are or neither is it one of the elements. The process is: 1) create element in creationPool, 2) remove element from creation pool and move it to the tabPanels. After this process is done, there is nothing left in the creationPool. What you want to do is, you want to delete the tabPanel itself. This question is something way more general, because it would need to work on all possible tabPanels. It involves removing the tabPanel, the navigation link and possibly destroying all observers linked to the tab. – K. Rohde Feb 08 '17 at 18:17
  • Thanks very much for the code. Can you submit it as a pull request to the Shiny repo? https://github.com/rstudio/shiny/pulls – Florian Bw Jun 15 '17 at 20:20
12

Probably thanks to @k-rohde, there's now natively available in Shiny a set of methods to add/remove/append tabs in a tabset:

library(shiny)
runApp(list(
  ui=fluidPage(
    fluidRow(
      actionLink("newTab", "Append tab"),
      actionLink("removeTab", "Remove current tab")
    ),
    tabsetPanel(id="myTabs", type="pills")
  ),
  server=function(input, output, session){
    tabIndex <- reactiveVal(0)
    observeEvent(input$newTab, {
      tabIndex(tabIndex() + 1)
      appendTab("myTabs", tabPanel(tabIndex(), tags$p(paste("I'm tab", tabIndex()))), select=TRUE)
    })
    observeEvent(input$removeTab, {
      removeTab("myTabs", target=input$myTabs)
    })
  }
))
ssayols
  • 790
  • 6
  • 10