Home > front end >  How to render a leaflet choropleth map in shiny?
How to render a leaflet choropleth map in shiny?

Time:04-30

I have successfully created an interactive choropleth map using Leaflet in R that projects a single variable across a set of polygons.

library(RSocrata)
library(rgdal)
library(leaflet)
library(sp)
library(dplyr)
#library(mapview)

area_bound <- rgdal::readOGR("https://data.cityofchicago.org/resource/igwz-8jzy.geojson")
area_bound$area_num_1 <- as.numeric(area_bound$area_numbe)
health <- read.socrata("https://data.cityofchicago.org/resource/iqnk-2tcu.json")

data_num <- as.data.frame(apply(health[3:29], 2, as.numeric))
data_num <- bind_cols(health[1:2], data_num)
health_area <- sp::merge(area_bound, data_num, by.x = "area_numbe", by.y = "community_area")

pal <- colorNumeric("viridis", NULL)

leaflet(health_area) %>%
  addTiles() %>%
  addPolygons(stroke = FALSE, smoothFactor = 0.3, fillOpacity = 1,
              fillColor = ~pal(as.numeric(firearm_related)),
              label = ~paste0(community, ": ", formatC(firearm_related, big.mark = ",")))

The health data set has multiple variables and I would like to create a shiny app that allows users to choose a different variable to produce a choropleth map. Using the code provided by Kyle Walker as a model for my server, I came up with the code below that allows users to choose from a list of two variables. Unfortunately I am having problems running it, getting a Warning: Error in min: invalid 'type' (list) of argument error. Any help in resolving this would be appreciated. I have also looked at the RStudio, Using Leaflet With Shiny tutorial, but the examples provided are not choropleth maps.

Here is my non-working code:

## app.R ##
library(shiny)    # for shiny apps
library(leaflet)  # renderLeaflet function
library(RSocrata)
library(rgdal)
library(sp)
library(dplyr)

area_bound <- rgdal::readOGR("https://data.cityofchicago.org/resource/igwz-8jzy.geojson")
area_bound$area_num_1 <- as.numeric(area_bound$area_numbe)
health <- read.socrata("https://data.cityofchicago.org/resource/iqnk-2tcu.json")

data_num <- as.data.frame(apply(health[3:29], 2, as.numeric))
data_num <- bind_cols(health[1:2], data_num)
health_area <- sp::merge(area_bound, data_num, by.x = "area_numbe", by.y = "community_area")

groups <- c("Breast Cancer" = "breast_cancer_in_females", "Firearm" = "firearm_related")

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      radioButtons(
        inputId = "group",
        label = "Select a group to map",
        choices = groups
      )
    ),
    mainPanel(
      leafletOutput("map", height = "600")
    )
  )
)

server = function(input, output) {
  group_to_map <- reactive({
    input$group
  })

output$map <- renderLeaflet({
  
  leaflet(options = leafletOptions(zoomControl = FALSE)) %>%
    addProviderTiles(providers$Stamen.TonerLite) %>%
    setView(lng = -87.623177,
            lat = 41.881832,
            zoom = 8.5)
  
})

observeEvent(input$group, {
  
  pal <- colorNumeric("viridis", group_to_map)
  
  leafletProxy("map") %>%
    clearShapes() %>%
    clearControls() %>%
    addPolygons(data = group_to_map,
                color = ~pal(),
                weight = 0.5,
                fillOpacity = 0.5,
                smoothFactor = 0.2) %>%
    addLegend(
      position = "bottomright",
      pal = pal,
      values = group_to_map,
      title = "% of population"
    )
})

}

shinyApp(ui, server)

CodePudding user response:

There are several issues with your shiny code. First, to refer to values from a reactive you have to call it like a function, i.e. you have to do group_to_map(). Next, group_to_map() is just a character. To use the data column whose name is stored in group_to_map() you have to do health_area[[group_to_map()]]. I also fixed the issue with your palette functions. Finally, note that I switched to sf for reading the geo data as I'm more familiar with sf objects:

## app.R ##
library(shiny)    # for shiny apps
library(leaflet)  # renderLeaflet function
library(RSocrata)
library(dplyr)

area_bound <- sf::st_read("https://data.cityofchicago.org/resource/igwz-8jzy.geojson")
health <- read.socrata("https://data.cityofchicago.org/resource/iqnk-2tcu.json")

health[3:29] <- lapply(health[3:29], as.numeric)
#> Warning in lapply(health[3:29], as.numeric): NAs introduced by coercion
health_area <- left_join(area_bound, health, by = c("area_num_1" = "community_area"))

groups <- c("Breast Cancer" = "breast_cancer_in_females", "Firearm" = "firearm_related")

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      radioButtons(
        inputId = "group",
        label = "Select a group to map",
        choices = groups
      )
    ),
    mainPanel(
      leafletOutput("map", height = "600")
    )
  )
)

server = function(input, output) {
  group_to_map <- reactive({
    input$group
  })
  
  output$map <- renderLeaflet({
    
    leaflet(options = leafletOptions(zoomControl = FALSE)) %>%
      addProviderTiles(providers$Stamen.TonerLite) %>%
      setView(lng = -87.623177,
              lat = 41.881832,
              zoom = 8.5)
    
  })
  
  observeEvent(input$group, {
    
    pal <- colorNumeric("viridis", range(health_area[[group_to_map()]]))
    
    leafletProxy("map") %>%
      clearShapes() %>%
      clearControls() %>%
      addPolygons(data = health_area,
                  color = ~pal(health_area[[group_to_map()]]),
                  weight = 0.5,
                  fillOpacity = 0.5,
                  smoothFactor = 0.2) %>%
      addLegend(
        position = "bottomright",
        pal = pal,
        values = health_area[[group_to_map()]],
        title = "% of population"
      )
  })
  
}

shinyApp(ui, server)
#> 
#> Listening on http://127.0.0.1:5938

  • Related