0
votes

I am trying to build an interactive Choropleth in Shiny using leaflet. However, the load time and recreate time is really slow. Any way to speed it up.

Here is a link to the entire app folder along with the data: 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")
  })

}
1
You're downloading the data every single time the user changes their selection. Do more preprocessing (like downloading data) at startup. - yeedle
I downloaded the data for all the years in the very beginning and subset for the year user selected as reactive expression. That didn't help either. Any other suggestion? - arjan-hada
Download it in another script and save it to an .Rdata file. Then load that file for your program once, but at the beginning outside of the reactive. Subset that loaded dataframe in the reactive as needed. Just common sense really. That should make things a lot faster. - Mike Wise
Hello, @MikeWise I updated my code as suggested, however, the app is still running very slow. Could you please have a look? - arjan-hada
Hello, @yeedle I updated my code as suggested, however, the Shiny app is still running slow. Can you please have a look? - arjan-hada

1 Answers

3
votes

Simplifying geometries using rmapshaper::ms_simplify helped make it a lot faster.

This is what I 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)

I used countries_simple instead of countries in the code then.