Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Dynamically creating tabs with plots in shiny without re-creating existing tabs

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.

like image 720
ruisen Avatar asked Jan 26 '16 18:01

ruisen


2 Answers

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)
like image 60
K. Rohde Avatar answered Nov 15 '22 10:11

K. Rohde


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)
    })
  }
))
like image 41
ssayols Avatar answered Nov 15 '22 09:11

ssayols