4

I'm building a Shiny app using the great ShinyDashoardPlus package (styled with a theme from the Dashboardthemes package) that has three tabItems holding the contents for the three sections of the app (section A, section B, and section C), accessible through the sidebarMenu in the left dashboardSidebar, and a right sidebar with two tabs (implemented as rightSidebarTabContent with the following ids: T_A and T_B) holding controls to explore further the contents of sections A and B respectively.

Since the rightSidebarTabContent T_A is only relevant for section A, and rightSidebarTabContent T_B is only relevant for section B, I would like that (1) the user's click on the left sidebar menu items A or B could activate the corresponding tab in the right sidebar. Moreover, since none of the rightSidebarTabContents is relevant in section C, I'd also like that (2) the user's click on the on the left sidebar menu item C could close the rightsidebar, if it is open.

I've found a possible hint on how to solve my problems (Automatic rightSidebar popup when menuItem is clicked in shinydashboardPlus), and I was indeed able to partially solve my first problem adding/removing some CSS class via shinyjs to activate a part of the different tabs in the rightSidebar at click on the menuItems.

As I said, this solution partially works for my first issue, although only the rightSidebarTabContent lower part is activated/deactivated in this way, but not the tab header with the icons for navigating between them. Moreover, possibly due to extra CSS classes added when I apply the shinydashboard theme "dark", I'm not able to toggle the closing of the rightSidebar at click on section C menu item (issue # 2).

To summarize:

  1. Right sidebar item T_A should expand when left sidebar item section A is selected. Likewise for T_A and section B.
  2. The right sidebar should collapse when section C is selected on the left sidebar

Can anyone please help with this? Thanks in advance for any help!

library(shiny)
library(shinyjs)
library(shinyWidgets)
library(shinydashboard)
library(shinydashboardPlus)
library(dashboardthemes)

ui <- dashboardPagePlus(
  useShinyjs(),
  header = dashboardHeaderPlus(
    title = "Dashboard",
    enable_rightsidebar = TRUE,
    rightSidebarIcon = "info-circle"
  ),
  sidebar = dashboardSidebar(
    sidebarMenu(
      menuItem("Section A", tabName = "Section_A", icon = icon("map")),
      menuItem("Section B", tabName = "Section_B", icon = icon("chart-line")),
      menuItem("Section C", tabName = "Section_C", icon = icon( "gears")),
      id = "nav"
    )
  ),
  body = dashboardBody(
    shinyDashboardThemes(
      theme = "grey_dark"
    ),
    tabItems(
      tabItem(
        tabName = "Section_A",
        p("Some content for section A")),
      tabItem(
        tabName = "Section_B",
        p("Some content for section B")),
      tabItem(
        tabName = "Section_C",
        p("Some content for section C"))
      )
  ),
  rightsidebar = rightSidebar(
    background = "dark",
    rightSidebarTabContent(
      id = "T_A",
      title = "Tab for section A",
      icon = "desktop",
      active = TRUE,
      p("Some content frelevant for section A"),
      sliderInput(
        "obs",
        "Number of observations:",
        min = 0, max = 1000, value = 500
      )
    ),
    rightSidebarTabContent(
      id = "T_B",
      title = "Tab for section B",
      p("Some content frelevant for section B"),
      textInput("caption", "Caption", "Data Summary")
    )
  ),
  title = "Right Sidebar"
)


