Expand/Collapse shiny box on header click - r

Question

I have developed a shiny app, where we are using various box object in the ui. Currently the boxes expand/Collapse by clicking on the "+/-" sign on the right of the box header, but we need the expand/collapse on click on the header (anywhere on the box header).
Below code (sample code)
If you look at the box with chart, I want the expansion & collapse to be performed on clicking the header i.e. "Histogram box title" and not just the "+/-" sign on right side of the header:
## Only run this example in interactive R sessions
if (interactive()) {
library(shiny)
# A dashboard body with a row of infoBoxes and valueBoxes, and two rows of boxes
body <- dashboardBody(
# Boxes
fluidRow(
box(title = "Histogram box title",
status = "warning", solidHeader = TRUE, collapsible = TRUE,
plotOutput("plot", height = 250)
)
)
)
server <- function(input, output) {
output$plot <- renderPlot({
hist(rnorm(50))
})
}
shinyApp(
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(),
body
),
server = server
)
}

Answer 1

This is easily achievable using javascript. You just have to create a javascript function and call the same in your header code. Refer to below code for better understanding. I have provided 3 options, let me know if this works for you.
## Only run this example in interactive R sessions
if (interactive()) {
library(shiny)
# javascript code to collapse box
jscode <- "
shinyjs.collapse = function(boxid) {
$('#' + boxid).closest('.box').find('[data-widget=collapse]').click();
}
"
# A dashboard body with a row of infoBoxes and valueBoxes, and two rows of boxes
body <- dashboardBody(
# Including Javascript
useShinyjs(),
extendShinyjs(text = jscode),
# Boxes
fluidRow(
box(id="box1",title = actionLink("titleId", "Histogram box title",icon =icon("arrow-circle-up")),
status = "warning", solidHeader = TRUE, collapsible = T,
plotOutput("plot", height = 250)
),
box(id="box2",title = p("Histogram box title",
actionButton("titleBtId", "", icon = icon("arrow-circle-up"),
class = "btn-xs", title = "Update")),
status = "warning", solidHeader = TRUE, collapsible = T,
plotOutput("plot1", height = 250)
),
box(id="box3",title = actionButton("titleboxId", "Histogram box title",icon =icon("arrow-circle-up")),
status = "warning", solidHeader = TRUE, collapsible = T,
plotOutput("plot2", height = 250)
)
)
)
server <- function(input, output) {
output$plot <- renderPlot({
hist(rnorm(50))
})
output$plot1 <- renderPlot({
hist(rnorm(50))
})
output$plot2 <- renderPlot({
hist(rnorm(50))
})
observeEvent(input$titleId, {
js$collapse("box1")
})
observeEvent(input$titleBtId, {
js$collapse("box2")
})
observeEvent(input$titleboxId, {
js$collapse("box3")
})
}
shinyApp(
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(),
body
),
server = server
)
}

Answer 2

You can do this for all boxes in an app with a few lines of external css and javascript.
The JS triggers a click on the widget when you click on the header title. It has to be the h3 element because the widget is inside .box-header, which would cause infinite recursion.
$('.box').on('click', '.box-header h3', function() {
$(this).closest('.box')
.find('[data-widget=collapse]')
.click();
});
But then we need to make the h3 element fill the full .box-header, so get rid of the header padding (except on the right), add it to the h3, and make the h3 fill 100% of the width of the box.
.box-header {
padding: 0 10px 0 0;
}
.box-header h3 {
width: 100%;
padding: 10px;
}

Answer 3

I think Lisa DeBruine answer is the better one since you can click the whole header and not just the title.
Pasted it into a small example:
if (interactive()) {
body <- dashboardBody(
useShinyjs(),
tags$style(HTML("
.box-header {
padding: 0 10px 0 0;
}
.box-header h3 {
width: 100%;
padding: 10px;
}")),
fluidRow(
box(id="box1", title = "Histogram box title",
status = "warning", solidHeader = TRUE, collapsible = T,
plotOutput("plot", height = 250)
)
)
)
server <- function(input, output) {
output$plot <- renderPlot({
hist(rnorm(50))
})
runjs("
$('.box').on('click', '.box-header h3', function() {
$(this).closest('.box')
.find('[data-widget=collapse]')
.click();
});")
}
shinyApp(
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(),
body
),
server = server
)
}