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%在box中不能与shinydashboard一起使用。根据{{​​3}}，只能通过JavaScript进行操作，因为布局尺寸是通过JavaScript初始化的。

解决方案

计算实际窗口高度

这包括两个部分：

• 最初计算和设置高度（计算高度的确切像素数：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();
});

修改用户界面

在用户界面侧，为该框提供一个ID或类，以便您可以使用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)