Leaflet Shiny Integration slow

Question

我正在嘗試使用傳單在Shiny中構建交互式Choropleth。但是，加載時間和重新創建時間非常慢。任何方式來加快它。

這裏是一個鏈接到整個應用程序的文件夾與數據一起： https://www.dropbox.com/home/Leaflet_Shiny_app

global.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 
) 

server.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簡化幾何，使其更快。

這是我did-

# 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，而不是國家的代碼即可。