Shinydashboard: tabPanel sidebar inside tabBox

Question

I am trying to create a sidebar effect inside a tabBox for a particular tabPanel (very similar to how shinyDashboardPlus does it with just a box) but it's not turning out as expected using mainPanel and sidebarPanel.

Code:

library(shiny)
library(shinydashboard)


  header <- dashboardHeader()
  sidebar <- dashboardSidebar()

  body <- dashboardBody(
    useShinyjs(),
    fluidRow(
      div(id = "TimingBox",
          tabBox(id = "Timing",
                 tabPanel("Tab 1", 
                          mainPanel(
                            plotOutput("plot1")
                          ),
                          div(id ="Sidebar",
                            sidebarPanel(
                            "Look here"
                            )
                          )
                 ),
                 tabPanel("Tab 2"),
                 title = p("Status",actionLink("Link", NULL, icon = icon("plus-square-o"))), width = 4,
                 selected = "Tab 1"
          )
      )
    )
  )

  ui <- dashboardPage(header, sidebar, body)

server <- function(input, output) {

  shinyjs::hide(id = "Sidebar")

  observeEvent(input$Link, {
    shinyjs::toggle(id = "Sidebar")
  })


  set.seed(122)
  histdata <- rnorm(500)

  output$plot1 <- renderPlot({
    data <- histdata[seq_len(50)]
    hist(data)
  })


}

shinyApp(ui, server)

ShinyDashboardPlus's box with sidebar (clicks on the i symbol):

Updated code:

I've worked on it some bit and realized I was missing sidebarLayout(). However, I would still like

The sideBar to overlay on top of the mainPanel

Have the sideBar height be the same as the mainPanel.

library(shiny)
library(shinydashboard)


  header <- dashboardHeader()
  sidebar <- dashboardSidebar()

  body <- dashboardBody(
    useShinyjs(),
    fluidRow(
      div(id = "TimingBox",
          tabBox(id = "Timing",
                 tabPanel("Tab 1", 
                    sidebarLayout(
                      div(id = "Sidebar",
                          style = "z-index: 1000;",
                          sidebarPanel("There are currently 20 overdue here", width = 6)
                      ),

                      mainPanel(plotOutput("plot1"), width = 12)
                    )
                 ),
                 tabPanel("Tab 2"),
                 title = p("Status",actionLink("Link", NULL, icon = icon("plus-square-o")),actionLink("Link2", NULL, icon = icon("search"))), width = 4,
                 selected = "Tab 1"
          )
      )
    )
  )

  ui <- dashboardPage(header, sidebar, body)

server <- function(input, output) {

  shinyjs::hide(id = "Sidebar")

  observeEvent(input$Link, {
    shinyjs::toggle(id = "Sidebar")
  })


  set.seed(122)
  histdata <- rnorm(500)

  output$plot1 <- renderPlot({
    data <- histdata[seq_len(50)]
    hist(data)
  })


}

shinyApp(ui, server)

Could you clarify some elements please : do you want the plot to reduce its width when the sidebar appear ? Does the button have to appear only when tab1 is selected and be on the header ? ? — gdevaux
I would think sidebar would want to overlay the plot (i.e. plot is not reduced) and the button doesn't have to only appear when tab1 is selected but that would be cherries on top! — Kevin
Is there a reason why you don't want to use shinydashboardPlus ? I have a solution using shinyWidgets, I am writing it — gdevaux
I would love to use shinydashboardPlus! I am using it currently for my boxes but I didn't see a Plus enhancement for tabBox. — Kevin

gdevaux gdevaux · Accepted Answer · 2019-11-21T14:51:36

Here is a solution using a dropdownButton from shinyWidgets. I think you can easily have "Status" and the button aligned by using some additional CSS.

library(shiny)
library(shinydashboard)
library(shinyjs)
library(shinyWidgets)


header <- dashboardHeader()
sidebar <- dashboardSidebar()

body <- dashboardBody(
  useShinyjs(),
  fluidRow(
    div(id = "TimingBox",
        tabBox(id = "Timing",
               tabPanel("Tab 1", 
                  plotOutput("plot1")

               ),
               tabPanel("Tab 2"),
               title = p("Status",
                         div(id = "mybutton", 
                             # put the button in div so it can be hide/show with some shinyjs
                             dropdownButton(
                               "A title", 
                               textInput("id1", "an input"),
                               selectInput("id2", "another input", choices = letters[1:5]),
                               circle = TRUE,
                               size = 'xs',
                               right = TRUE,
                               icon = icon("gear"),
                               width = '100px'
                         ))), 
               width = 4,
               selected = "Tab 1"
        )
    )
  )
)

ui <- dashboardPage(header, sidebar, body)

server <- function(input, output) {

  set.seed(122)
  histdata <- rnorm(500)

  output$plot1 <- renderPlot({
    data <- histdata[seq_len(50)]
    hist(data)
  })

  # Display button to show the sidebar only when tab 1 is active
  observe({
    print(input$Timing)
    if(input$Timing != "Tab 1"){
      shinyjs::hide(id = "mybutton")
    }else{
      shinyjs::show(id = "mybutton")
    }
    })
}

shinyApp(ui, server)

Shinydashboard: tabPanel sidebar inside tabBox

1 Answers