闪亮的仪表板 -sidebarMenu 和 menuItem

Question

我正在尝试使用 sidebarMenu 和 menuItems 构建一个闪亮的应用程序。目前菜单项重复，

enter image description here

单击第一个和第二个菜单项不会显示 table 或绘图。只有最后两个显示输出。我怎样才能修改它只有两个项目 - 1) Plots Menu, 2) Table Menu (with sub items) 然后点击它显示相应的输出。使用了 mtcars 数据集，下面粘贴了代码

data(mtcars)
ibrary(shiny)
library(shinydashboard)
library(dplyr)

 ui <- dashboardPage(
    dashboardHeader(title = "Dynamic sidebar"),
    dashboardSidebar(
      sidebarMenu(
        menuItem("Plots Menu", tabName = "plot_page", icon = icon("line-chart")),

        menuItem("Table Menu", tabName="intro_page", icon = icon("info"),
                 selectInput(inputId = "mcm", label = "Some label",
                             multiple = TRUE, choices = unique(mtcars$cyl), selected = unique(mtcars$cyl)))

      ),
      sidebarMenuOutput("menu")
    ),
    dashboardBody(tabItems(
      tabItem(tabName = "plots", h2("Dashboard plots"),
              fluidRow(column(width = 12, class = "well",
                              h4("Boxplot"),
                              plotOutput("bxp")))
      ),
      tabItem(tabName = "dashboard", h2("Dashboard tab content"),
              dataTableOutput(outputId = "subdt"))
    )
    )
  )



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

    output$menu <- renderMenu({
      sidebarMenu(
        menuItem("Plots Menu", tabName = "plots", icon = icon("line-chart")),

        menuItem("Table Menu", tabName="dashboard", icon = icon("calendar"))
      )
    })

    datsub <- reactive({
      mtcars %>%
          filter_at(vars("cyl"), all_vars(. %in% input$mcm))


    })

    output$subdt <- renderDataTable({
      datsub()
    })

    output$bxp <- renderPlot({

      hist(rnorm(100))


    }) 

  }

  shinyApp(ui, server)

Answer 1

您同时拥有标准侧边栏和响应式侧边栏选项运行。如果您需要反应式侧边栏，只需将内容放入 server 函数中，然后在 ui.

中使用 sidebarMenuOutput 调用所有内容

`ui.R`

dashboardSidebar(sidebarMenu(id = "menu", sidebarMenuOutput("menu")))

`server.R`

output$menu <- renderMenu({
    sidebarMenu(
      menuItem("Plots Menu", tabName = "plots", icon = icon("line-chart")),
      menuItem("Table Menu", icon = icon("info"),
               menuSubItem(
                 "Dashboard", tabName = "dashboard", icon = icon("calendar")
               ),
               selectInput(
                 inputId = "mcm", label = "Some label", multiple = TRUE,
                 choices = unique(mtcars$cyl), selected = unique(mtcars$cyl)
               )
      )
    )
  })

Answer 2

我把代码放在一起了。 -伊恩

data(mtcars)
library(shiny)
library(shinydashboard)
library(dplyr)

ui <- dashboardPage(
  dashboardHeader(title = "Dynamic sidebar"),
  dashboardSidebar(sidebarMenu(id = "menu", sidebarMenuOutput("menu"))),
  dashboardBody(tabItems
    (
    tabItem
      (tabName = "plots", h2("Dashboard plots"),
    fluidRow(column(width = 12, class = "well",
    h4("Boxplot"),
    plotOutput("bxp")))
    ),
    tabItem(tabName = "dashboard", h2("Dashboard tab content"),
    dataTableOutput(outputId = "subdt"))
  )
  )
)



server <- function(input, output, session) {
  output$menu <- renderMenu({
    sidebarMenu(
      menuItem("Plots Menu", tabName = "plots", icon = icon("line-chart")),
      menuItem("Table Menu", icon = icon("info"),
               menuSubItem(
                 "Dashboard", tabName = "dashboard", icon = icon("calendar")
               ),
               selectInput(
                 inputId = "mcm", label = "Some label", multiple = TRUE,
                 choices = unique(mtcars$cyl), selected = unique(mtcars$cyl)
               )
      )
    )
  })

  datsub <- reactive({
    mtcars %>%
      filter_at(vars("cyl"), all_vars(. %in% input$mcm))
  })

  output$subdt <- renderDataTable({
    datsub()
  })

  output$bxp <- renderPlot({
    hist(rnorm(100))
  }) 

}

shinyApp(ui, server)

闪亮的仪表板 -sidebarMenu 和 menuItem

shiny dashboard -sidebarMenu with menuItem

r

shiny

shinydashboard

ui.R

server.R

`ui.R`

`server.R`