在引導卡中安裝 Plotly 子圖

Question

在 plot 1 下面的可重現代碼中，它的寬度/高度看起來不錯，但我想擴展 plot 2 的高度，因此子圖看起來不會那么“擠壓”在一起。 有沒有人有關於如何做到這一點的建議，以便它很好地保持在卡片內，但隨着子圖的數量而響應擴展？ 在此示例中，有五個子圖，但可以是任何數字（通常是 2 到 7 左右）。

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) 

Answer 1

我們可以使用plotlyOutput並傳遞一個與子圖數量相對應的height參數：

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)