带有菜单项内容的子菜单-闪亮的仪表板

Question

我正在开发闪亮的应用程序，需要在菜单项中包含子菜单，并在菜单项中包含内容。

[从stackoverflow进行研究后，我发现了以下链接，Show content for menuItem when menuSubItems exist in Shiny Dashboard

但是上述解决方案中的问题是，每当我单击子菜单时，菜单项下拉列表都会关闭。因此，我需要再次单击menuitem，然后再次单击menuitem以获得子菜单的下拉列表。

请帮助我解决此问题。

当我单击子菜单时，下拉菜单不应自动关闭。

library(shiny)
library(shinydashboard)

convertMenuItem <- function(mi,tabName) {
  mi$children[[1]]$attribs['data-toggle']="tab"
  mi$children[[1]]$attribs['data-value'] = tabName
  if(length(mi$attribs$class)>0 && mi$attribs$class=="treeview"){
    mi$attribs$class=NULL
  }
  mi
}

ui <- dashboardPage(skin = "black", 

                dashboardHeader(
                  title = "test"), 
                dashboardSidebar(
                  sidebarMenu(id = "tabs",
                              convertMenuItem(menuItem("Data Scorecard", tabName = "scd",
                                                       menuSubItem("C1", tabName = "comp",icon = icon("angle-double-right")),
                                                       menuSubItem("C2", tabName = "consist",icon = icon("angle-double-right")),
                                                       menuSubItem("C3", tabName = "confirm",icon = icon("angle-double-right")),
                                                       menuSubItem("c4", tabName = "dupli",icon = icon("angle-double-right")),
                                                       menuSubItem("c5", tabName = "inte",icon = icon("angle-double-right")),
                                                       menuSubItem("c6", tabName = "accu",icon = icon("angle-double-right")),
                                                       menuSubItem("c7", tabName = "age",icon = icon("angle-double-right"))),"scd"))),


                dashboardBody(
                              tabItems(
                        tabItem(tabName = "scd", 
                                fluidRow(h4("scd"))),

                        tabItem(tabName = "comp",
                                fluidRow(h4("c1"))),
                        tabItem(tabName = "consist",
                                fluidRow(h4("c1"))),
                        tabItem(tabName = "confirm",
                                fluidRow(h4("c1"))),
                        tabItem(tabName = "dupli",
                                fluidRow(h4("c1"))),
                        tabItem(tabName = "inte", 
                                fluidRow(h4("c1"))),
                        tabItem(tabName = "accu",
                                fluidRow(h4("c1"))),
                        tabItem(tabName = "age",
                                fluidRow(h4("c1")))
                )))

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

请检查图像以进一步说明。

感谢SJB