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

Question

当点击侧栏中的菜单项时，我希望它不仅展开并显示菜单子项，而且预选第一个并显示相应的选项卡项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)

Answer 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。

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

Shiny dashboard preselect menuSubItem when clicking menuItem

r

shiny

shinydashboard