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

Answer 1

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