单击 menuItem 时闪亮的仪表板预选 menuSubItem答案

【问题标题】：Shiny dashboard preselect menuSubItem when clicking menuItem单击 menuItem 时闪亮的仪表板预选 menuSubItem
【发布时间】：2021-12-07 05:50:28
【问题描述】：

单击侧边栏中的菜单项时，我希望它不仅可以展开并显示菜单子项，还可以预选第一个并显示相应的选项卡项 UI。

我知道可以将一个项目定义为选中，它会在我启动应用程序时显示。对我来说，这是一种令人困惑的行为，因为相应的菜单项在侧边栏中并未显示为“已选择”。无论如何，我的要求更进一步，因为我想在每次单击菜单项时预先选择一个菜单子项。

library(shinydashboard)
library(shiny)


ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Table1" , tabname = "my_table1", icon = icon("table"),startExpanded = F,
               menuSubItem("sub menu1",tabName = "subMenu1"),
               menuSubItem("sub menu2",tabName = "subMenu2")
               ),
      menuItem("Table2" , tabname = "my_table2", icon = icon("table"),startExpanded = F,
               menuSubItem("sub menu3",tabName = "subMenu3"),
               menuSubItem("sub menu4",tabName = "subMenu4", selected = T)
               )
      )),
  
  dashboardBody(
    tabItems(
      tabItem(tabName = "my_table1",
              h2("First Table")
      ),
      tabItem(tabName = "my_table2",
              h2("Second Table")
      ),
      tabItem(tabName = "subMenu1",
              h2("First tab")
      ),
      tabItem(tabName = "subMenu2",
              h2("Second tab")
      ),
      tabItem(tabName = "subMenu3", 
              h2("Third tab")
      ),
      tabItem(tabName = "subMenu4", 
              h2("Fourth tab")
      )
    )))

server <- function(input, output) {
}
shinyApp(ui, server)

【问题讨论】：

标签： r shiny shinydashboard

【解决方案1】：

您的sidebarMenu 需要id，而您的服务器函数需要session 参数，因此您可以使用：

updateTabItems(session, inputId="sidebarID", selected="subMenu1")

请检查以下内容：

library(shinydashboard)
library(shiny)


ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(
      id = "sidebarID",
      menuItem("Table1" , tabname = "my_table1", icon = icon("table"), startExpanded = TRUE,
               menuSubItem("sub menu1",tabName = "subMenu1", selected = TRUE),
               menuSubItem("sub menu2",tabName = "subMenu2")
      ),
      menuItem("Table2" , tabname = "my_table2", icon = icon("table"), startExpanded = FALSE,
               menuSubItem("sub menu3",tabName = "subMenu3"),
               menuSubItem("sub menu4",tabName = "subMenu4")
      )
    )),
  
  dashboardBody(
    tabItems(
      tabItem(tabName = "my_table1",
              h2("First Table")
      ),
      tabItem(tabName = "my_table2",
              h2("Second Table")
      ),
      tabItem(tabName = "subMenu1",
              h2("First tab")
      ),
      tabItem(tabName = "subMenu2",
              h2("Second tab")
      ),
      tabItem(tabName = "subMenu3", 
              h2("Third tab")
      ),
      tabItem(tabName = "subMenu4", 
              h2("Fourth tab")
      )
    )))

server <- function(input, output, session) {
  observeEvent(input$sidebarItemExpanded, {
    cat(paste("menuItem() currently expanded:", input$sidebarItemExpanded, "\n"))
    if(input$sidebarItemExpanded == "Table1"){
      updateTabItems(session, inputId="sidebarID", selected="subMenu1")
    } else if(input$sidebarItemExpanded == "Table2"){
      updateTabItems(session, inputId="sidebarID", selected="subMenu3")
    }
  })
  
  observe({
    cat(paste("tabItem() currently selected:", input$sidebarID, "\n"))
  })
}
shinyApp(ui, server)

更多请查看related docs。

【讨论】：