tab dependent input for shiny dashboard

Question

I am facing an issue with shiny dashboard. I am trying to create a simple dashboard with two tabItems on the left. Each tabItem have their specific set of controls and a plot. But I am probably missing something on the server side to link the input to the tab because the controls of the second tab is behaving strangely. Any help would be much appreciated. Here is my code

library(shiny)
library(shinydashboard)
library(data.table)
library(ggplot2)
data = data.table(group = rep(c(1, 3, 6), each = 10), x = rep(1:10, times = 3), value = rnorm(30))

sidebar <- dashboardSidebar(
  sidebarMenu(id = 'sidebarMenu',
    menuItem("tab 1", tabName = "tab1", icon = icon("dashboard")),
    menuItem("tab 2", icon = icon("th"), tabName = "tab2")
  )
)

body <- dashboardBody(
          tabItems(
            tabItem(tabName = "tab1",
              fluidRow(
                box(title = "Controls",
                    checkboxGroupInput('group', 'group:', c(1, 3, 6), selected = 6, inline = TRUE), width = 4),
                box(plotOutput("plot1"), width = 8)
             )
           ),

          tabItem(tabName = "tab2",
             fluidRow(
               box(title = "Controls",
                   checkboxGroupInput('group', 'group:', c(1, 3, 6), selected = 6, inline = TRUE), width = 4),
               box(plotOutput("plot2"), width = 8)
             )
          )
       )
    )

 # Put them together into a dashboardPage
 ui <- dashboardPage(
 dashboardHeader(title = "test tabbed inputs"),
 sidebar,
 body,
 skin = 'green'
 )

server <- function(input, output) {
   output$plot1 <- renderPlot({
   plotData <- data[group %in% input$group]
   p <- ggplot(plotData, aes(x = x, y = value, colour = factor(group))) + geom_line() + geom_point()
   print(p)
   })
   output$plot2 <- renderPlot({
   plotData <- data[group %in% input$group]
   p <- ggplot(plotData, aes(x = x, y = value, colour = factor(group))) + geom_line() + geom_point()
   print(p)
   })
}

shinyApp(ui, server)

When I change input in the first tab it also changes in the second and then when I try to change it back often time nothing happens or it just behaves weirdly. I think I need to specify tie the input to the tabItems somehow but could not find a good example of doing that. Any help would be much appreciated.

Thanks, Ashin

Have you tried just calling the checkboxGroupInput calls different names and then just replicating the code in server.R twice so there isn't confusion about which variable you're manipulating? — Colin Robinson
Yes that is what I ended up doing which solved the problem. But in my actual problem I have multiple inputs per tab so renaming every time seemed is going to be a little cumbersome. Was hoping to see if there is some other solutions that I am missing out on. — Ashin Mukherjee
I'm not a Shiny ninja, but I don't believe there is a way to do that. If you want multiple different inputs, they have to be multiple different variables. Maybe someone else will come along and know a way though. — Colin Robinson

Stéphane Laurent Stéphane Laurent · Accepted Answer · 2016-02-25T15:32:56

To deal with a dynamic number of tabs or other widgets, create them in server.R with renderUI. Use a list to store the tabs and the do.call function to apply the tabItems function. The same for the sidebar.

I think my code below generates your expectation.

library(shiny)
library(shinydashboard)
library(data.table)
library(ggplot2)
data = data.table(group = rep(c(1, 3, 6), each = 10), x = rep(1:10, times = 3), value = rnorm(30))

sidebar <- dashboardSidebar(
  uiOutput("Sidebar")
)

body <- dashboardBody(
  uiOutput("TABUI")
)

# Put them together into a dashboardPage
ui <- dashboardPage(
  dashboardHeader(title = "test tabbed inputs"),
  sidebar,
  body,
  skin = 'green'
)

server <- function(input, output) {

  ntabs <- 3
  tabnames <- paste0("tab", 1:ntabs) # "tab1", "tab2", ...
  checkboxnames <- paste0(tabnames, 'group') # "tab1group", "tab2group", ...
  plotnames <- paste0("plot", 1:ntabs) # "plot1", "plot2", ...

  output$Sidebar <- renderUI({
    Menus <- vector("list", ntabs)
    for(i in 1:ntabs){
      Menus[[i]] <-   menuItem(tabnames[i], tabName = tabnames[i], icon = icon("dashboard"), selected = i==1)
    }
    do.call(function(...) sidebarMenu(id = 'sidebarMenu', ...), Menus)
  })

  output$TABUI <- renderUI({
    Tabs <- vector("list", ntabs)
    for(i in 1:ntabs){
      Tabs[[i]] <- tabItem(tabName = tabnames[i],
                     fluidRow(
                       box(title = "Controls", 
                           checkboxGroupInput(checkboxnames[i], 'group:', c(1, 3, 6), selected = 6, inline = TRUE), 
                           width = 4),
                       box(plotOutput(paste0("plot",i)), width = 8)
                     )
      )
    }
    do.call(tabItems, Tabs)
  })

  RV <- reactiveValues()
  observe({
    selection <- input[[paste0(input$sidebarMenu, 'group')]]
    RV$plotData <- data[group %in% selection]
  })

  for(i in 1:ntabs){
    output[[plotnames[i]]] <- renderPlot({
      plotData <-  RV$plotData 
      p <- ggplot(plotData, aes(x = x, y = value, colour = factor(group))) + 
        geom_line() + geom_point()  
      print(p)
    })
  }

}

shinyApp(ui, server)

Note that I put the "plot data" in a reactive list. Otherwise, if I did that:

output[[plotnames[i]]] <- renderPlot({
   selection <- input[[paste0(input$sidebarMenu, 'group')]]
   plotData <- data[group %in% selection]
   ...

the plot would be reactive each time you go back to a tab (try to see what I mean).

tab dependent input for shiny dashboard

1 Answers