Search code examples
rshinyleafletr-leaflet

Select states on a map in a Shiny Application


Im trying to reproduce this excellent answer: Turn states on a map into clickable objects in Shiny

I have the following dataset available:

library(rgdal)
library(leaflet)

tmp <- tempdir()
url <- "http://personal.tcu.edu/kylewalker/data/mexico.zip"
file <- basename(url)
download.file(url, file)
unzip(file, exdir = tmp)
mexico <- readOGR(dsn = tmp, layer = "mexico", encoding = "UTF-8")

pal <- colorQuantile("YlGn", NULL, n = 5)
state_popup <- paste0("<strong>Estado: </strong>", 
                  mexico$name, 
                  "<br><strong>PIB per c?pita, miles de pesos, 2008: </strong>", 
                  mexico$gdp08)

On top on this data I build the following Shiny Application:

# load necessary packages
library( leaflet )    
library( shiny )
library( shinydashboard )


ui <- fluidPage(
  # place the contents inside a box
  shinydashboard::box(
    width = 12
    , title = "Click on the map!"
    # separate the box by a column
    , column(
      width = 2
      , shiny::actionButton( inputId = "clearHighlight"
                             , icon = icon( name = "eraser")
                             , label = "Clear the Map"
                             , style = "color: #fff; background-color: #D75453; border-color: #C73232"
      )
    )
    # separate the box by a column
    , column(
      width = 10
      , leaflet::leafletOutput( outputId = "myMap"
                                , height = 850
      )
    )
  ) # end of the box
) # end of fluid page

# create the server
server <- function( input, output, session ){

  # create foundational map
  foundational.map <- shiny::reactive({
    leaflet() %>%
      #addTiles( urlTemplate = "https://cartodb-basemaps-{s}.global.ssl.fastly.net/light_all/{z}/{x}/{y}.png") %>%
      #setView( lng = -87.567215
      #         , lat = 41.822582
      #         , zoom = 11 ) %>%
      addProviderTiles("CartoDB.Positron") %>%
      addPolygons( data = mexico
                   , fillOpacity = 0
                   , opacity = 0.2
                   , color = "#000000"
                   , weight = 2
                   , layerId = mexico$states
                   , group = "click.list"
      )
  })

  output$myMap <- renderLeaflet({

    foundational.map()

  }) 

  click.list <- shiny::reactiveValues( ids = vector() )

  shiny::observeEvent( input$myMap_shape_click, {

    click <- input$myMap_shape_click
    click.list$ids <- c( click.list$ids, click$id )
    lines.of.interest <- mexico[ which( mexico$states %in% click.list$ids ) , ]

    if( is.null( click$id ) ){
      req( click$id )
    } else if( !click$id %in% lines.of.interest@data$id ){
      leaflet::leafletProxy( mapId = "myMap" ) %>%
        addPolylines( data = lines.of.interest
                      , layerId = lines.of.interest@data$id
                      , color = "#6cb5bc"
                      , weight = 5
                      , opacity = 1
        ) 

    } # end of if else statement

  }) # end of shiny::observeEvent({})

  shiny::observeEvent( input$clearHighlight, {

    output$myMap <- leaflet::renderLeaflet({

      click.list$ids <- NULL
      foundational.map()

    }) # end of re-rendering $myMap

  }) # end of clearHighlight action button logic

} # end of server

shiny::shinyApp( ui = ui, server = server)

The basic map works. However, what I want to achieve is that when I click a state border is placed around the state. This should happen with the following code:

click <- input$myMap_shape_click
click.list$ids <- c( click.list$ids, click$id )
lines.of.interest <- mexico[ which( mexico$states %in% click.list$ids ) , ]

if( is.null( click$id ) ){
  req( click$id )
} else if( !click$id %in% lines.of.interest@data$id ){
  leaflet::leafletProxy( mapId = "myMap" ) %>%
    addPolylines( data = lines.of.interest
                  , layerId = lines.of.interest@data$id
                  , color = "#6cb5bc"
                  , weight = 5
                  , opacity = 1
    ) 

}

