Search code examples
rbootstrap-4shinyplotlyr-plotly

Fit Plotly Subplot in Bootstrap Card

In the reproducible code below plot 1 looks fine in terms of its width/height, but I'd like to expand plot 2 in terms of its height so the subplots don't seem so "squished" together. Does anyone have a suggestion on how to do that so it stays nicely within the card but expands responsively with the number of subplots? In this example, there are five subplots, but that could be any number (usually 2 to 7 or so).

library(shiny)
library(bslib)
library(shinyWidgets)
library(plotly)

card <- function(body, title) {
  div(class = "card",
    div(icon("chart-line", style = "color:white"), class = "card-header bg-success text-white text-center font-weight-bold", title),
    div(class = "card-body d-flex justify-content-center", body)
  )
}

ui <- fluidPage(

    navbarPage(
        theme = bs_theme(bootswatch = "flatly", version = 4),
        title = 'Methods',
        tabPanel('One'),
    ),
    mainPanel(
        h1('Hello World'),      
        
    uiOutput('p1'),
    br(),
    uiOutput('p2'),

        
    )
)

server <- function(input, output) {

    output$p1 <- renderUI({
        fig <- plot_ly(data = iris, x = ~Sepal.Length, y = ~Petal.Length)
        card(fig, 'Plot 1: Looks Good')
    })

    
    ### I could do this
    output$p2 <- renderUI({
    vars <- setdiff(names(economics), "date")
    plots <- lapply(vars, function(var) {
      plot_ly(economics, x = ~date, y = as.formula(paste0("~", var))) %>%
        add_lines(name = var)
    })  
        card(subplot(plots, nrows = length(plots), shareX = TRUE, titleX = FALSE), 'Plot 2: Too Squished')
    })

}

shinyApp(ui, server)
Solution

  • We can use plotlyOutput and pass a height parameter corresponding to the number of subplots:

    library(shiny)
library(bslib)
library(shinyWidgets)
library(plotly)

card <- function(body, title) {
  div(class = "card",
      div(icon("chart-line", style = "color:white"), class = "card-header bg-success text-white text-center font-weight-bold", title),
      div(class = "card-body d-flex justify-content-center", body)
  )
}

ui <- fluidPage(
  navbarPage(
    theme = bs_theme(bootswatch = "flatly", version = 4),
    title = 'Methods',
    tabPanel('One'),
  ),
  mainPanel(
    h1('Hello World'),
    uiOutput('p1'),
    br(),
    uiOutput('p2'),
  )
)

server <- function(input, output) {
  output$p1 <- renderUI({
    fig <- plot_ly(data = iris, x = ~Sepal.Length, y = ~Petal.Length)
    card(fig, 'Plot 1: Looks Good')
  })
  
  output$plotlyOut <- renderPlotly({
    vars <- setdiff(names(economics), "date")
    plots <- lapply(vars, function(var) {
      plot_ly(economics, x = ~date, y = as.formula(paste0("~", var))) %>%
        add_lines(name = var)
    })  
    subplot(plots, nrows = length(plots), shareX = TRUE, titleX = FALSE)
  })
  
  output$p2 <- renderUI({
    nSubplots <- length(setdiff(names(economics), "date"))
    card(plotlyOutput("plotlyOut", height = paste0(nSubplots*200, "px")), 'Plot 2: Looks Good?')
  })
}

shinyApp(ui, server)

    result