传单闪亮集成缓慢

Question

我正在尝试使用传单在 Shiny 中构建交互式 Choropleth。但是，加载时间和重新创建时间确实很慢。有什么办法可以加快速度吗

这里是整个应用程序文件夹以及数据的链接： https://www.dropbox.com/home/Leaflet_Shiny_app

全球.R

library(shinydashboard)
library(tidyverse)
library(ggvis)
library(leaflet)
library(WDI)
library(sp)

ui.R

header <- dashboardHeader(
  title = "Greenhouse gas (GHG) emissions"
  )

## Sidebar content
sidebar <- dashboardSidebar(
  sidebarMenu(
    menuItem("Interactive Choropleth", tabName = "choropleth")
  )
)  

## Body content
body <- dashboardBody(
    
  # First tab content
  tabItem("choropleth",
          
    fluidRow(
      column(width = 9,
        box(width = NULL, solidHeader = TRUE,
            title = "Greenhouse gas emissions (kt of CO2 equivalent)",
            leafletOutput("choropleth_ghg", height = 500)
        )
      ),
      column(width = 3,
        box(width = NULL, status = "warning",
          selectInput("year", "Year", 
                        choices = seq(1970, 2012, 1), 
                        selected = 2012)
        )
      )
    )
  )
)

dashboardPage(
  header,
  sidebar,
  body
)

服务器.R

# Read the dataset for choropleth
# From http://data.okfn.org/data/core/geo-countries#data
countries <- geojsonio::geojson_read("json/countries.geojson", what = "sp")

# Download the requested data by using the World Bank's API, 
# parse the resulting JSON file, and format it in long country-year format.
load("who_ghg.RData")

function(input, output, session) {
  
  # Interactive Choropleth map.........................................................
  
  # Reactive expression for the data subsetted to what the user selected
  countries_plus_ghg <- reactive({
    
    # Filter the data to select for the year user selected
    who_ghg_subset <- filter(who_ghg, year == input$year)
    
    # Merge a Spatial object having a data.frame for Choropleth map
    sp::merge(countries, who_ghg_subset, 
              by.x = "ISO_A3", by.y = "iso3c")
  })
  
  # Create the map
  output$choropleth_ghg <- renderLeaflet({
    leaflet(countries) %>% 
      setView(0, 20, zoom = 1) %>%
      addTiles()
  })
  
  # Observer to change the color of countries, labels and legends
  # based on the year user selects in the UI
  observe({
    dat <- countries_plus_ghg()
    
    # Define numeric vector bins to add some color
    bins <- ggplot2:::breaks(c(min(dat$EN.ATM.GHGT.KT.CE, na.rm = TRUE)
                               ,max(dat$EN.ATM.GHGT.KT.CE, na.rm = TRUE)),
                             "width",n = 5)
    
    # Call colorBin to generate a palette function that maps the RColorBrewer 
    #"YlOrRd" colors to our bins.
    pal <- colorBin("YlOrRd", 
                    domain = dat$EN.ATM.GHGT.KT.CE, 
                    bins =  bins)
    
    # Generate the labels with some HTML
    labels <- sprintf(
      "<strong>%s</strong><br/>%g",
      dat$country, dat$EN.ATM.GHGT.KT.CE
    ) %>% lapply(htmltools::HTML)
    
    leafletProxy("choropleth_ghg", data = dat) %>% 
      addPolygons(
        fillColor = ~pal(EN.ATM.GHGT.KT.CE),
        weight = 1,
        opacity = 1,
        color = "white",
        fillOpacity = 0.7,
        highlight = highlightOptions(
          weight = 2,
          color = "#666",
          dashArray = "",
          fillOpacity = 0.7,
          bringToFront = TRUE),
        label = labels,
        labelOptions = labelOptions(
          style = list("font-weight" = "normal", padding = "3px 8px"),
          textsize = "15px",
          direction = "auto")) %>% 
      clearControls() %>% 
      addLegend(pal = pal, values = ~EN.ATM.GHGT.KT.CE, opacity = 0.7, title = NULL,
                position = "bottomleft")
  })
  
}

Answer 1

使用 rmapshaper::ms_simplify 简化几何形状有助于使其速度更快。

这就是我所做的-

# Topologically-aware geometry simplification using rmapshaper package, 
# keep = proportion of points to retain
countries_simple <- rmapshaper::ms_simplify(countries, keep = 0.05, keep_shapes = TRUE)

我当时在代码中使用了countries_simple而不是country。