Click to zoom in on polygon in Leaflet maps with Shiny

GIS Shiny R Leaflet

12 July, 2020

An easy way to add further interactivity to Leaflet maps rendered in R Shiny apps is to enable zoom-to-point functionality for your polygons. There currently isn't an out-of-the-box solution for this, but it's pretty easy to implement with a bit of manual work, as long as you don't have too many polygons.

The idea behind this implementation is to create and reference a variable that contains the coordinates of the center of each polygon. When the user clicks anywhere inside a polygon layer, we can access the polygon's layerId in Shiny, and match that with our reference table to get the coordinates of the polygon's center. Finally, we pass those coordinates to setView within a leafletProxy call to zoom into our desired point.

Setup

We're going to create our own polygons so that we can make this an easily reproducible example. Therefore, we only need to load Shiny and Leaflet packages (and dplyr because I don't know how to do anything without it).

library(leaflet)
library(shiny)
library(dplyr)

Next, we'll manually create our polygons. There are a bunch of polygon classes that you can pass to Leaflet, but we're going to go as simple as it can get: a simple two-column matrix containing latitude and longitude values. We will create matrices for two shapes, and store them in a named list my_shapes:

my_shapes = list(
    square_1 = matrix(c(175,176,176,175,-40,-40,-41,-41), nrow=4, ncol=2),
    square_2 = matrix(c(175,176,176,175,-36,-36,-37,-37), nrow=4, ncol=2)
)

To load these shapes, we'll create our Leaflet map object, then loop over our list, calling addPolygons for each shape. An important note is that we set layerId = shape, so that each polygon has a unique layerId which will ultimately be used to get the coordinates to zoom to.

map <- leaflet() %>%
    addTiles()

for (shape in names(my_shapes)) {
    map <- addPolygons(map,
        lng = my_shapes[[shape]][,1],
        lat = my_shapes[[shape]][,2],
        layerId = shape)
}

So we have a map with two square polygons. Next, we'll talk about creating our reference table with point coordinates.

Creating our point references

This is the embarrassingly low-tech part of the process. Of course, for simple squares, it would be pretty easy to programatically calculate the center of each square; but most of the polygons you'll work with will be irregular shapes. So, we're going to take advantage of Shiny's click variables to manually specify the coordinates at the center of our polygons.

The way that we do this is to create a simple Shiny app with our Leaflet map created above. We'll create a list my_centers to store our coordinates, and use an eventReactive that responds to input$map_shape_click to record the values. More information on the interpretation of map_shape_click can be found in the docs, but the general idea is that Leaflet can send interactions with the map to Shiny's backend in the form of input$MAPID_OBJCATEGORY_EVENTNAME. In this case, MAPID = map, OBJCATEGORY = shape (i.e., our polygon shape), and EVENTNAME = click (our mouse click). Here's what our observer looks like:

my_centers <<- list()

output$coords <- eventReactive(input$map_shape_click, {
    my_centers[[input$map_shape_click$id]] <<- input$map_shape_click
})

The idea here is to start our app, and sequentially click on the center of the polygons. Each click will be recorded in our observer as a new element in the my_centers list. The names of each list element are input$map_shape_click$id, which turns out to be the names of the polygons that we initially provided in my_shapes: "square_1" and "square_2". We're assigning our list to the parent environment (which happens to be the global environment), so we can access this data after closing the app.

So, let's put this all together. For some reason that I don't understand, we also need to render the text of our observer in the UI (here we do that with textOutput("coords")). Let's see what our Shiny app looks like now:

library(leaflet)
    library(shiny)

my_shapes <- list(
    square_1 = matrix(c(175,176,176,175,-40,-40,-41,-41), nrow=4, ncol=2),
    square_2 = matrix(c(175,176,176,175,-36,-36,-37,-37), nrow=4, ncol=2)
)

my_centers <<- list()

ui <- {
    fluidPage(
        fluidRow(
            leafletOutput("map"),
            textOutput("coords")
        )
    )
}

server <- function(input, output, session) {

    output$map <- renderLeaflet({

        map <- leaflet() %>%
            addTiles()

        for (shape in names(my_shapes)) {
            map <- addPolygons(map,
                lng = my_shapes[[shape]][,1],
                lat = my_shapes[[shape]][,2],
                layerId = shape)
        }

        map

    })

    output$coords <- eventReactive(input$map_shape_click, {
        my_centers[[input$map_shape_click$id]] <- input$map_shape_click
    })
}

