Show output of dashboardBody when rightSidebarTabContent id selected in shinyDashboard - r

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)

Answer 1

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)