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

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

如果要添加反应性或自定义的功能，则在R中创建传单地图可能很棘手。我的目标是使用R中的工作流程制作一个Choropleth贴图，然后通过单击多边形和“显示”一组点的功能来进行扩充。

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

这是将“反应性”点添加到以下内容的基本图解的代表部分：

# 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()步骤中传递包含点信息的数据集，然后转换为geoJSON。
在R传单小部件中使用layerID中的addPolygons来跟踪唯一的多边形，在这种情况下为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))

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