server <- function(input, output) {
  observe({
    if (req(input$nav) == "Section_A"){
      message("Section A has been selected")
      shinyjs::removeClass(id = "control-sidebar-T_A-tab", class = "tab-pane")
      shinyjs::removeClass(id = "control-sidebar-T_B-tab", class = "tab-pane active")
      shinyjs::addClass(id = "control-sidebar-T_A-tab", class = "tab-pane active")
      shinyjs::addClass(id = "control-sidebar-T_B-tab", class = "tab-pane")
    }
    if (req(input$nav) == "Section_B"){
      message("Section B has been selected")
      shinyjs::removeClass(id = "control-sidebar-T_B-tab", class = "tab-pane")
      shinyjs::removeClass(id = "control-sidebar-T_A-tab", class = "tab-pane active")
      shinyjs::addClass(id = "control-sidebar-T_B-tab", class = "tab-pane active")
      shinyjs::addClass(id = "control-sidebar-T_A-tab", class = "tab-pane")
    }
    if (req(input$nav) == "Section_C"){
      message("Section C has been selected")
      shinyjs::removeClass(selector = "aside.control-sidebar-open aside.control-sidebar-dark", class = "control-sidebar-open aside.control-sidebar-dark-open")
      shinyjs::addClass(selector = "aside.control-sidebar", class = "control-sidebar")
    }
  })
}


shinyApp(ui = ui, server = server)
teofil
  • 2,344
  • 1
  • 8
  • 17

3 Answers3

4

You can render your right sidebar items reactively through renderUI instead of modifying the CSS. Inside rightSidebar we can place a single uiOutput that would get populated with different contents dependent on the chosen item in the left sidebar. Note that this is a partial solution. The sidebar, once expanded, will still not collapse when selecting section C in the left sidebar. [See edit below that addresses collapsing of the right sidebar.]

library(shinyjs)
library(shinyWidgets)
library(shinydashboard)
library(shinydashboardPlus)
library(dashboardthemes)

ui <- dashboardPagePlus(
  useShinyjs(),
  header = dashboardHeaderPlus(
    title = "Dashboard",
    enable_rightsidebar = TRUE,
    rightSidebarIcon = "info-circle"
  ),
  sidebar = dashboardSidebar(
    sidebarMenu(
      menuItem("Section A", tabName = "Section_A", icon = icon("map")),
      menuItem("Section B", tabName = "Section_B", icon = icon("chart-line")),
      menuItem("Section C", tabName = "Section_C", icon = icon( "gears")),
      id = "nav"
    )
  ),
  body = dashboardBody(
    shinyDashboardThemes(
      theme = "grey_dark"
    ),
    tabItems(
      tabItem(
        tabName = "Section_A",
        p("Some content for section A")),
      tabItem(
        tabName = "Section_B",
        p("Some content for section B")),
      tabItem(
        tabName = "Section_C",
        p("Some content for section C"))
    )
  ),
  rightsidebar = rightSidebar(
    background = "dark",
    uiOutput("side_bar"),
    title = "Right Sidebar"
  )
)

server <- function(input, output) {
  observe({
    if (req(input$nav) == "Section_A"){
      message("Section A has been selected")
      # added in edit
      shinyjs::addClass(selector = "aside.control-sidebar", class = "control-sidebar-open")
      output$side_bar <- renderUI({
        rightSidebarTabContent(
          id = "T_A",
          title = "Tab for section A",
          p("Some content relevant for section A"),
          sliderInput(
            "obs",
            "Number of observations:",
            min = 0, max = 1000, value = 500
          )
        )
      })
    }
    if (req(input$nav) == "Section_B"){
      message("Section B has been selected")
      # added in edit
      shinyjs::addClass(selector = "aside.control-sidebar", class = "control-sidebar-open")
      output$side_bar <- renderUI({
        rightSidebarTabContent(
          id = "T_B",
          title = "Tab for section B",
          p("Some content relevant for section B"),
          textInput("caption", "Caption", "Data Summary")
        )
      })
    }

    if (req(input$nav) == "Section_C"){
      message("Section C has been selected")
      # added in edit
      shinyjs::removeClass(selector = "aside.control-sidebar", class = "control-sidebar-open")

      output$side_bar <- renderUI({ div() })
    }
  })
}


shinyApp(ui = ui, server = server)

Edit: Collapse the right sidebar when section C is clicked. After reading the post you linked more carefully, you can simply add

