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

Create interactive map with R Leaflet that shows markers upon polygon click

如果想要添加响应式或自定义功能,在 R 中创建传单地图可能会很棘手。我的目标是使用我在 R 中的工作流程制作等值线图,然后通过单击多边形和 'reveal' 一组点的功能来增强该地图。

中提出并回答了类似的问题,但在 leaflet.js 中完全完成了。将此解决方案转换为可以在 R 但没有 shiny 的情况下完成的事情并不那么简单。我知道这将涉及使用 htmlwidgets::onRender() 和一些 JavaScript 知识。

这是要添加 'reactive' 点的基本图的代表:

# 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") 

我们可以从使用 leaflet.js 的@nikoshr 解决方案开始,进行一些调整以从 R 开始工作。这是基本思想:

  • onRender()步骤中包含点信息的data-set传递给geoJSON.
  • 在您的 R 传单小部件中使用 addPolygons 中的 layerID 来跟踪独特的多边形,在本例中为 CNTY_ID.
  • 使用条件语句 (if(layer instanceof L.Polygon)) 仅循环遍历多边形层。如果它遍历所有层,我会遇到问题。
  • 创建一个featureGroup()动态添加点;以前的解决方案使用 layerGroup() 但这不适用于方法 .bringToFront()
  • 添加 .on('click') 命令,将标记添加到 CNTY_ID
  • 添加 .on('mouseover') 命令以确保标记点始终位于顶部,无论在 R 小部件中选择了什么突出显示选项。

使用上述问题中提供的传单小部件,可以添加以下内容以创建所需的地图:

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))

这将创建一个地图,在单击关联的多边形时显示县的弹出窗口以及点(悬停时带有工具提示)。多边形将在鼠标悬停时突出显示,但不会遮盖点。