shiny dashboard -sidebarMenu with menuItem

Question

I am trying to build a shiny application using sidebarMenu with menuItems. Currently the menu items are duplicated,

enter image description here

Clicking the first and second menu items are not showing the table or the plot. Only the last two shows the output. How can I modify it to have only two items - 1) Plots Menu, 2) Table Menu (with sub items) and clicking on it show the respective output. Used the mtcars dataset and the code ispasted below

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

You have both the standard and reactive sidebar options running in tandem. If you need a reactive sidebar, just put the contents in the server function and call all of it with sidebarMenuOutput in 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

I put the code together. -Ian

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)