How to combine top navigation (navbarPage) and a sidebar menu (sidebarMenu) in shiny

Question

I have a shiny app (using navbarPage) with many tabs and would like to add a sidebarMenu that can be seen no matter which tab is selected. The input values in the sidebar have an impact on the content of all tabs. Additionally, it should be possible to hide the sidebarMenu as it is in a shinydashboard.

I see two possible ways:

(A) Using shinydashboard and somehow adding a top navigation bar or

(B) using navbarPage and somehow adding a sidebar menu that can be hidden.

(A) Using shinydashboard, the closest to what I want is this (simplified MWE):

library("shiny")
library("shinydashboard")

cases <- list(A=seq(50,500, length.out=10), B=seq(1000,10000, length.out=10))

ui <- dashboardPage(
  dashboardHeader(title = "dash w/ navbarMenu"),
  dashboardSidebar(selectizeInput('case', 'Pick a case', selected="A", choices = c("A", "B"), multiple = FALSE), numericInput('num', 'Number', min = 1, max = 10, value = 1, step = 1)),
  dashboardBody(
    tabsetPanel(
      tabPanel(h4("Perspective 1"),
               tabsetPanel(
                 tabPanel("Subtab 1.1", plotOutput("plot11")),
                 tabPanel("Subtab 1.2")
               )),
      tabPanel(h4("Perspective 2"),
               tabsetPanel(
                 tabPanel("Subtab 2.1"),
                 tabPanel("Subtab 2.2")
               ))
    )
  )
)

server <- function(input, output) {
  output$plot11 <- renderPlot({
    hist(rnorm(cases[[input$case]][input$num]))
  })
}

shinyApp(ui, server)

which is ugly because the navigation bar menu are tabsets which are not part of the menu. What I want is:

Based on this post, I guess it's not possible to include "Perspective 1" and "Perspective 2" tabs in the top menu at all, thus using shinydashboard seems not feasible.

(B) Using navbarPage, I tried using navlistPanel() but I didn't succeed to

(1) make it behave like a sidebarMenu, i.e. be overall visible on the left side of the page and

(2) add hide functionality. Here is my try:

library("shiny")

cases <- list(A=seq(50,500, length.out=10),
              B=seq(1000,10000, length.out=10))

ui <- navbarPage(title = "nav w/ sidebarMenu",
                   tabPanel(h4("Perspective 1"),
                            tabsetPanel(
                              tabPanel("Subtab 1.1",
                                       plotOutput("plot11")),
                              tabPanel("Subtab 1.2")
                            )),
                   tabPanel(h4("Perspective 2"),
                            tabsetPanel(
                              tabPanel("Subtab 2.1"),
                              tabPanel("Subtab 2.2")
                            )),

                 navlistPanel(widths = c(2, 2), "SidebarMenu",
                              tabPanel(selectizeInput('case', 'Pick a case', selected="A", choices = c("A", "B"), multiple = FALSE)),
                              tabPanel(numericInput('num', 'Number', min = 1, max = 10, value = 1, step = 1))
                 )
)


server <- function(input, output) {
  output$plot11 <- renderPlot({
    hist(rnorm(cases[[input$case]][input$num]))
  })
}

shinyApp(ui, server)

Again, what I want is:

I know, there is flexDashboard. It does not solve the problem for three reasons:

(1) I think it is not possible to hide the sidebar menu, as it is a column and not a real sidebar menu,

(2) it is not reactive which I require in my app,

(3) I think dataTables don't work, which I also need.

Besides, I'd prefer to not have to change the code to Rmarkdown syntax.

Preferably, I'd use a navbarPage and add a sidebarMenu, because my app is already built using navbarPage.

Answer 1

You could use sidebarLayout and do something like this:

ui <- fluidPage(sidebarLayout(
  sidebarPanel(navlistPanel(
    widths = c(12, 12), "SidebarMenu",
    tabPanel(selectizeInput('case', 'Pick a case', selected="A", choices = c("A", "B"), multiple = FALSE)),
    tabPanel(numericInput('num', 'Number', min = 1, max = 10, value = 1, step = 1))
  )),
      mainPanel(navbarPage(title = "nav w/ sidebarMenu",
                            
                            tabPanel(h4("Perspective 1"),
                                     tabsetPanel(
                                       tabPanel("Subtab 1.1",
                                                plotOutput("plot11")),
                                       tabPanel("Subtab 1.2")
                                     )),
                            tabPanel(h4("Perspective 2"),
                                     tabsetPanel(
                                       tabPanel("Subtab 2.1"),
                                       tabPanel("Subtab 2.2")
                                     )))
      
      )
    ))

You get something like this:

Another option would be using fluidRow function. Something like this:

  ui <- fluidPage(
    fluidRow(
      column(3, navlistPanel(
        widths = c(12, 12), "SidebarMenu",
        tabPanel(selectizeInput('case', 'Pick a case', selected="A", choices = c("A", "B"), multiple = FALSE)),
        tabPanel(numericInput('num', 'Number', min = 1, max = 10, value = 1, step = 1))
      )),
      column(9,  navbarPage(title = "nav w/ sidebarMenu",
                             
                             tabPanel(h4("Perspective 1"),
                                      tabsetPanel(
                                        tabPanel("Subtab 1.1",
                                                 plotOutput("plot11")),
                                        tabPanel("Subtab 1.2")
                                      )),
                             tabPanel(h4("Perspective 2"),
                                      tabsetPanel(
                                        tabPanel("Subtab 2.1"),
                                        tabPanel("Subtab 2.2")
                                      ))))
      
      
    )
      )
    

To get this:

Hope it helps!

Answer 2

There is now an easier and more elegant way to do achieve it:

shinydashboardPlus

and here to see it in action.