Search code examples
rdynamicshinynavbartabpanel

R Shiny: Dynamically creating tabs with output within navbarPage()


I am trying to create an app using navbarPage() (or something similar) where you choose certain inputs in the sidebar, and when you click on a button it will show the results in a separate tab. I created an example, using the script of K.Rohde below (note that I left his original comments in my script).

In this example, you choose 4 letters in the sidebar and if you click on the button, it dynamically creates a separate tab with text output. When I use fluidPage() it works perfectly, but I want to use navbarPage() or something similar, since my final script includes more pages.

When I use navbarPage(), the script doesn't work anymore:

  • When you click on a tab you dynamically created, the output of that tab opens in a blank page instead of in the tab itself.

I tried fixing it by playing around with tabsetPanel() and tabPanel in the ui and server, but this didn't work. SBista thought that navbarPage() seems to mess up the Javascript functionality, as mentioned in my previous post.

I'd appreciate any help!

ui:

ui <- navbarPage("Shiny",

  # 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

  tabPanel("Statistics"),

  tabPanel("Summary",
    sidebarLayout(
      sidebarPanel(width = 4,
                 selectInput(inputId = "choice_1", label = "First choice:",
                             choices = LETTERS, selected = "H", multiple = FALSE),
                 selectInput(inputId = "choice_2", label = "Second choice:",
                             choices = LETTERS, selected = "E", multiple = FALSE),
                 selectInput(inputId = "choice_3", label = "Third choice:",
                             choices = LETTERS, selected = "L", multiple = FALSE),
                 selectInput(inputId = "choice_4", label = "Fourth choice:",
                             choices = LETTERS, selected = "P", multiple = FALSE),
                 actionButton("goCreate", "Go create a new Tab!")
    ), 
    mainPanel(
      tabsetPanel(id = "mainTabset",
                  tabPanel("InitialPanel1", "Some text here to show this is InitialPanel1",
                           textOutput("creationInfo"),
                           # Important! : 'Freshly baked' tabs first enter here.
                           uiOutput("creationPool", style = "display: none;")
                           # End Important
                  )
      )
    )
    )
  )
)

Server:

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 

  output$creationInfo <- renderText({
    paste0("The next tab will be named: Results ", input$goCreate + 1)
  })

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

    newTabPanels <- list(
      tabPanel(paste0("NewTab ", nr),

               htmlOutput(paste0("Html_text", nr)),
               actionButton(paste0("Button", nr), "Some new button!"), 
               textOutput(paste0("Text", nr))
      )
    )

    output[[paste0("Html_text", nr)]] <- renderText({
        paste("<strong>", "Summary:", "</strong>", "<br>",
              "You chose the following letters:", isolate(input$choice_1), isolate(input$choice_2), isolate(input$choice_3), isolate(input$choice_4), "." ,"<br>",
              "Thank you for helping me!")
    })

    addTabToTabset(newTabPanels, "mainTabset")
  })
}

Solution

  • As I mentioned in the comment of answer there seems to be some problem with the javascript finctionality, after further refering to the HTML structure I figured out that for navbarPage there are two tab-contents. Due to this the javascript was failing so slightly changing the javascript functionality actually seems to work.

    You just need to change
    var tabContainerTarget = document.getElementsByClassName('tab-content')[0]; to

    var tabContainerTarget = document.getElementsByClassName('tab-content')[1];

    So your code should work if your ui is changed with the new javascript as follows:

    ui <- navbarPage("Shiny",
    
                     # 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')[1];
    
                                                /* 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
    
                     tabPanel("Statistics"),
    
                     tabPanel("Summary",
                              sidebarLayout(
                                sidebarPanel(width = 4,
                                             selectInput(inputId = "choice_1", label = "First choice:",
                                                         choices = LETTERS, selected = "H", multiple = FALSE),
                                             selectInput(inputId = "choice_2", label = "Second choice:",
                                                         choices = LETTERS, selected = "E", multiple = FALSE),
                                             selectInput(inputId = "choice_3", label = "Third choice:",
                                                         choices = LETTERS, selected = "L", multiple = FALSE),
                                             selectInput(inputId = "choice_4", label = "Fourth choice:",
                                                         choices = LETTERS, selected = "P", multiple = FALSE),
                                             actionButton("goCreate", "Go create a new Tab!")
                                ), 
                                mainPanel(
                                  tabsetPanel(id = "mainTabset",
                                              tabPanel("InitialPanel1", "Some text here to show this is InitialPanel1",
                                                       textOutput("creationInfo"),
                                                       # Important! : 'Freshly baked' tabs first enter here.
                                                       uiOutput("creationPool", style = "display: none;")
                                                       # End Important
                                              )
                                  )
                                )
                              )
                     )
                     )