在shinydashboard永久扩展手风琴

时间:2017-08-17 19:17:59

标签: r shiny accordion shinydashboard

有没有办法将shinydashboard菜单设置为永久展开,如下图所示:

enter image description here

我知道手风琴菜单的行为是这样的(我的意思是只有一个可以同时扩展),因为文档但是可能有一些技巧可以做到这一点或者在我的闪亮应用程序中实现一些替代方案?

这是代码:

library(shiny)
library(shinydashboard)

header <- dashboardHeader()

  sidebar <- dashboardSidebar(
    sidebarMenu(
      # Setting id makes input$tabs give the tabName of currently-selected tab
      id = "tabs",
      menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
      menuItem("Widgets", icon = icon("th"), tabName = "widgets",
               menuSubItem("Sub-item 1", tabName = "subitem1"),
               menuSubItem("Sub-item 2", tabName = "subitem2"),
               startExpanded = TRUE),
      menuItem("Charts", icon = icon("bar-chart-o"),
               menuSubItem("Sub-item 3", tabName = "subitem3"),
               menuSubItem("Sub-item 4", tabName = "subitem4"),
               startExpanded = TRUE
      )
    )
  )

  body <- dashboardBody(
    tabItems(
      tabItem("dashboard",
              div(p("Dashboard tab content"))
      ),
      tabItem("widgets",
              "Widgets tab content"
      ),
      tabItem("subitem1",
              "Sub-item 1 tab content"
      ),
      tabItem("subitem2",
              "Sub-item 2 tab content"
      )
    )
  )

  shinyApp(
    ui = dashboardPage(header, sidebar, body),
    server = function(input, output) { }
  )

1 个答案:

答案 0 :(得分:0)

好的,这非常hacky并且可能有更好的方法来执行此操作,但您可以使用CSS样式将链接“移动”到其他内容“下方”,这样就无法使用z-index单击它们。不幸的是,您必须手动编写每个菜单项,并参考其href。请看这个例子:

library(shiny)
library(shinydashboard)

header <- dashboardHeader()

sidebar <- dashboardSidebar(
  sidebarMenu(
    tags$head(tags$style(HTML('
        a[href="#shiny-tab-widgets"] {
          z-index: -99999;
        }
        a[href="#"] {
          z-index: -99999;
        }
      '))),

    # Setting id makes input$tabs give the tabName of currently-selected tab
    id = "tabs",
    menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
    menuItem("Widgets", icon = icon("th"), tabName = "widgets",
             menuSubItem("Sub-item 1", tabName = "subitem1"),
             menuSubItem("Sub-item 2", tabName = "subitem2"),
             startExpanded = TRUE),
    menuItem("Charts", icon = icon("bar-chart-o"),
             menuSubItem("Sub-item 3", tabName = "subitem3"),
             menuSubItem("Sub-item 4", tabName = "subitem4"),
             startExpanded = TRUE
    )
  )
)

body <- dashboardBody(

  tabItems(
    tabItem("dashboard",
            div(p("Dashboard tab content"))
    ),
    tabItem("widgets",
            "Widgets tab content"
    ),
    tabItem("subitem1",
            "Sub-item 1 tab content"
    ),
    tabItem("subitem2",
            "Sub-item 2 tab content"
    )
  )
)

shinyApp(
  ui = dashboardPage(header, sidebar, body),
  server = function(input, output) { }
)