shinyjs::addClass(selector = "aside.control-sidebar", class = "control-sidebar-open")

in your observer when section A and section B are selected, and add

shinyjs::removeClass(selector = "aside.control-sidebar", class = "control-sidebar-open")

when section C is selected.

Then the right sidebar will expand and collapse based on selections in the left sidebar.

A gif of the behavior:

enter image description here

teofil
  • 2,344
  • 1
  • 8
  • 17
  • Hi, thanks a lot for the answer! Your solutions indeed partially solve my issues, but I've noticed a couple of side effects I'd like to avoid. First, when one is in section A or B it is no longer possible to close the right sidebar. Clicking on the icon in the header has not effect, although it still works in section C. I would like it was always be possible to open/close the sidebar clicking on the icon in the header. Second, now the right sidebar automatically opens when the app is loaded, while I'd prefer it to stay closed and let the user decide whether to open it or not. – Stefano Guidi Sep 20 '19 at 17:54
  • Regarding the second issue, the sidebar automatically opens because the app has to select a tab on loading. A possible workaround would be to have something like Section 0 which will be the fist tab and wont need to have a second sidebar. As far as I can see it is not possible for an app to load without selecting a default tab. – novica Sep 27 '19 at 14:13
  • This answer isn't working with shinydashboardPlus 2.0.0 and above - `rightSiderbarMenu()`, `rightSidebarTablist()`, `rightSidebarTabItem()`, `rightSidebarPanel()` and `rightSidebarTabContent()` were removed. They are now replaced by `dashboardControlbar()`, `controlbarMenu()` and `controlbarItem()`. See the [changelog](https://rinterface.github.io/shinydashboardPlus/news/index.html) – ismirsehregal Dec 06 '21 at 08:34
2

Adding to teofil's answer, you can use selector = "body" instead so the right sidebar can still be opened and closed.

shinyjs::addClass(selector = "body", class = "control-sidebar-open")
shinyjs::removeClass(selector = "body", class = "control-sidebar-open")
CPB
  • 31
  • 3
1

An alternative solution is to use shiny::tabsetPanel instead of shinydashboardPlus::rightSidebarTabContent.

To use tabsetPanel inside of the right sidebar, but still look something like shinydashboard's right sidebar tabset panel requires some CSS styling include removing the dark space at the top of the right sidebar panel and changing the 'active' and 'hover' colours of the tabpanel.

Showing/hiding tabPanel merely requires using showTab and hideTab. It is possible to use the select argument of showTab to just select the tab, without necessarily hiding the other tabs.

As a bonus, I've also add a rintrojs walkthrough. As the code stands, the change in panels during the walkthrough can't be 'seen', but it is happening!

Thanks to CPB's answer, which showed the best way to show/hide the right sidebar.

library(shiny)
library(shinyjs)
library(shinyWidgets)
library(shinydashboard)
library(shinydashboardPlus)
library(dashboardthemes)
library(rintrojs)