But clearly something is off. Any thoughts on what goes wrong?


Solution

  • The issue turns out to be quite simple to solve (once you know where to look). You are referencing twice to mexico$states, while it should be mexico$state, so I removed two letters and now it works. See the code below.

    Maybe also good to add how I found this out, so you know how to debug similar issues in the future. In the observeEvent, i added print(click). The output of that is:

    $id
    NULL
    
    $.nonce
    [1] 0.2851101
    
    $group
    [1] "click.list"
    
    $lat
    [1] 22.26199
    
    $lng
    [1] -100.2037
    

    So then we see that there is something wrong with the id of the clicks! From there it is simple to see the error, the polygons had ids mexico$states, instead of mexico$state.

    Hope this helps!

    library(rgdal)
    library(leaflet)
    
    tmp <- tempdir()
    url <- "http://personal.tcu.edu/kylewalker/data/mexico.zip"
    file <- basename(url)
    download.file(url, file)
    unzip(file, exdir = tmp)
    mexico <- readOGR(dsn = tmp, layer = "mexico", encoding = "UTF-8")
    
    pal <- colorQuantile("YlGn", NULL, n = 5)
    state_popup <- paste0("<strong>Estado: </strong>", 
                          mexico$name, 
                          "<br><strong>PIB per c?pita, miles de pesos, 2008: </strong>", 
                          mexico$gdp08)
    
    # load necessary packages
    library( leaflet )    
    library( shiny )
    library( shinydashboard )
    
    
    ui <- fluidPage(
      # place the contents inside a box
      shinydashboard::box(
        width = 12
        , title = "Click on the map!"
        # separate the box by a column
        , column(
          width = 2
          , shiny::actionButton( inputId = "clearHighlight"
                                 , icon = icon( name = "eraser")
                                 , label = "Clear the Map"
                                 , style = "color: #fff; background-color: #D75453; border-color: #C73232"
          )
        )
        # separate the box by a column
        , column(
          width = 10
          , leaflet::leafletOutput( outputId = "myMap"
                                    , height = 850
          )
        )
      ) # end of the box
    ) # end of fluid page
    
    # create the server
    server <- function( input, output, session ){
    
      # create foundational map
      foundational.map <- shiny::reactive({
        leaflet() %>%
          #addTiles( urlTemplate = "https://cartodb-basemaps-{s}.global.ssl.fastly.net/light_all/{z}/{x}/{y}.png") %>%
          #setView( lng = -87.567215
          #         , lat = 41.822582
          #         , zoom = 11 ) %>%
          addProviderTiles("CartoDB.Positron") %>%
          addPolygons( data = mexico
                       , fillOpacity = 0
                       , opacity = 0.2
                       , color = "#000000"
                       , weight = 2
                       , layerId = mexico$state
                       , group = "click.list"
          )
      })
    
      output$myMap <- renderLeaflet({
    
        foundational.map()
    
      }) 
    
      click.list <- shiny::reactiveValues( ids = vector() )
    
      shiny::observeEvent( input$myMap_shape_click, {
    
        click <- input$myMap_shape_click
        click.list$ids <- c( click.list$ids, click$id )
        lines.of.interest <- mexico[ which( mexico$state %in% click.list$ids ) , ]
        print(click)
    
        if( is.null( click$id ) ){
          req( click$id )
        } else if( !click$id %in% lines.of.interest@data$id ){
          leaflet::leafletProxy( mapId = "myMap" ) %>%
            addPolylines( data = lines.of.interest
                          , layerId = lines.of.interest@data$id
                          , color = "#6cb5bc"
                          , weight = 5
                          , opacity = 1
            ) 
    
        } # end of if else statement
    
      }) # end of shiny::observeEvent({})
    
      shiny::observeEvent( input$clearHighlight, {
    
        output$myMap <- leaflet::renderLeaflet({
    
          click.list$ids <- NULL
          foundational.map()
    
        }) # end of re-rendering $myMap
    
      }) # end of clearHighlight action button logic
    
    } # end of server
    
    shiny::shinyApp( ui = ui, server = server)