Run the app with shinyApp(ui, server), and simply click on the centers of the polygons. Then close the app. Examine my_centers:

str(my_centers)
        List of 2
 $ square_2:List of 4
  ..$ id    : chr "square_2"
  ..$ .nonce: num 0.373
  ..$ lat   : num -36.5
  ..$ lng   : num 176
 $ square_1:List of 4
  ..$ id    : chr "square_1"
  ..$ .nonce: num 0.0413
  ..$ lat   : num -40.5
  ..$ lng   : num 176

We have a named list of length 2, with lat and lng values for each of our polygons (corresponding to the coordinates that we clicked on in our method above). Great! Now all we need to do is convert those into a clean, usable reference table. There are definitely cleaner and quicker ways of doing this, but I like writing loops, so...

for (i in 1:length(my_centers)) {
    this_obj <- my_centers[[i]]
    lat <- this_obj$lat
    lng <- this_obj$lng
    this_obj_df <- data.frame(
        id = names(my_centers)[i],
        lat = lat,
        lng = lng)

    if (!exists('reference_table')) {
        reference_table <- this_obj_df
    } else {
        reference_table <- bind_rows(reference_table, this_obj_df)
    }
}

Now we have a reference table, containing the ID of each of our polygons, as well as the latitute and longitude values of their centers (as defined by our mouse clicking!).

The last piece of the puzzle is to use our reference table to update the field of view of our map. This involves using the input$map_shape_click that we used above, and matching the id that we get from that with our reference table to retrieve the coordinates. Once we have the coordinates, we pass them to setView in our call to a leafletProxy, and voila—zoom to point.

Zooming to point

At this point, what I've done in the past is write my reference table out as a csv file so that I can reuse it without having to actually produce those lat/lng values again. But either way, let's keep or get this object in the environment because we're going to need it when we run out app.

write.csv(reference_table, "reference-table.csv", row.names = FALSE)
reference_table <- read.csv("reference-table.csv")

The key part here is to set up an observer that looks for input$map_shape_click, and use that to update our map. We'll store our returned object in a variable that we'll call click; we'll get the relevant entry in our reference table and store it in this_shape; and then we'll set the view of our map using those data. The observer looks like this:

observeEvent(input$map_shape_click, {

    click <- input$map_shape_click

    this_shape <- reference_table[match(click$id, reference_table$id),]

    leafletProxy("map") %>% 
        setView(
            lng = this_shape$lng,
            lat = this_shape$lat,
            zoom = 8)
})

Note that we set zoom = 8. We can set this to whatever we want, and if you want to get fancy, you can set a different zoom level for each of your shapes—simply add zoom as a variable in your reference table, and reference it in the same way we reference longitude and latitude.

And that's it! Now when we run our Shiny app, clicking on any point in a polygon will zoom to the middle of it. The full code for the app is here:

library(leaflet)
library(shiny)

my_shapes = list(
    square_1 = matrix(c(175,176,176,175,-40,-40,-41,-41), nrow=4, ncol=2),
    square_2 = matrix(c(175,176,176,175,-36,-36,-37,-37), nrow=4, ncol=2)
)

# read in the reference coordinates if you've written them somewhere
reference_table <- read.csv("reference-table.csv")

my_centers <<- list()

ui <- {
    fluidPage(
        fluidRow(
            leafletOutput("map")
        )
    )
}

server <- function(input, output, session) {

    output$map <- renderLeaflet({

        map <- leaflet() %>%
            addTiles()

        for (shape in names(my_shapes)) {
            map <- addPolygons(map,
                lng = my_shapes[[shape]][,1],
                lat = my_shapes[[shape]][,2],
                layerId = shape)
        }

        map

    })

    observeEvent(input$map_shape_click, {

        click <- input$map_shape_click
    
        this_shape <- reference_table[match(click$id, reference_table$id),]
    
        leafletProxy("map") %>% 
            setView(
                lng = this_shape$lng,
                lat = this_shape$lat,
                zoom = 8)
    })
}

shinyApp(ui, server)

Final thanks to SymbolixAU for this great Stack Overflow answer that inspired this post.

---