Search code examples
rshinyr-leaflet

Leaflet polygons change style upon choosing location from a Shiny dropdown menu


I'm completely new to Shiny, so please forgive any mistakes or misunderstandings. I'm creating a Shiny application with Leaflet in R based off of this example. The example works from point data whereas my app works with polygons, which appears to be what is causing me problems.

Here is the shapefile I'm working with and here is my full code:

library(shiny)
library(leaflet)
library(sp)
library(rgeos)
library(rgdal)
library(RColorBrewer)
library(raster)

#pull in full rock country shapefile, set WGS84 CRS
countries <- readOGR("D:/NaturalEarth/HIF", layer = "ctry_hif", 
                     stringsAsFactors = F, encoding = "UTF-8")
countries <- spTransform(countries, CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs"))


#define color palettes for mapping
darkpal <- brewer.pal(5, "Set3")

#country level
pal <- colorFactor(darkpal, countries@data$colors)


shinyApp(
  ui = fluidPage(leafletOutput('myMap', width = "80%", height = 500),
                 br(),
                 leafletOutput('myMap2', width = "80%", height = 500), 
                 absolutePanel(width = "20%", top = 10, right = 5, 
                               selectInput(inputId = "location", 
                                           label = "Country", 
                                           choices = c("", countries@data$sovereignt), 
                                           selected = "")
                 )
  ),


  #country-level Rock map
  server <- function(input, output, session) {

    output$myMap <- renderLeaflet({
      leaflet(countries) %>% 
        addTiles() %>% 
        addPolygons(fillColor = ~pal(countries@data$colors), 
                    fillOpacity = 1, 
                    weight = 1, 
                    stroke = T, 
                    color = "#000000", 
                    label = ~as.character(sovereignt), 
                    group = "Countries",
                    layerId = ~sovereignt)
    }) 


    #change polygon style upon click event
    observeEvent(input$myMap_shape_click, {
      click <- input$myMap_shape_click
      if(is.null(click))
        return()

      #subset countries by click point
      selected <- countries[countries@data$sovereignt == click$id,]

      #define leaflet proxy for dynamic updating of map
      proxy <- leafletProxy("myMap")

      #change style upon click event
      if(click$id == "Selected"){
        proxy %>% removeShape(layerId = "Selected")
      } else {
        proxy %>%
          setView(lng = click$lng, lat = click$lat, zoom = input$myMap_zoom) %>%
          addPolygons(data = selected,
                      fillColor = "yellow",
                      fillOpacity = .95,
                      color = "orange",
                      opacity = 1,
                      weight = 1,
                      stroke = T,
                      layerId = "Selected")}
    }) #end observe event for highlighting polygons on click event 


    #update location bar when polygon is clicked
    observeEvent(input$myMap_shape_click, {
      click <- input$myMap_shape_click
      if(!is.null(click$id)){
        if(is.null(input$location) || input$location!=click$id) updateSelectInput(session, "location", selected=click$id)
      }
    }) #end observe event for updating dropdown upon click event


    #update the map markers and view on location selectInput changes
    observeEvent(input$location, {

      #set leaflet proxy for redrawing of map
      proxy <- leafletProxy("myMap")

      #define click point
      click <- input$myMap_shape_click

      #subset countries spdf by input location
      ctrysub <- subset(countries, sovereignt == input$location)

      #define click point as corresponding polygon
      selected <- countries[countries@data$sovereignt == click$id,]

      if(nrow(ctrysub) == 0){
        proxy %>% removeShape(layerId = "Selected")
      } else if(length(click$id) && input$location != click$id){
        proxy %>% addPolygons(data = selected,
                              fillColor = "yellow",
                              fillOpacity = .95,
                              color = "orange",
                              opacity = 1,
                              weight = 1,
                              stroke = T,
                              layerId = "Selected")
      } else if(!length(click$id)){
        proxy %>% addPolygons(data = selected,
                              fillColor = "yellow",
                              fillOpacity = .95,
                              color = "orange",
                              opacity = 1,
                              weight = 1,
                              stroke = T,
                              layerId = "Selected")}
    }) #end observe event for drop down selection

  }) #end server

I want my app to react to both shape clicks AND selections from the dropdown menu. With the above code, clicking on polygons changes the polygon style to show that it has been selected. It also updates the dropdown menu with the appropriate country name once it has been clicked. When I try to select a country from the dropdown menu, however, nothing happens on the map. I want for dropdown selections to result in the appropriate country polygon being highlighted in the same style as when the polygon is clicked on.

Admittedly, I don't fully understand the third observeEvent that is supposed to accomplish this goal. I have attempted to match my polygon data to the linked marker data with no luck. To try to pinpoint my issue, I printed all relevant outputs/objects from the example and did the same for my code. As it is now, they match up perfectly, but my Shiny app still doesn't react the way that the example does. SO, from the linked example:

  observeEvent(input$location, { # update the map markers and view on location selectInput changes
    p <- input$Map_marker_click
    p2 <- subset(locs, loc==input$location)
    proxy <- leafletProxy("Map")
    if(nrow(p2)==0){
      proxy %>% removeMarker(layerId="Selected")
    } else if(length(p$id) && input$location!=p$id){
      proxy %>% setView(lng=p2$lon, lat=p2$lat, input$Map_zoom) %>% acm_defaults(p2$lon, p2$lat)
    } else if(!length(p$id)){
      proxy %>% setView(lng=p2$lon, lat=p2$lat, input$Map_zoom) %>% acm_defaults(p2$lon, p2$lat)
    }
  })
  • nrow(p2): prints 1 upon click event AND dropdown selection
  • length(p$id): prints 1 upon click event, prints 0 on dropdown selection
  • input$location: prints location name string upon click event AND dropdown selection
  • p$id: prints location name string upon click event, prints NULL from dropdown selection
  • !length(p$id):prints FALSE upon click event, prints TRUE from dropdown selection

And from my code:

   observeEvent(input$location, {

      #set leaflet proxy for redrawing of map
      proxy <- leafletProxy("myMap")

      #define click point
      click <- input$myMap_shape_click

      #subset countries spdf by input location
      ctrysub <- subset(countries, sovereignt == input$location)

      #define click point as corresponding polygon
      selected <- countries[countries@data$sovereignt == click$id,]

      if(nrow(ctrysub) == 0){
        proxy %>% removeShape(layerId = "Selected")
      } else if(length(click$id) && input$location != click$id){
        proxy %>% addPolygons(data = selected,
                              fillColor = "yellow",
                              fillOpacity = .95,
                              color = "orange",
                              opacity = 1,
                              weight = 1,
                              stroke = T,
                              layerId = "Selected")
      } else if(!length(click$id)){
        proxy %>% addPolygons(data = selected,
                              fillColor = "yellow",
                              fillOpacity = .95,
                              color = "orange",
                              opacity = 1,
                              weight = 1,
                              stroke = T,
                              layerId = "Selected")}
    }) #end observe event for drop down selection
  • nrow(ctrysub): prints 1 upon click event AND dropdown selection
  • length(click$id): prints 1 upon click event, prints 0 on dropdown selection
  • input$location: prints country name string upon click event AND dropdown selection
  • click$id: prints country name string upon click event, prints NULL from dropdown selection
  • !length(click$id):prints FALSE upon click event, prints TRUE from dropdown selection

I suspect that the issue is with the format of a marker versus a polygon, but again, all of the relevant objects have the same output for both sets of code, so I'm not sure where to go from here. So, how can I code this so that my dropdown selection results in the polygon being highlighted in the same way as when it is clicked on?


Solution

  • Figured it out! In my observeEvent, I defined my selected polygon by the click$id rather than the input$location, which is why it didn't react to my drop-down menu selection. So instead of:

     #define click point as corresponding polygon
          selected <- countries[countries@data$sovereignt == click$id,]
    

    I needed to use:

     #define dropdown selection as corresponding polygon
          selected <- countries[countries@data$sovereignt == input$location,]