plot height fill allotted area on screen (auto,100%, 100vh, etc.)

[kramerrs]

I would like the plots to fill the allocated areas. Either plotly and or inclusively ggplot or other plots.

It is frustrating because I am trying to replicate a dashboard from flexdashboard, and flexdashboard seems to handle this case. In flexdashboard there is something in the flexdashboard.min.css that makes it work. I am unable to reproduce it with plotly. It appears that plotly doesn't respect the height adjustment, except it does in flexdashboard. Also, in the example below neither ggplot or plotly automatically set height to fill.

Here is reprex, though I have tried a number of different combinations. The only thing that appears to work with shinydashboard is to catch the resize event on the server side and rerender the plot.

library(shiny)
library(shinydashboard)
library(ggplot2)
#library(leaflet)
library(plotly)

Sample data

set.seed(123)
sample_data <- data.frame(
category = sample(letters[1:5], 100, replace = TRUE),
x = rnorm(100),
y = rnorm(100),
lat = runif(100, 35, 45),
lng = runif(100, -100, -90)
)

UI

ui <- dashboardPage(
dashboardHeader(title = "Interactive Dashboard"),
dashboardSidebar(
sidebarMenu(
menuItem("Controls", tabName = "controls", icon = icon("sliders")),
menuItem("Plots", tabName = "plots", icon = icon("chart-line"))
)
),
dashboardBody(
fillPage( tabItems(
tabItem(tabName = "controls",
fluidRow( style='height:40vh',
box(
title = "Inputs", width = 4,
sliderInput("slider", "Number of Points:", min = 10, max = 100,
value = 50),
checkboxInput("show_plotly", "Show Plotly Plot", value = TRUE),
checkboxInput("show_leaflet", "Show Leaflet Map", value = TRUE),
selectInput("category", "Select Category:",
choices = unique(sample_data$category)),
actionButton("update", "Update")
)
)),
tabItem(tabName = "plots",
fluidRow( style='height:100vh',
box(title = "ggplot2 Scatter Plot", width = 6, plotOutput("ggplot" )),
box(title = "Plotly Interactive Plot", width = 6, plotlyOutput("plotly" ))
))
))
)
)

Server

server <- function(input, output, session) {

filtered_data <- reactive({
sample_data[sample_data$category == input$category, ]
})

output$ggplot <- renderPlot({
ggplot(filtered_data(), aes(x = x, y = y)) +
geom_point() +
theme_minimal() +
labs(title = "Scatter Plot (ggplot2)", x = "X-Axis", y = "Y-Axis")
})

output$plotly <- renderPlotly({
if (input$show_plotly) {
plot_ly(filtered_data(), x = ~x, y = ~y, type = 'scatter', mode = 'markers' ) %>%
layout(title = "Interactive Scatter Plot (Plotly)",
xaxis = list(title = "X-Axis"), yaxis = list(title = "Y-Axis"))
}
})

output$leaflet <- renderLeaflet({

if (input$show_leaflet) {

leaflet(filtered_data()) %>%

addTiles() %>%

addMarkers(~lng, ~lat, popup = ~paste("X:", x, "
Y:", y)) %>%

setView(lng = mean(filtered_data()$lng), lat = mean(filtered_data()$lat),

zoom = 4)

}

})

}

Run the app

shinyApp(ui, server)

[YongbingDing]

您好，丁永兵已经收到您的邮件，谢谢。