Search code examples
rshinyshinydashboard

No response from Shiny Dashboard App when wrapping code in tabItems()


I have a table in R Shiny dashboard that does not show the correct data when I try to add additional pages to the dashboard. Once I wrap my table inside tabItem() and apply the filters, what appears is an empty table and the filters are no longer are working. In fact, I don't think the app is registering my filter commands at all because when I try to apply the filters, the R studio console just says:

Listening on http://127.0.0.1:4543

I've checked to see if I'm using the correct tabName and I've checked my formatting as well. I can't seem to understand what is causing the issue. I'm unable to provide the exact code used due to confidentiality, but below is a reproducible example using the Air Quality dataset from Kaggle.

My original code is set up using the exact structure .

library(tidyverse)
library(shiny)
library(shinydashboard)
library(reactable)

# air quality dataset
air_quality_nyc <- read.csv('Air_Quality.csv')


#### Nitrogen Dioxide
season_no2 <-air_quality_nyc %>%
  filter((grepl('Winter',Time.Period)|grepl('Summer',Time.Period))
         & Geo.Place.Name== 'Queens' 
         & Name == 'Nitrogen Dioxide (NO2)')



#### Nitrogen Dioxide Annual Graph
annual_no2 <-air_quality_nyc %>%
  filter(grepl('Annual Average',Time.Period) & Geo.Place.Name== 'Queens' & Name == 'Nitrogen Dioxide (NO2)')%>%
  mutate(across(Time.Period,str_replace,'Annual Average',''))%>%
  mutate(across(Time.Period,as.numeric))

no2_plot <- annual_no2 %>%
  ggplot(aes(x=Time.Period,y=Data.Value))+
  geom_point()+
  geom_line()


###################### Dashboard ################################

ui <- dashboardPage(
  dashboardHeader(title = "Air Quality"),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Tables", tabName = "table", selected = TRUE,
               menuSubItem('Air Quality Data', tabName='air_data')),
      menuItem("Graphs", tabName = "graph", 
               menuSubItem('NO2 Graph', tabName='no2'))
    
    
    )),
  dashboardBody(
    tabItems(
      tabItem(tabName='table',
        h1('Main Page')
      ),
      tabItem(tabName = 'air_data',
        box(reactableOutput('air_quality'), width = 12),
        selectInput(
          inputId = 'geoPlace',
          choices = c('Manhattan','Queens','Staten Island','Bronx','Brooklyn'),
          label = 'Borough',
          #multiple = TRUE,
        ),
        selectInput(
          inputId = 'time',
          choices = c('Annual 2016','Annual 2017','Annual 2018','Annual 2019','Annual 2020'),
          label = 'Time Period',
          #multiple = TRUE,
        ),
        selectInput(
          inputId = 'type',
          choices = c('Fine Particulate Matter (PM2.5)','Nitrogen Dioxide (NO2)','Sulfur Dioxide (SO2)','Ozone (O3)'),
          label = 'Name',
          #multiple = TRUE,
        ),
        submitButton(
          text = 'Apply Changes'
        )
        
        
      ),
      tabItem(tabName = 'no2',
              box(plotOutput('no2_graph'))
        
      ),
      tabItem(tabName = 'graph',
        h1('Other Main Page')
      )
      
      
      
    )
   
    
    
    )
  
  )




server <- function(input,output){
  
  output$air_quality<- renderReactable({
    
    reactable(
      df<-air_quality_nyc %>%
      filter(Geo.Place.Name == input$geoPlace, 
             Time.Period == input$time,
             Name == input$type)
    )
  })
  
  output$no2_graph<-renderPlot(
    no2_plot
  )
}


shinyApp(ui,server)

Solution

  • Define an id for sidebarMenu and use updateTabItems() on the server side. Then it works.

    library(tidyverse)
    library(shiny)
    library(shinydashboard)
    library(reactable)
    
    # air quality dataset
    air_quality_nyc <- read.csv('Air_Quality.csv')
    df <- air_quality_nyc
    
    #### Nitrogen Dioxide
    season_no2 <-air_quality_nyc %>%
      filter((grepl('Winter',Time.Period)|grepl('Summer',Time.Period))
             & Geo.Place.Name== 'Queens'
             & Name == 'Nitrogen Dioxide (NO2)')
    
    
    
    #### Nitrogen Dioxide Annual Graph
    annual_no2 <-air_quality_nyc %>%
      filter(grepl('Annual Average',Time.Period) & Geo.Place.Name== 'Queens' & Name == 'Nitrogen Dioxide (NO2)')%>%
      mutate(across(Time.Period,str_replace,'Annual Average',''))%>%
      mutate(across(Time.Period,as.numeric))
    
    no2_plot <- annual_no2 %>%
      ggplot(aes(x=Time.Period,y=Data.Value))+
      geom_point()+
      geom_line()
    
    
    ###################### Dashboard ################################
    
    ui <- dashboardPage(
      dashboardHeader(title = "Air Quality"),
      dashboardSidebar(
        sidebarMenu(id="tabs",
          menuItem("Tables", tabName = "table", selected = TRUE,
                   menuSubItem('Air Quality Data', tabName='air_data')),
          menuItem("Graphs", tabName = "graph", 
                   menuSubItem('NO2 Graph', tabName='no2'))
          
          
        )),
      dashboardBody(
        tabItems(
          tabItem(tabName='table',
                  h1('Main Page')
          ),
          tabItem(tabName = 'air_data',
                  box(reactableOutput('air_quality'), width = 12),
                  selectInput(
                    inputId = 'geoPlace',
                    choices = unique(df$Geo.Place.Name), # c('Manhattan','Queens','Staten Island','Bronx','Brooklyn'),
                    label = 'Borough',
                    #multiple = TRUE,
                  ),
                  selectInput(
                    inputId = 'time',
                    choices = unique(df$Time.Period), # c('Annual 2016','Annual 2017','Annual 2018','Annual 2019','Annual 2020'),
                    label = 'Time Period',
                    #multiple = TRUE,
                  ),
                  selectInput(
                    inputId = 'type',
                    choices = unique(df$Name), #c('Fine Particulate Matter (PM2.5)','Nitrogen Dioxide (NO2)','Sulfur Dioxide (SO2)','Ozone (O3)'),
                    label = 'Name',
                    #multiple = TRUE,
                  ),
                  actionBttn("apply","Apply Changes")
                  # submitButton(
                  #   text = 'Apply Changes'
                  # )
                  
                  
          ),
          tabItem(tabName = 'no2',
                  box(plotOutput('no2_graph'))
                  
          ),
          tabItem(tabName = 'graph',
                  h1('Other Main Page')
          )
          
        )
        
      )
    )
    
    server <- function(input,output,session) {
      
      observeEvent(input$tabs, {
        print(input$tabs)
        updateTabItems(session,"tabs",input$tabs)
      })
      
      mydf <- reactive(
        air_quality_nyc %>%
          dplyr::filter(Geo.Place.Name == input$geoPlace,
                        Time.Period == input$time,
                        Name == input$type)
      )
      
      output$air_quality <- renderReactable({
        
        reactable(
          mydf()
        )
      })
      
      output$no2_graph<-renderPlot(
        no2_plot
        #plot(pressure)
      )
    }
    
    
    shinyApp(ui,server)