R Shiny 中盒子的高度

Question

我希望包含我的地图的框具有 100% 的高度，以便它适合所有屏幕。目前，当我缩小窗口时，盒子没有到达底部并且不适应

dashboardBody(
      tabItems(
        #--------- ELEMENTS TAB "carte" --------#
        tabItem(tabName ="carte",
                fluidRow(
                  box(
                    width = 3,
                    title = "Settings",
                    status = "primary",
                    solidHeader = TRUE,
                    collapsible = TRUE,
                    useShinyalert(),br(),
                    fileInput(inputId = "zip", label = "Upload your file (.zip) :", multiple = FALSE, accept = c('.zip')), 
                    checkboxGroupInput(inputId ="indice", label ="Choose a spectral index (multiple choice possible) :", choices = c("NDVI", "NDWIGAO", "NDWIMCF", "MNDWI")),br(),
                    dateRangeInput(inputId ="dates", label = "Select the date range :", start = "", end = ""), br(),
                    textInput(inputId = "mail", label = "Enter your email address :"), br(),br(),
                    useShinyjs(),
                    extendShinyjs(text = jsResetCode),
                    div(style = "display:inline-block", actionButton("reset_button", "Refresh", icon("refresh", lib ="glyphicon"))),
                    div(style = "display:inline-block", actionButton("send", "Send now !", icon("send", lib = "glyphicon"), style = "background-color : #000000 ; color : #fff ; border-color : #717878"))                 
                  ),

                  box(
                    width = 9,
                    title = "Map",
                    status = "primary",
                    solidHeader = TRUE,
                    collapsible = FALSE,
                    height = "100%",
                    leafletOutput(outputId = "map", width="100%", height = 940)
                  )
                )
        ),

Answer 1

不幸的是height: 100%不能与boxin 一起使用shinydashboard。根据这个Github Issue只能通过 JavaScript 实现，因为布局大小是通过 JavaScript 启动的。

解决方案

计算实际窗口高度

这包括两部分：

• 最初计算和设置高度（计算 height: 100% 会给出的确切像素数。）
• 在用户调整浏览器窗口大小时随时修改它。

该代码将高度设置box为window height - header height - 30px (top and bottom margins)。

例如：如果窗口高度为 960px，dashboardHeader 为 50px，则输出元素的高度将为960 - 50 - 30 = 880px.

tags$head(tags$script('
// Define function to set height of "map" and "map_container"
setHeight = function() {
  var window_height = $(window).height();
  var header_height = $(".main-header").height();

  var boxHeight = window_height - header_height - 30;

  $("#map_container").height(boxHeight);
  $("#map").height(boxHeight - 20);
};

// Set input$box_height when the connection is established
$(document).on("shiny:connected", function(event) {
  setHeight();
});

 // Refresh the box height on every window resize event    
$(window).on("resize", function(){
  setHeight();
});

修改界面

在 UI 端，给 box 一个 id 或 class，这样你就可以用 JS 代码设置它。即：我将盒子的 id 设置为"map_container".

box(id = "map_container",
  leafletOutput("map")
)

完整代码

使用基本shinydashboard示例

library(shiny)
library(shinydashboard)
library(leaflet)

ui <- dashboardPage(
  dashboardHeader(title = "Basic dashboard"),
  dashboardSidebar(),
  dashboardBody(
    tags$head(tags$script('
      // Define function to set height of "map" and "map_container"
      setHeight = function() {
        var window_height = $(window).height();
        var header_height = $(".main-header").height();

        var boxHeight = window_height - header_height - 30;

        $("#map_container").height(boxHeight);
        $("#map").height(boxHeight - 20);
      };

      // Set input$box_height when the connection is established
      $(document).on("shiny:connected", function(event) {
        setHeight();
      });

      // Refresh the box height on every window resize event    
      $(window).on("resize", function(){
        setHeight();
      });
    ')),
    # Boxes need to be put in a row (or column)
    fluidRow(
      box(id = "map_container",
        leafletOutput("map")
      ),

      box(
        title = "Controls",
        sliderInput("slider", "Number of observations:", 1, 100, 50)
      )
    )
  )
)

server <- function(input, output) {
  set.seed(122)
  histdata <- rnorm(500)

  output$map <- renderLeaflet( {
    leaflet() %>%
      addProviderTiles(providers$Stamen.TonerLite,
                       options = providerTileOptions(noWrap = TRUE)
      ) %>%
      addMarkers(data = cbind(rnorm(40) * 2 + 13, rnorm(40) + 48))
  })
}

shinyApp(ui, server)