sidebarMenu 未存储正确的值

Question

我有一个包含多个dashboardPages的shainyApp，在每个dashboardPages中我都有sidebarMenu。

我正在尝试获取点击标签的名称。

这是一个示例代码：

ui<-navbarPage("",
               tabPanel("tab1",
                        dashboardPage(
                          dashboardHeader(),
                          dashboardSidebar(
                            sidebarMenu(id="menu1",
                                        menuItem("a1", icon = icon("th"),tabName = "a1",selected = T),
                                        menuItem("a2", icon = icon("th"),tabName = "a2")
                                        )
                          ),
                          dashboardBody()
                        )
                        ),
               tabPanel("tab2",
                        dashboardPage(
                          dashboardHeader(),
                          dashboardSidebar(
                            sidebarMenu(id="menu2",
                                        menuItem("b1", icon = icon("th"),tabName = "b1",selected = T),
                                        menuItem("b2", icon = icon("th"),tabName = "b2")
                            )
                          ),
                          dashboardBody(
                            textOutput("text")
                          )
                        )
               )
               )
server <- function(input, output, session) {
  
output$text<-renderText({
   input$menu2
})

}

shinyApp(ui,server)  

我面临的问题是 input$menu2 开头的值为 'a1' 而不是 'b1'

这是一个错误还是我在这里做错了什么？

感谢您对此的帮助

谢谢

Answer 1

您的程序运行良好。即使您转到第二个选项卡，它也会显示在第一个实例中预先选择的内容。一旦您单击侧边栏中的某个项目，例如 b2，它将显示该项目，直到从 tab1 或 tab2 在侧边栏中单击另一个项目。

如果您希望在每个带有自己的侧边栏的选项卡上显示不同的图表或其他信息，可以使用单个 dashboardPage 来完成。只需使用conditionalPanel，如下所示。

require(shiny)
require(shinydashboard)
require(shinyjs)

### create a simple app
ui <- dashboardPage(
  title='Test Menus',
  dashboardHeader(
    title = 'Loading Menus'
  ),
  dashboardSidebar(
    conditionalPanel("input.navbar == 'tab1_val'",
                     div(id='tab1_sidebar',
                         #sliderInput('tab1_slider', 'tab1 slider', min=2,max=7,value=2),
                         sidebarMenu(id="menu1", 
                                     menuItem("a1", icon = icon("th"),tabName = "a1",selected = T),
                                     menuItem("a2", icon = icon("th"),tabName = "a2")
                         )  
                         )
    ),
    conditionalPanel("input.navbar == 'tab2_val'",
                     div(id='tab2_sidebar',
                         #sliderInput('tab2_slider', 'tab2 slider', min=2,max=7,value=5),
                         sidebarMenu(id="menu2",
                                     menuItem("b1", icon = icon("th"),tabName = "b1",selected = T),
                                     menuItem("b2", icon = icon("th"),tabName = "b2")
                         )
                         )
    )
  ),
  dashboardBody(
    useShinyjs(),
    tabsetPanel(
      id = "navbar",
      tabPanel(title="tab1 title",id="tab1",value='tab1_val',
               valueBoxOutput('tab1_valuebox'),
               uiOutput("text1"),
               plotOutput("plot1")
               ),
      tabPanel(title="tab2 title",id="tab2",value='tab2_val',
               valueBoxOutput('tab2_valuebox'),
               uiOutput("text2"),
               plotOutput("plot2")
               )
    )
  )
)

server <- shinyServer(function(input, output, session) {

  output$tab1_valuebox <- renderValueBox({
    valueBox('1000',subtitle = "blah blah",icon = icon("car"),
             color = "blue", print(input$menu1)
    )
  })

  output$tab2_valuebox <- renderValueBox({
    valueBox('2000',subtitle = "blah2 blah2",icon = icon("car"),
             color = "red"
    )
  })
  
  output$text1<-renderUI({
    print(input$menu1)
  })
  
  output$text2<-renderUI({
    print(input$menu2)
  })
  
  pt1 <- qplot(rnorm(500),fill=I("red"),binwidth=0.2,title="plotgraph1")
  pt2 <- qplot(rnorm(600),fill=I("blue"),binwidth=0.2,title="plotgraph2")
  output$plot1 = renderPlot({pt1})
  output$plot2 = renderPlot({pt2})
  
  ####  on click of a tab1 valuebox
  shinyjs::onclick('tab1_valuebox',expr={
    # move to tab2
    updateTabsetPanel(session, "navbar", 'tab2_val')
  })

  ###  on click of a tab2 valuebox
  shinyjs::onclick('tab2_valuebox',expr={
    # move to tab1
    updateTabsetPanel(session, "navbar", 'tab1_val')
  })
  
})
 
shinyApp(ui,server)

这来自@DeanAttali here 提供的两个答案之一。所有功劳归于他。