Shinydashboard：选项卡框中项目的垂直渲染不正确

Question

我正在使用shinydashboards tabboxes，但在tabbox 中fluidrows 的垂直对齐存在问题，因此我的绘图顶部会出现一个按钮。

tabbox 中的第一个选项卡在各自的流体行中包含一个绘图和下载按钮，第二个选项卡包含一个datatable 和下载按钮，每个在各自的流体行中。该图是一个 facet_grid，为了使其可见，我在我的服务器中指定了图的高度。绘图正确渲染，但UI 在渲染按钮并将按钮渲染在绘图顶部时似乎没有响应指定的高度。

我还使用服务器中的数据选项卡指定数据表对象的高度； renderDataTable(options = list(scrollY = "400px"){}。

在这种情况下，数据选项卡中的按钮呈现在数据表下方的正确垂直位置。

以下是仪表板结构的可重现示例。任何关于为什么图形选项卡中的按钮呈现在绘图顶部的输入将不胜感激。

谢谢

library(shiny)
library(shinyBS)
library(shinydashboard)
library(dplyr)
library(ggplot2)
library(lubridate)
library(DT)
library(tidyr)

# load data in long format
dat <- mtcars
dat <- dat %>%
  select(c("mpg", "cyl", "disp", "drat", "wt")) %>%
  gather(key = "key", value = "value", cyl, disp, drat, wt )


#############################
#The dashboard
############################

header <- dashboardHeader(title = "Title", titleWidth = 450)

sidebar <- dashboardSidebar(
  sidebarMenu(
    menuItem("Model", icon = icon("dashboard"), tabName = "model")
  )
)

body <- dashboardBody(
  tabItems(

    #====================================
    tabItem(tabName = "model",
            #===========
          fluidRow(
                           tabBox(side="left",
                                  width = 8,
                                  height = "700px",
                                  title = "",
                                  id = "model_tab",
                                  tabPanel("Graph",
                                           column(width = 12,
                                                    fluidRow(
                                                      plotOutput("plot")
                                                      ), # close fluidRow
                                                    fluidRow(
                                                      downloadButton("plot_download")
                                                      )  #close fluidRow
                                                ) #close column
                                          ),   #close tabPanel

                                  tabPanel("Data",
                                             column(width = 12,
                                               fluidRow(
                                                 DT::dataTableOutput("data", 
                                                                   height = "350px")
                                                 ), #close fluidRow
                                               fluidRow(
                                                 downloadButton("data_download")
                                                ) # close fluidRow
                                             ) #close column
                                          ) # close tabPabel
                           ), # close tabBox

            #=========== 
            sidebarPanel(width = 4,
                         align = "left",

                         title = "User controls",
                         color = "fuchsia", 
                         solidHeader = TRUE, 

                         sliderInput("mpg",
                                "mpg",
                                min = 1,
                                max = 100,
                                value = 10),


                         sliderInput("cyl",
                                        "cyl",
                                        min = 5,
                                        max = 50,
                                        value = 10),


                         sliderInput("disp",
                                        "disp",
                                        min = 5,
                                        max = 50,
                                        value = 10),


                         sliderInput("drat",
                                        "drat",
                                        min = 100,
                                        max = 300,
                                        value = 155),



                         dateRangeInput("date_range", 
                                   "Date range", 
                                   start=as.Date('2020-04-01') , 
                                   end = as.Date('2025-03-01'),
                                   format = "yyyy-mm-dd")#,


          )  #close sidebarpanel
          ) #close fluidRow
        )  #close tabItem
  ) #close tabItems
)  #close dashboardBody

#################################################
ui <- dashboardPage(header, 
                    sidebar, 
                    body, 
                    skin= "purple")
#################################################

# Define server logic required to draw a histogram
server <- function(input, output, session) {




   output$plot <- renderPlot({
     plt <- ggplot(dat, aes(x=value, y=mpg))+
       geom_point()+
       facet_grid(rows=vars(unique(dat$key)))
     plt

   plt
  }, height = 600)





  output$plot_download <- downloadHandler(
    filename = function() { paste(input$dataset, '.png', sep='') },
    content = function(file) {
      png(file)
      print(plotInput())
      dev.off()
    })


  output$data <- renderDataTable(options = list(scrollY = "400px"), {
    dat
  })

  output$HOW_data_download <- downloadHandler(
    filename = "data.csv",
    content = function(file) {
      write.csv(dat, file, row.names = FALSE)
    }
  )

  }


# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

如果你像这样plotOutput("plot", height = "600px") 在 ui 中指定你的高度，它应该会正确呈现