Adjust plotly output height to box with dynamic height in shiny dashboard - r

Question

In the shiny app below I have a box which height depends on the number of shiny widgets it includes and a plot. I would like the box height to somehow saved every time it changes and be passed to the plot in order to have the same height always.
library(shiny)
library(plotly)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
# Copy the line below to make a set of radio buttons
radioButtons("radio1", label = h3("Radio buttons"),
choices = list("Choice 1" = 1, "Choice 2" = 2),
selected = 1)
),
dashboardBody(
fluidRow(
column(4,
box(
# Copy the line below to make a set of radio buttons
radioButtons("radio2", label = h3("Radio buttons"),
choices = list("Choice 1" = 1, "Choice 2" = 2, "Choice 3" = 3),
selected = 1),
uiOutput("rd3")
)),
plotlyOutput("t2")
)
)
)
server <- function(input, output, session) {
output$rd3<-renderUI({
if(input$radio1==1){
return(NULL)
}
else{
radioButtons("radio3", label = h3("Radio buttons"),
choices = list("Choice 1" = 1, "Choice 2" = 2, "Choice 3" = 3),
selected = 1)
}
})
output$t2<-renderPlotly(
fig <- plot_ly(data = iris, x = ~Sepal.Length, y = ~Petal.Length)
)
}
shinyApp(ui, server)

Answer 1

The following works based on spsComps::heightMatcher.
However, I needed to trigger a resize event via shinyjs to avoid the plot height getting out of sync after a few clicks, which I think should not be necessary (also makes it quite slow).
library(shiny)
library(plotly)
library(shinydashboard)
library(spsComps)
library(shinyjs)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(# Copy the line below to make a set of radio buttons
radioButtons(
"radio1",
label = h3("Radio buttons"),
choices = list("Choice 1" = 1, "Choice 2" = 2),
selected = 1
)),
dashboardBody(
useShinyjs(),
fluidRow(
column(4,
box(
id = "box_1",
# Copy the line below to make a set of radio buttons
radioButtons(
"radio2",
label = h3("Radio buttons"),
choices = list(
"Choice 1" = 1,
"Choice 2" = 2,
"Choice 3" = 3
),
selected = 1
),
uiOutput("rd3")
)),
box(id = "box_2", plotlyOutput("t2", height = "100%")),
spsComps::heightMatcher("box_2", "box_1")
)
)
)
server <- function(input, output, session) {
observeEvent(input$radio1, {
shinyjs::runjs("$(window).trigger('resize');")
})
output$rd3 <- renderUI({
if (input$radio1 == 1) {
return(NULL)
} else {
radioButtons(
"radio3",
label = h3("Radio buttons"),
choices = list(
"Choice 1" = 1,
"Choice 2" = 2,
"Choice 3" = 3
),
selected = 1
)
}
})
output$t2 <- renderPlotly({fig <-
plot_ly(
data = iris,
x = ~ Sepal.Length,
y = ~ Petal.Length
)})
}
shinyApp(ui, server)