使用 R Leaflet 创建交互式地图，在多边形单击时显示标记

Question

Creating a leaflet map in R can be tricky if one wants to add reactive, or otherwise customized, features. My goal was to use my workflow in R to make a choropleth map that is then augmented by the ability to click a polygon and 'reveal' a set of points.

A similar question was asked and answered in another post , but it is completely done in leaflet.js . Converting this solution to something that can be done from within R but without shiny is not as straight forward. I know it will involve using htmlwidgets::onRender() and some JavaScript knowledge.

Here is a reprex of a basic plot to add 'reactive' points to:

# Load libraries
library(sf)
library(leaflet)

# Grab data sample from the sf package for mapping
nc <- st_read(system.file("shape/nc.shp", package="sf"))

# Set a basic palette 
pal <- colorNumeric("viridis", NULL)

# Create the leaflet widget with R code
nc_map <- leaflet() %>%
  addProviderTiles(providers$CartoDB.Positron) %>% # To get city names
  addPolygons(data = nc,
              fillColor = ~pal(AREA),
              color = 'grey',
              opacity = 1,
              layerId = ~CNTY_ID,
              group = 'Municipality',
              fillOpacity = 0.65,
              weight = 1.5,
              dashArray = '3',
              smoothFactor = 1,
              highlight = highlightOptions( # Make highlight pop out
                weight = 3.5,
                color = '#666',
                dashArray = "",
                fillOpacity = 0.5,
                bringToFront = T),
              popup = ~NAME,
              popupOptions = popupOptions(
                style = list('font-weight' = 'normal', padding = '3px 8px'),
                textsize = '15px',
                maxWidght = 200,
                maxHeight = 250,
                direction = 'auto')) %>%
  addLegend(data = nc, pal = pal, values = ~AREA,
            opacity = 0.7,
            title = 'Area of county',
            position = "bottomleft") 

Answer 1

We can start from @nikoshr's solution using leaflet.js , making a few adjustments to work from R . Here is the basic idea:

• Pass the data-set containing the point information during the onRender() step, and convert to geoJSON .
• Use the layerID from addPolygons in your R leaflet widget to track unique polygons, in this case the CNTY_ID .
• Loop through just the polygon layer using a conditional statement ( if(layer instanceof L.Polygon) ). I had issues if it looped through all layers.
• Create a featureGroup() to add points to dynamically; previous solutions used a layerGroup() but this doesn't work with the method .bringToFront()
• Add an .on('click') command that will add the markers to the specific to the CNTY_ID .
• Add an .on('mouseover') command to ensure the marker points are always on top, no matter what the highlight option is chosen in the R widget.

Working from the leaflet widget provided in the question above, the following can be added to create the desired map:

library(geojsonsf)

# Custom points to appear in the data (centroids)
nc_centroid <- st_centroid(nc)


nc_map %>%  htmlwidgets::onRender("

function(el, x, data){

var mymap= this;

// Create new group
var featureGroup = L.featureGroup();
mymap.addLayer(featureGroup);

// For each polygon layer...
mymap.eachLayer(function(layer){
  
  if(layer instanceof L.Polygon) {
  
    // Zoom to the clicked area
    layer.on('click', function(e){
      var bbox = e.target.getBounds();
      var sw = bbox.getSouthWest();
      var ne = bbox.getNorthEast();
      mymap.fitBounds([sw, ne]);
      
      // Grab ID from the polygon clicked 
      var clickedPoly = e.sourceTarget.options.layerId;
      
      // Clear prior layer and fill with markers with matching polygon ID
      featureGroup.clearLayers();
      featureGroup.addLayer(L.geoJson(data, {
        
        pointToLayer: function(feature, latlng){
          var markerlayer = L.circleMarker(latlng, { 
            color: '#2e2eb8',
            radius: 7,
            fill: true,
            fillOpacity: .5,
            opacity: .5
          });
          return markerlayer;
        },
        
        // Add labels to the markers
        onEachFeature: function(feature, layer) {
          if (feature.properties && feature.properties.NAME) {
            return layer.bindTooltip(feature.properties.NAME);
          }
        },
        // Keep only counties within the clicked polygon
        filter: function (feature) {
          return feature.properties.CNTY_ID === clickedPoly;
        }
      }));
    });
    
    // Ensure that the markers are always on top
    layer.on('mouseover', function(e){
      featureGroup.bringToFront();
    });
  };  
});
}", data = geojsonsf::sf_geojson(nc_centroid))

This will create a map that shows the popup for the county as well as the point (with tooltip on hover) when the associated polygon is clicked. The polygon will be highlighted upon mouseover, but will not mask the points.