ui <- dashboardPagePlus(
  rintrojs::introjsUI(),
  header = dashboardHeaderPlus(
    title = "Dashboard",
    enable_rightsidebar = TRUE,
    rightSidebarIcon = "info-circle"
  ),
  sidebar = dashboardSidebar(
    sidebarMenu(
      menuItem("Section A", tabName = "Section_A", icon = icon("map")),
      menuItem("Section B", tabName = "Section_B", icon = icon("chart-line")),
      menuItem("Section C", tabName = "Section_C", icon = icon( "gears")),
      id = "nav"
    )
  ),
  body = dashboardBody(
    shinyDashboardThemes(
      theme = "grey_dark"
    ),
    tabItems(
      tabItem(
        tabName = "Section_A",
        p("Some content for section A")),
      tabItem(
        tabName = "Section_B",
        p("Some content for section B")),
      tabItem(
        tabName = "Section_C",
        p("Some content for section C"))
    ),
    shiny::actionButton("walkthrough", "Overview of tabs")
    # this will start an rintrojs walkthrough
  ),
  rightsidebar = rightSidebar(
    shiny::tags$head(shiny::tags$style(shiny::HTML(
      ".control-sidebar-tabs {display:none;}
    .tabbable > .nav > li > a:hover {background-color: #333e43; color:white}
    .tabbable > .nav > li[class=active] > a   {background-color: #222d32;  color:white}"))),
    # '{display:none;}' removes empty space at top of rightsidebar
    # https://stackoverflow.com/questions/59289622/
    #  remove-the-dark-space-at-the-top-of-the-right-sidebar-in-a-shinydashboardplus
    # '.tabbable etc.' change tabpanel tab colouring on hover and active to be
    # more like shinydashboardPlus::rightSidebarTabContent
    # https://stackoverflow.com/questions/35025145/
    #  background-color-of-tabs-in-shiny-tabpanel
    # https://stackoverflow.com/questions/47798850/
    #  change-background-color-of-tabpanel-when-it-is-active-or-hover-over-in-shiny
    useShinyjs(),

    background = "dark",
    shiny::tabsetPanel(
      id = "myrightpanel",
      shiny::tabPanel(
        shiny::icon("desktop"),
        value = "T_A",
        shiny::div(id = "first-panel",
                   p("Some content relevant for section A"),
                   sliderInput(
                     "obs",
                     "Number of observations:",
                     min = 0, max = 1000, value = 500
                   ))
      ),
      shiny::tabPanel(
        shiny::icon("calendar-alt"),
        value = "T_B",
        p("Some content relevant for section B"),
        textInput("caption", "Caption", "Data Summary")
      )
    )
  ),
  title = "Right Sidebar"
)


server <- function(input, output, session) {
  observe({
    if (req(input$nav) == "Section_A"){
      message("Section A has been selected")
      shinyjs::addClass(selector = "body", class = "control-sidebar-open")
      shiny::showTab(inputId = "myrightpanel",
                     target = "T_A", select = TRUE)
      shiny::hideTab(inputId = "myrightpanel",
                     target = "T_B")
    }
    if (req(input$nav) == "Section_B"){
      shinyjs::addClass(selector = "body", class = "control-sidebar-open")
      shiny::showTab(inputId = "myrightpanel",
                     target = "T_B", select = TRUE)
      shiny::hideTab(inputId = "myrightpanel",
                     target = "T_A")
    }
    if (req(input$nav) == "Section_C"){
      message("Section C has been selected")
      shinyjs::removeClass(selector = "body", class = "control-sidebar-open")
    }
  })

  walkthrough_df <-
    data.frame(element = "#first-panel",
               intro = c(paste(shiny::tags$h4("My first tab"),
                               shiny::br(),
                               "Has a slider input")),
               stringsAsFactors = FALSE)
  walkthrough_df <-
    rbind(walkthrough_df,
          data.frame(element = "#caption",
                     intro = c(paste(shiny::tags$h4("My second panel text input"),
                                     shiny::br(),
                                     "Has a text input. The tabs has changed"))))

  walkthrough <- reactive(walkthrough_df)

  shiny::observeEvent(input$walkthrough, {
    shinyjs::addClass(selector = "body", class = "control-sidebar-open") # open right sidebar
    shiny::showTab(inputId = "myrightpanel", target = "T_A")
    shiny::showTab(inputId = "myrightpanel", target = "T_B") # show both tabs
    shinyjs::delay(1000, # need to delay for the above showTab changes to be enacted
                   rintrojs::introjs(session, options = list(steps = walkthrough(),
                                                             overlayOpacity = 0.3),
                                     events = list(onbeforechange = I("rintrojs.callback.switchTabs(targetElement)")))
    )
  })
}

shinyApp(ui = ui, server = server)
David Fong
  • 506
  • 4
  • 3