Un halo teinté à l’intérieur d’un polygone avec leaflet et la librairie sf (simple feature)

Ajouter un halo teinté à l’intérieur d’un polygone dans leaflet

Stackoverflow est une fois de plus une source d’inspriation. J’y ai trouvé cette question pour créer des bandes teintées avec leaflet, initialement non liée à R, mais j’ai pensé pouvoir y répondre facilement avec R. C’est aussi pour moi une bonne excuse pour jouer avec cette nouvelle librairie sf (“simple feature”) et l’utiliser avec leaflet. Ma solution est simple. L’idée est de créer un nouveau multipolygon à partir de l’original, mais avec un vide à l’intérieur, de telle sorte que l’on crée ce qu’on appelle communément un polygon “doughnut” pour chaque zone. Comme je l’ai fait remonter avec une question sur stackoverflow (encore…), j’ai récemment remarqué que cela pouvait être compliqué de faire une figure de multipolygones avec des trous sur ggplot2 en utilisant les SpatialPolygons de la librarie sp. Ce qui est une autre bonne raison pour utiliser ici la librairie sf.

Récupérer les polygones des régions françaises

Récupérons les polygones des régions françaises et attribuons une couleur à chacune. J’aime bien les couleurs piratepal de la librairie yarrr.

fra.sp <- getData('GADM', country = 'FRA', level = 1, path = extraWD)
fra.sf <- st_as_sf(fra.sp)

ggplot(fra.sf) +
  geom_sf(aes(fill = NAME_1), alpha = 0.8) +
  scale_fill_manual(values = rep(unique(yarrr::piratepal("basel")),
                                 length.out = nrow(fra.sf))) +
  guides(fill = FALSE)

Figure 1: Coloration des régions françaises avec rstat et la librairie sf

Créer les futurs trous des polygones avec une zone tampon

On crée les futurs trous dans les polygones à l’aide d’une zone tampon ayant une distance négative pour obtenir une réduction du polygone d’origine. Ici, st_buffer retourne un objet sans type de géométrie (geometry type: GEOMETRY), ce qui empêche d’en faire une figure (Error in CPL_gdal_dimension(st_geometry(x), NA_if_empty)). Une solution est d’utiliser st_cast après.

fra.sf.buf <- st_cast(st_buffer(fra.sf, dist = -0.1))

ggplot() +
  geom_sf(data = fra.sf.buf, aes(fill = factor(NAME_1)), alpha = 0.8) +
  geom_sf(data = fra.sf,
          colour = "grey20", fill = "transparent",
          size = 0.5) +
  scale_fill_manual(values = rep(unique(yarrr::piratepal("basel")),
                                 length.out = nrow(fra.sf))) +
  guides(fill = FALSE)

Figure 2: Polygones des futurs vides intérieurs des bandes teintées

Créer des vides au milieu des polygones d’origine

Pour créer ces fameux doughnuts à partir des polygones d’origine et des polygones tampons, j’ai utilisé la fonction st_difference. Cependant, comme discuté avec Edzer sur le github de la librairie sf, j’ai dû transformer les polygones tampons en un multipolygone de multipolygone unique avec st_combine. De plus, le multipolygone créé n’a pas non plus de géométrie et doit être passé dans st_cast.

# st_difference work if the mask is a unique multipolygon
fra.sf.buf.comb <- fra.sf.buf %>% st_combine() %>% st_sf()
fra.sf.doug <- st_difference(fra.sf, fra.sf.buf.comb) %>% st_cast()

ggplot() +
  geom_sf(data = fra.sf.doug, aes(fill = factor(NAME_1)),
          alpha = 0.6, colour = "transparent") +
  # geom_sf(data = fra.sf, colour = "grey20") +
  scale_fill_manual(values = rep(unique(yarrr::piratepal("basel")),
                                 length.out = nrow(fra.sf.doug))) +
  guides(fill = FALSE)

Figure 3: Bande teintée de type doughnuts

Afficher les bandes teintées avec leaflet

Pour accélérer l’affichage, les polygones ont été simplifiés avec st_simplify. Vous le verrez si vous zoomez.

# Simplify geometry to get a lighter widget
# Separate "Rhône-Alpes", "Franche-Comté", "Bourgogne", "Bretagne" as it does not support to much simplification
fra.sf.doug.simple1 <- st_simplify(filter(fra.sf.doug, NAME_1 %in% c("Rhône-Alpes", "Franche-Comté")), dTolerance = 1e-4)
fra.sf.doug.simple2 <- st_simplify(filter(fra.sf.doug, NAME_1 %in% c("Bourgogne")), dTolerance = 1e-5)
fra.sf.doug.simple3 <- st_simplify(filter(fra.sf.doug, NAME_1 %in% c("Bretagne")), dTolerance = 1e-2)
fra.sf.doug.simple4 <- st_simplify(filter(fra.sf.doug, !NAME_1 %in% c("Rhône-Alpes", "Franche-Comté", "Bourgogne", "Bretagne")), dTolerance = 0.02)
fra.sf.doug.simple <- rbind(fra.sf.doug.simple1, fra.sf.doug.simple2, fra.sf.doug.simple3,  fra.sf.doug.simple4) %>% st_cast()
fra.sf.simple <- st_simplify(fra.sf, dTolerance = 0.02)

Maintenant, on peut utiliser ces polygones doughnut sur leaflet en affichant une bande teintée avec de la transparence et les polygones originaux en contour noir.

factpal <- colorFactor(rep(unique(yarrr::piratepal("basel")),
                                 length.out = nrow(fra.sf.doug.simple)),
                       fra.sf.doug.simple$NAME_1)

# leaflet widget
m <- leaflet() %>%
  addProviderTiles(providers$Stamen.Toner) %>%
  addPolygons(data = fra.sf.doug.simple, weight = 1, smoothFactor = 0.75,
    opacity = 0, fillOpacity = 0.6,
    color = "#000000",
    fillColor = ~factpal(fra.sf.doug.simple$NAME_1),
    highlightOptions = highlightOptions(color = "white", weight = 2,
      bringToFront = TRUE)) %>%
  addPolygons(data = fra.sf.simple, weight = 1, smoothFactor = 0.75,
    opacity = 1.0, fillOpacity = 0,
    color = "#000000")

Le script rmarkdown complet

Si vous souhaitez reproduire ces figures, le script rmarkdown complet est disponible ici sur mon github.