在tabItems()中 Package 代码时，Shiny Dashboard应用程序没有响应

muk1a3rh 于 2023-07-31 发布在其他

关注(0)|答案(1)|浏览(104)

我在R闪亮的 Jmeter 板中有一个表，当我尝试向 Jmeter 板添加额外的页面时，它没有显示正确的数据。一旦我将表 Package 在tabItem()中并应用过滤器，就会出现一个空表，过滤器不再工作。事实上，我认为应用程序根本没有注册我的过滤器命令，因为当我尝试应用过滤器时，R studio控制台只是说：

Listening on http://127.0.0.1:4543

字符串
我已经检查了我是否使用了正确的tabName，我也检查了我的格式。我似乎不明白是什么导致了这个问题。由于保密性，我无法提供所使用的确切代码，但下面是一个使用Kaggle Air Quality数据集的可复制示例。
我的原始代码是使用确切的结构来设置的。

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)

型

r

来源：https://stackoverflow.com/questions/76699743/no-response-from-shiny-dashboard-app-when-wrapping-code-in-tabitems

1条答案

按热度按时间

9lowa7mx1#

为sidebarMenu定义一个id，并在服务器端使用updateTabItems()。那就成功了

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)

字符串

赞(0）回复(0）举报 2023-07-31

我来回答

在tabItems()中 Package 代码时，Shiny Dashboard应用程序没有响应

1条答案

相关问题

热门标签

最新问答