Show output of dashboardBody when rightSidebarTabContent id selected in shinyDashboard

Question

How I am able to show the output of dashboardBody when the id of rightSidebarTabContent selected. If id = "tab_1", selected, show the verbatimTextOutput("tab1") and so on. I used shinyjs::show and shinyjs::hide, but it's not working. Any suggestion?


library(shiny)
library(shinydashboard)
library(shinyjs)
  ui <- dashboardPagePlus(
         header = dashboardHeaderPlus(
                   enable_rightsidebar = TRUE,
                  rightSidebarIcon = "gears"
    ),
    sidebar = dashboardSidebar(),
    rightsidebar = rightSidebar(
      id = "right_sidebar",
      background = "dark",
      rightSidebarTabContent(
        id = "tab_1",
        title = "Tab 1",
        icon = "desktop",
        active = TRUE,
        sliderInput(
          "obs",
          "Number of observations:",
          min = 0, max = 1000, value = 500
        )
      ),
      rightSidebarTabContent(
        id = "tab_2",
        title = "Tab 2",
        textInput("caption", "Caption", "Data Summary")
      ),
      rightSidebarTabContent(
        id = "tab_3",
        icon = "paint-brush",
        title = "Tab 3",
        numericInput("obs", "Observations:", 10, min = 1, max = 100)
      )
    ),
    dashboardBody(
      div(id = "tab1_out", verbatimTextOutput("tab1")),
      div(id = "tab2_out", verbatimTextOutput("tab2")),
      div(id = "tab3_out", verbatimTextOutput("tab3"))
    )
  )

server <-  function(input, output) { 
    
    output$tab1 <- renderPrint({
      "tab1"
    })
    
    output$tab2 <- renderPrint({
      "tab2"
    })
    
    
    output$tab3 <- renderPrint({
      "Tab3"
    })
    
    observeEvent(input$right_sidebar,{
      if(input$right_sidebar == "tab_1"){
        shinyjs::show("tab1_out")
        shinyjs::hide("tab2_out")
        shinyjs::hide("tab3_out")
      }else if(input$right_sidebar == "tab_2"){
        shinyjs::hide("tab1_out")
        shinyjs::show("tab2_out")
        shinyjs::hide("tab3_out")
      }else{
        shinyjs::hide("tab1_out")
        shinyjs::hide("tab2_out")
        shinyjs::show("tab3_out")
      }
    })
    
}

shinyApp(ui, server)

score 0 · Answer 1 · answered Sep 16 '20 at 20:54

I am not sure that you can hide and show the body content from right sidebar. However, you can control the outputs in display page. The code below shows that the body content is still controlled by left sidebar, but the plot display can be changed from the right sidebar. For each tabPanel, you can either choose to have a right sidebar or not.

library(shiny)
library(shinydashboard)
library(shinyjs)
library(shinydashboardPlus)
library(ggplot2)


  header <- dashboardHeaderPlus(
    enable_rightsidebar = TRUE,
    rightSidebarIcon = "gears"
  )
  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"
    )
  )
  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
    background = "dark",
    uiOutput("side_bar"),
    title = "Right Sidebar"
  )

  body <- dashboardBody(
    tabItems(
      tabItem(
        tabName = "Section_A",
        p("Some content for section A"),
        tabPanel(id = "tab_1o", "Tab 1 for Section A", verbatimTextOutput("tab1"), plotOutput("plot1")),
      ),
      tabItem(
        tabName = "Section_B",
        p("Some content for section B"),
        tabPanel(id = "tab_2o", "Tab 2 for Section B", verbatimTextOutput("tab2"), DTOutput("data2") ),
        ),
      tabItem(
        tabName = "Section_C",
        p("Some content for section C"),
        tabPanel(id = "tab_3o", "Tab 3 for Section C", verbatimTextOutput("tab3"), plotOutput("plot3"))
        )
    ),
    tags$script(
      '$("a[data-toggle=\'tab\']").click(function(){
              Shiny.setInputValue("tabactive", $(this).data("value"))
            })'
               )
  )
  

ui <- tags$body(class="skin-blue sidebar-mini control-sidebar-open", dashboardPagePlus( ##  keep the right sidebar open permanently
#ui <- dashboardPagePlus( 
  shinyjs::useShinyjs(),
  header = header,
  sidebar = sidebar,
  body = body,
  rightsidebar = rightsidebar
)
)

server <-  function(input, output) {

  output$tab1 <- renderPrint({
    "tab1"
  })
  output$plot1 <- renderPlot({
    set.seed(122)
    histdata <- rnorm(500)
    data <- histdata[seq_len(req(input$obs1))]
    hist(data)
  })

  output$tab2 <- renderPrint({
    "tab2"
  })
  output$plot2 <- renderPlot(qplot(rnorm(500),fill=I("green"),binwidth=0.2,title="plotgraph2"))
  output$data2 <- renderDT(datatable(iris))

  output$tab3 <- renderPrint({
    "Tab3"
  })
  output$plot3 <- renderPlot(qplot(rnorm(req(input$obs3)),fill=I("blue"),binwidth=0.2,title="plotgraph3"))

  observe({

    if (req(input$nav) == "Section_A"){
      message("tab_1 has been selected")
      
      #shinyjs::addClass(selector = "aside.control-sidebar", class = "control-sidebar-open")
      shinyjs::removeClass(selector = "aside.control-sidebar", class = "control-sidebar-open")
      output$side_bar <- renderUI({
        rightSidebarTabContent(
          id = "tab_1",
          title = "Right sidebar for Section A ",
          icon = "desktop",
          #active = TRUE,
          sliderInput(
            "obs1",
            "Number of observations:",
            min = 0, max = 1000, value = 500
          )
        )

      })
    }
    if (req(input$nav) == "Section_B"){
      message("tab_2 has been selected")
     
      #shinyjs::addClass(selector = "aside.control-sidebar", class = "control-sidebar-open")  ## to add right sidebar
      shinyjs::removeClass(selector = "aside.control-sidebar", class = "control-sidebar-open")  ## remove right sidebar
      output$side_bar <- renderUI({
        rightSidebarTabContent(
          id = "tab_2",
          title = "Right sidebar for Section B ",
          textInput("caption", "Caption", "Data Summary")
        )

      })
    }
    if (req(input$nav) == "Section_C"){
      message("tab_3 has been selected")
      
      #shinyjs::addClass(selector = "aside.control-sidebar", class = "control-sidebar-open")
      shinyjs::removeClass(selector = "aside.control-sidebar", class = "control-sidebar-open")
      output$side_bar <- renderUI({
        rightSidebarTabContent(
          id = "tab_3",
          icon = "paint-brush",
          title = "Right sidebar for Section C",
          numericInput("obs3", "Observations:", 400, min = 1, max = 1000)
        )

      })
    }
  })

}

shinyApp(ui, server)

Thank you, the problem is I don't have sidebar panel, I have only the right sidebar panel. — Ben, Sep 19 '20 at 18:52
In that case, perhaps you can adapt one of the solutions proposed by @ismirsehregal here: https://stackoverflow.com/questions/58842442/connect-shiny-widget-display-with-specific-navbar-tabpanel-selection — YBS, Sep 19 '20 at 22:10

Show output of dashboardBody when rightSidebarTabContent id selected in shinyDashboard

1 Answers1