闪亮：情节的动态高度调整

debugcn 发表于 Dev

牛皮纸

问题：在下面的Shiny应用程序中，用户可以根据选择的输入来添加显示在值框中的信息。如果用户选择了所有可能的选项，则UI看起来如屏幕截图所示。

问题：绘图（与值框在同一行中）的高度是否有可能调整（因此，绘图的底部与最后一个值框的底部对齐）？

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(),
  
  dashboardSidebar(
    selectizeInput(
      inputId = "select",
      label = "Select country:",
      choices = c("CH", "JP", "GER", "AT", "CA", "HK"),
      multiple = TRUE)
  ),
  
  dashboardBody(
    fluidRow(column(2, uiOutput("ui1")),
             column(10, plotOutput("some_plot"))))#,
                # column(4, uiOutput("ui2")),
                # column(4, uiOutput("ui3")))
)

server <- function(input, output) {
  
  output$ui1 <- renderUI({
    req(input$select)
    
    lapply(seq_along(input$select), function(i) {
      fluidRow(
        valueBox(value = input$select[i],
                 subtitle = "Box 1",
                 width = 12)
      )
    })
  })
  
  output$some_plot <- renderPlot(
    plot(iris)
  )
}

shinyApp(ui = ui, server = server)

YBS

您可以在中调整高度renderPlot。我已将最小值设置为3值框高度。因此，添加3个值框后，它开始增加高度。您可以根据需要对其进行修改。试试下面的代码。

  library(shiny)
  library(shinydashboard)
  
  ui <- dashboardPage(
    dashboardHeader(),
    
    dashboardSidebar(
      selectizeInput(
        inputId = "select",
        label = "Select country:",
        choices = c("CH", "JP", "GER", "AT", "CA", "HK"),
        multiple = TRUE)
    ),
    
    dashboardBody(
      fluidRow(column(2, uiOutput("ui1")),
               column(10, plotOutput("some_plot"))))#,
    
    # column(4, uiOutput("ui2")),
    # column(4, uiOutput("ui3")))
  )
  
  server <- function(input, output) {
    plotht <- reactiveVal(360)
    observe({
      req(input$select)
      nvbox <- length(input$select)
      if (nvbox > 3) {
        plotheight <- 360 + (nvbox-3)*120
      }else plotheight <- 360
      plotht(plotheight)
    })
    
    output$ui1 <- renderUI({
      req(input$select)
      
      lapply(seq_along(input$select), function(i) {
        fluidRow(
          valueBox(value = input$select[i],
                   subtitle = "Box 1",
                   width = 12)
        )
      })
    })
    
    observe({
      output$some_plot <- renderPlot({
        plot(iris)
      }, height=plotht())
    })
 
    
  }
  
  shinyApp(ui = ui, server = server)