14

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: dashboard_w_navbar

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: nav_w_sidebar

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.

3 Answers 3

Reset to default

Trending sort

Trending sort is based off of the default sorting method — by highest score — but it boosts votes that have happened recently, helping to surface more up-to-date answers.

It falls back to sorting by highest score if no posts are trending.

6

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: enter image description here

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: enter image description here

Hope it helps!

3
  • Thanks SBista. Is it possible to make the sidebarMenu collapsible?
    – jmjr
    Oct 20, 2017 at 9:33
  • You could use hide from shinyjs package.
    – SBista
    Oct 20, 2017 at 9:38
  • As I know R but am not experienced at all in HTML, I have some questions about this : is this a legit use (not to use navbarPage as a top container) ? Apr 4, 2021 at 8:51
3

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

shinydashboardPlus

and here to see it in action.

2
  • 2
    Could you elaborate on this @jmjr? I see that I can add a left_menu with shinydashboardPlus, but how do I put the appropriate navigation there? Putting the sidebarMenu() does not really work satisfactorily.
    – fry
    May 20, 2019 at 16:28
  • One of the two links in this accepted answer is dead. Perhaps @jmjr would be willing to update the answer with reproducible code to replace the dead link?
    – bdemarest
    Sep 26, 2019 at 21:20
2

This is now possible using bootstraplib

Github Request to implement this: https://github.com/rstudio/bootstraplib/issues/76

min reprex:

# package load ------------------------------------------------------------
library(shiny)
library(bootstraplib)

# boot dash layout funs ---------------------------------------------------


boot_side_layout <- function(...) {
  div(class = "d-flex wrapper", ...)
}

boot_sidebar <- function(...) {
  div(
    class = "bg-light border-right sidebar-wrapper",
    div(class = "list-group list-group-flush", ...)
  )
}

boot_main <- function(...) {
  div(
    class = "page-content-wrapper",
    div(class = "container-fluid", ...)
  )
}



# title -------------------------------------------------------------------
html_title <-
  '<span class="logo">
    <div style="display:inline-block;">
      <a href="https://www.google.com"><img src="https://jeroen.github.io/images/Rlogo.png" height="35"/></a>
      <b>my company name</b> a subtitle of application or dashboard
    </div>
  </span>'


# css ---------------------------------------------------------------------

css_def <- "
body {
  overflow-x: hidden;
}

.container-fluid, .container-sm, .container-md, .container-lg, .container-xl {
    padding-left: 0px;
}

.sidebar-wrapper {
  min-height: 100vh;
  margin-left: -15rem;
  padding-left: 15px;
  padding-right: 15px;
  -webkit-transition: margin .25s ease-out;
  -moz-transition: margin .25s ease-out;
  -o-transition: margin .25s ease-out;
  transition: margin .25s ease-out;
}


.sidebar-wrapper .list-group {
  width: 15rem;
}

.page-content-wrapper {
  min-width: 100vw;
  padding: 20px;
}

.wrapper.toggled .sidebar-wrapper {
  margin-left: 0;
}

.sidebar-wrapper, .page-content-wrapper {
  padding-top: 20px;
}

.navbar{
  margin-bottom: 0px;
}

@media (max-width: 768px) {
  .sidebar-wrapper {
    padding-right: 0px;
    padding-left: 0px;

  }
}

@media (min-width: 768px) {
  .sidebar-wrapper {
    margin-left: 0;
  }

  .page-content-wrapper {
    min-width: 0;
    width: 100%;
  }

  .wrapper.toggled .sidebar-wrapper {
    margin-left: -15rem;
  }
}

"


# app ---------------------------------------------------------------------
ui <- tagList(
  tags$head(tags$style(HTML(css_def))),
  bootstrap(),
  navbarPage(
    collapsible = TRUE,
    title = HTML(html_title),
    tabPanel(
      "Tab 1",
      boot_side_layout(
        boot_sidebar(
          sliderInput(
            inputId = "bins",
            label = "Number of bins:",
            min = 1,
            max = 50,
            value = 30
          )
        ),
        boot_main(
          fluidRow(column(6, h1("Plot 1")), column(6, h1("Plot 2"))),
          fluidRow(
            column(6, plotOutput(outputId = "distPlot")),
            column(6, plotOutput(outputId = "distPlot2"))
          )
        )
      )
    ),
    tabPanel(
      "Tab 2",
      boot_side_layout(
        boot_sidebar(h1("sidebar input")),
        boot_main(h1("main output"))
      )
    )
  )
)

server <- function(input, output) {
  output$distPlot <- renderPlot({
    x <- faithful$waiting
    bins <- seq(min(x), max(x), length.out = input$bins + 1)

    hist(x,
      breaks = bins, col = "#75AADB", border = "white",
      xlab = "Waiting time to next eruption (in mins)",
      main = "Histogram of waiting times"
    )
  })

  output$distPlot2 <- renderPlot({
    x <- faithful$waiting
    bins <- seq(min(x), max(x), length.out = input$bins + 1)

    hist(x,
      breaks = bins, col = "#75AADB", border = "white",
      xlab = "Waiting time to next eruption (in mins)",
      main = "Histogram of waiting times"
    )
  })
}

shinyApp(ui, server)
1
  • 1
    That's a nice layout, do you know how to make the sidebar permanent between tabs, so that the same inputs are displayed in the sidebar, whatever the selected tab? (like a dashboard)
    – bretauv
    Jul 8, 2020 at 13:58

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.