rr-leafletrgdalrgeo-shapefile

How to mask the world except for one country using R and sf and show it in a leaflet map?


I want to display a leaflet map in R where the whole world is "whited out" except for a specific country (e.g., Germany). I had a working solution using sp, rgdal, and rgeos, but these packages are now deprecated.

My old function created a "hole mask" (everything white except Germany), using this code:

mask_world_except_specified_region <- function(path, shp_filename) {
  specified_area <- rgdal::readOGR(path, shp_filename)
  world <- raster::rasterToPolygons(raster::raster(ncol = 1, nrow = 1, crs = sp::proj4string(specified_area)))
  specified_area_mask <- rgeos::gDifference(world, specified_area)
  tmp_id_df <- data.frame(ID = "1")
  rownames(tmp_id_df ) <- names(specified_area_mask)
  sp::SpatialPolygonsDataFrame(specified_area_mask, tmp_id_df)
}

I then used the function to create a SpatialPolygonsDataFrame like this:

germany_mask_spdf <- mask_world_except_specified_region("my/path", "gadm_36_DEU_1")

which I passed into leaflet::addPolygons() as a masking layer.

create_leaflet_map_germany <- function(df) {
  
  leaflet(data = df, options = leafletOptions(minZoom = 6, dragging = TRUE)) %>%
    addProviderTiles(provider = "CartoDB.PositronNoLabels", group = "Carto") %>%
    addProviderTiles(provider = "Esri.WorldStreetMap", group = "Esri") %>%
    addTiles(group = "OSM") %>%
    addPolygons(data = germany_mask_spdf, fillColor = "white", fillOpacity = 1.0, color = "black", weight = 1 ) %>%
    setView(lng = 10.3608414, lat = 51.1593825, zoom = 6) %>%  # These coordinates point to Niederdorla, a village near the geographic center of Germany
    addCircleMarkers(~lon, ~lat, color = '#195365', radius = 7, fill = '#195365', popup = ~Popup) %>%
    addResetMapButton() %>%
    addLayersControl(baseGroups = c("Carto", "Esri", "OSM"), position = "topright")
}

df <- data.frame(
  lon = c(10, 11.34),
  lat = c(53.34, 48.08),
  Popup = c("Moin", "Servus")
)

create_leaflet_map_germany(df)

Expected output looks like:

This Map

Any help on how to replicate this masking behavior using sf (and possibly terra) would be greatly appreciated — ideally in a way that works with leaflet::addPolygons()

Apologies in advance for any mistakes in how I'm asking this — it's my first question here. I'll do my best to improve.


Solution

  • Taking @cristian-vargas code: One could use this TileLayer.BoundaryCanvas Plugin in R like using htmlwidgets::prependContent to load the plugin / change the background to white using this. This plugin will shave off layers around a given geomJSON boundry - though sadly it's buggy for basemaps.cartocdn.com/light_nolabels and the borders are not that precise - I guess the limiting factor here is the precision of your germany geomJSON - how far do you want to go? ;). I took the boundryCanvas Links from here.

    res

    Code

    library(rnaturalearth)
    library(leaflet)
    library(htmlwidgets)
    library(htmltools)
    
    geojson <- geojsonsf::sf_geojson(ne_countries(scale = 10, country = "Germany"))
    
    data <- data.frame(
      lon = c(10, 11.34), lat = c(53.34, 48.08),Popup = c("Moin", "Servus")
    )
    
    leaflet(data = data, options = leafletOptions(minZoom = 6, dragging = TRUE)) %>%
      setView(lng = 10.3608414, lat = 51.1593825, zoom = 6) %>%
      addCircleMarkers(~lon, ~lat, color = '#195365', radius = 7,fill = TRUE, fillOpacity = 0.8, fillColor = '#195365', popup = ~Popup) |> 
      leaflet.extras::addResetMapButton() |> 
      htmlwidgets::prependContent(tags$head(
        tags$script(src = "https://cdn.rawgit.com/aparshin/leaflet-boundary-canvas/f00b4d35/src/BoundaryCanvas.js"),
        tags$style(".leaflet-container { background: white; }" )
      )) |> 
      htmlwidgets::onRender(
        sprintf(
          'function(el, x) {
            var map = this;
            var boundary = %s;
            
            var osmLayer = new L.TileLayer.BoundaryCanvas("https://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png", {
              boundary: boundary
            });
            var esriWorldTopoMap = new L.TileLayer.BoundaryCanvas("https://server.arcgisonline.com/ArcGIS/rest/services/World_Topo_Map/MapServer/tile/{z}/{y}/{x}", {
              boundary: boundary
            });
            var cartoDBPositron = new L.TileLayer.BoundaryCanvas("https://{s}.basemaps.cartocdn.com/light_nolabels/{z}/{x}/{y}{r}.png", {
              boundary: boundary
            });
            var baseLayers = {
              "OSM": osmLayer,
              "ESRI": esriWorldTopoMap,
              "Carto": cartoDBPositron
            };        
            map.addLayer(osmLayer);
            L.control.layers(baseLayers, {}, {collapsed: false}).addTo(map);
          }', 
          geojson
        )
      )
    

    Notes: I left it away, but be sure to extend attribution courtesy if used commercially - at least this is shown in my linked source so we can assume it's good practice.