Reputation: 1413
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")
Upvotes: 0
Views: 1940
Reputation: 1413
We can start from @nikoshr's solution using leaflet.js
, making a few adjustments to work from R
. Here is the basic idea:
onRender()
step, and convert to geoJSON
.layerID
from addPolygons
in your R leaflet widget to track unique polygons, in this case the CNTY_ID
.if(layer instanceof L.Polygon)
). I had issues if it looped through all layers.featureGroup()
to add points to dynamically; previous solutions used a layerGroup()
but this doesn't work with the method .bringToFront()
.on('click')
command that will add the markers to the specific to the CNTY_ID
..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.
Upvotes: 1