带有menuItem的闪亮仪表板-sidebarMenu

Question

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

enter image description here

单击第一个和第二个菜单项不显示表格或图表。只有最后两个显示输出。如何将其修改为只有两个项目 - 1）绘图菜单，2）表格菜单（带子项目）并单击它显示相应的输出。使用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函数中，然后在sidebarMenuOutput中使用ui调用所有内容。

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)