Ajouter une couche géographique de points dans {tmap} avec plusieurs formats de bordures

Ça fait un moment depuis mon dernier article de blog. En ce moment mon temps libre est utilisé pour améliorer des packages comme “{fusen} : Gonflez votre package à partir d’un simple Rmd plat” , “{attachment} : Tools to deal with dependencies in scripts, Rmd and packages” ou “{gitlabr} : An R client for the GitLab API”. Par conséquent, dessiner des cartes ne fait pas trop partie de mes priorités. Mais aujourd’hui, j’ai dû faire une petite astuce sur {tmap} que j’avais envie de partager.

Obtenir des données ponctuelles

Utilisons les données incluses dans {tmap} avec la taille de la population des villes dans le monde.
Je n’utiliserai que la colonne iso_a3 pour séparer mes villes en différents symboles d’apparence. Ce n’est pas vraiment utile dans ce cas, mais, au moins, c’est un exemple reproductible.

library(dplyr)
library(sf)
library(tmap)
library(stringr)
library(tidyr)
library(purrr)

data(World)
data(metro)

metro_small <- metro %>% 
  select(name_long, iso_a3)
metro_small
## Simple feature collection with 436 features and 2 fields
## Geometry type: POINT
## Dimension:     XY
## Bounding box:  xmin: -123.1193 ymin: -37.814 xmax: 174.7667 ymax: 60.16925
## Geodetic CRS:  WGS 84
## First 10 features:
##                name_long iso_a3                    geometry
## 2                  Kabul    AFG   POINT (69.17246 34.52889)
## 8  El Djazair  (Algiers)    DZA     POINT (3.04197 36.7525)
## 13                Luanda    AGO   POINT (13.23432 -8.83682)
## 16          Buenos Aires    ARG POINT (-58.40037 -34.60508)
## 17               Cordoba    ARG  POINT (-64.18105 -31.4135)
## 25               Rosario    ARG POINT (-60.63932 -32.94682)
## 32               Yerevan    ARM     POINT (44.51462 40.182)
## 33              Adelaide    AUS  POINT (138.5986 -34.92866)
## 34              Brisbane    AUS  POINT (153.0281 -27.46794)
## 37             Melbourne    AUS    POINT (144.9633 -37.814)

Pas l’temps d’tout lire

A ce jour, il n’est pas possible de définir des couleurs et des tailles de bordure différentes pour une même couche de point dans {tmap}.

  • Créez votre propre symbologie
  • Associez votre carte à la symbologie
  • Séparez vos couches en fonction des types de bordures
  • Combinez les couches
  • Ajouter une légende manuelle personnalisée
# A custom company symbology
symbology <-tribble(
  ~city_letter, ~color, ~border_color, ~border_width,
  "A-start", "cyan", "black", 0.5,
  "D-start", "orangered", "transparent", 0,
  "Others", "white", "forestgreen", 1,
  "Extra not used", "black", "cyan", 1,
)

# Combine my layer to my symbology
metro_small_symbology <- metro_small %>% 
  mutate(city_letter = case_when(
    str_starts(iso_a3, "A") ~ "A-start",
    str_starts(iso_a3, "D") ~ "D-start",
    TRUE ~ "Others"
  )) %>% 
  left_join(symbology, by = "city_letter")

#' Create a custom symbol layer with no legend
#' 
#' @param data sf layer with column 'city_letter' at least
#' @param border_color A unique color value
#' @param border_width A unique width value
#' @param my_palette a named vector of colours associated to 'city_letter'
my_layer_point_border_no_legend <- function(data, 
                                  border_color, 
                                  border_width, 
                                  my_palette) {
  tm_shape(data) +
    tm_symbols(col = "city_letter", 
               palette = my_palette,
               border.col = border_color, 
               border.lwd = border_width, 
               legend.col.show = FALSE, 
               size = 0.5)
}

# Define a color palette
my_palette <- setNames(symbology[["color"]], symbology[["city_letter"]])

# Full pipe creation of tmap layers by border types
metro_small_tmap_layer <- 
  metro_small_symbology %>% 
  # nest
  nest(data = -c(border_color, border_width)) %>% 
  # Calculate tmap shapes
  mutate(tm_layer = 
           pmap(list(data, border_color, border_width), my_layer_point_border_no_legend, my_palette = my_palette)) %>% 
  pull(tm_layer) %>% 
  reduce(`+`)

# Create symbology from the original layer
layer_symbology <- metro_small_symbology %>% 
  st_drop_geometry() %>% 
  distinct(city_letter, color, border_color, border_width)

# Draw the map
tm_shape(World) + 
    tm_polygons() + 
  metro_small_tmap_layer + # layer with points
  tm_add_legend(type = "symbol", 
                title = "City Letter start",
                labels = layer_symbology[["city_letter"]], 
                col = layer_symbology[["color"]],
                border.col = layer_symbology[["border_color"]],
                border.lwd = layer_symbology[["border_width"]]
  )

Créer une symbologie

Vous pouvez créer une symbologie pour chaque couche à dessiner. Cette symbologie pourra être utilisée pour tous vos projets sur le même sujet.
Dans mon cas, je vais créer une symbologie liée à la première lettre du code iso_a3 :

  • Les villes dont le code iso_a3 commence par A seront dessinées avec un disque bleu, avec une bordure sombre de largeur 1.
  • Les villes dont le code iso_a3 commence par D seront dessinées avec un cercle rouge, avec une bordure transparente de largeur 0.
  • Toutes les autres villes seront dessinées avec un cercle blanc, avec une bordure verte de largeur 3.
  • Je crée une symbologie supplémentaire, qui ne sera pas utilisée dans cet exemple mais qui pourrait l’être plus tard. Il s’agit d’illustrer ce qui va se passer ensuite.
symbology <-tribble(
  ~city_letter, ~color, ~border_color, ~border_width,
  "A-start", "cyan", "black", 0.5,
  "D-start", "orangered", "transparent", 0,
  "Others", "white", "forestgreen", 1,
  "Extra not used", "black", "cyan", 1,
)
symbology
## # A tibble: 4 × 4
##   city_letter    color     border_color border_width
##   <chr>          <chr>     <chr>               <dbl>
## 1 A-start        cyan      black                 0.5
## 2 D-start        orangered transparent           0  
## 3 Others         white     forestgreen           1  
## 4 Extra not used black     cyan                  1

Maintenant je peux associer ma symbologie à ma couche :

  • Premièrement, je dois créer une nouvelle colonne qui correspondra à la colonne city_letter de la symbologie.
  • Ensuite, je peux associer la symbologie à ma couche
metro_small_symbology <- metro_small %>% 
  mutate(city_letter = case_when(
    str_starts(iso_a3, "A") ~ "A-start",
    str_starts(iso_a3, "D") ~ "D-start",
    TRUE ~ "Others"
  )) %>% 
  left_join(symbology, by = "city_letter")
metro_small_symbology
## Simple feature collection with 436 features and 6 fields
## Geometry type: POINT
## Dimension:     XY
## Bounding box:  xmin: -123.1193 ymin: -37.814 xmax: 174.7667 ymax: 60.16925
## Geodetic CRS:  WGS 84
## First 10 features:
##                name_long iso_a3 city_letter     color border_color border_width
## 1                  Kabul    AFG     A-start      cyan        black          0.5
## 2  El Djazair  (Algiers)    DZA     D-start orangered  transparent          0.0
## 3                 Luanda    AGO     A-start      cyan        black          0.5
## 4           Buenos Aires    ARG     A-start      cyan        black          0.5
## 5                Cordoba    ARG     A-start      cyan        black          0.5
## 6                Rosario    ARG     A-start      cyan        black          0.5
## 7                Yerevan    ARM     A-start      cyan        black          0.5
## 8               Adelaide    AUS     A-start      cyan        black          0.5
## 9               Brisbane    AUS     A-start      cyan        black          0.5
## 10             Melbourne    AUS     A-start      cyan        black          0.5
##                       geometry
## 1    POINT (69.17246 34.52889)
## 2      POINT (3.04197 36.7525)
## 3    POINT (13.23432 -8.83682)
## 4  POINT (-58.40037 -34.60508)
## 5   POINT (-64.18105 -31.4135)
## 6  POINT (-60.63932 -32.94682)
## 7      POINT (44.51462 40.182)
## 8   POINT (138.5986 -34.92866)
## 9   POINT (153.0281 -27.46794)
## 10    POINT (144.9633 -37.814)

Cartographier les points avec des couleurs différentes

Je peux utiliser la symbologie pour cartographier mes points avec des couleurs différentes selon la colonne city_letter.

tm_shape(World) + 
    tm_polygons() + 
tm_shape(metro_small_symbology) +
    tm_symbols(col = "city_letter")

Je peux modifier ma palette par défaut pour utiliser ma propre symbologie. Pour ce faire, j’ai besoin d’un vecteur nommé dans l’argument palette de ma symbology.

my_palette <- setNames(symbology[["color"]], symbology[["city_letter"]])

tm_shape(World) + 
    tm_polygons() + 
tm_shape(metro_small_symbology) +
    tm_symbols(col = "city_letter", palette = my_palette)

Carte de points avec des couleurs et des bordures différentes

A ce jour, il n’est pas possible de définir des couleurs et des tailles de bordure différentes pour la même forme de point dans {tmap}.
En effet, l’argument border.col ne requiert qu’une seule valeur. L’exemple ci-dessous ne peut pas fonctionner comme prévu.

my_palette <- setNames(symbology[["color"]], symbology[["city_letter"]])

tm_shape(World) + 
    tm_polygons() + 
tm_shape(metro_small_symbology) +
    tm_symbols(col = "city_letter", palette = my_palette,
               border.col = symbology[["border_color"]])
## Warning in if (is.na(symbol.border.col)) {: la condition a une longueur > 1 et
## seul le premier élément est utilisé

Par conséquent, nous devons

  • séparer l’ensemble de données, en fonction des types de frontières
  • dessiner la couche pour chaque type
  • créer manuellement une légende combinée

Nous pouvons nest l’objet {sf} pour créer nos 3 types de couches, selon les types de bordures.

metro_small_symbology_nested <- metro_small_symbology %>% 
  nest(data = -c(border_color, border_width))

metro_small_symbology_nested
## # A tibble: 3 × 3
##   border_color border_width data          
##   <chr>               <dbl> <list>        
## 1 black                 0.5 <sf [14 × 5]> 
## 2 transparent           0   <sf [7 × 5]>  
## 3 forestgreen           1   <sf [415 × 5]>

Nous créons une fonction qui peut dessiner une couche avec des bordures définies.

#' A custom symbol layer
#' 
#' @param data sf layer with column 'city_letter' at least
#' @param border_color A unique color value
#' @param border_width A unique width value
#' @param my_palette a named vector of colours associated to 'city_letter'
my_layer_point_border <- function(data, 
                                  border_color, 
                                  border_width, 
                                  my_palette) {
  tm_shape(data) +
    tm_symbols(col = "city_letter", 
               palette = my_palette,
               border.col = border_color, 
               border.lwd = border_width)
}

# example
my_layer_point_border(metro_small_symbology, border_color = "red", border_width = 3, my_palette = my_palette)

Et maintenant, nous pouvons appliquer cette fonction à l’ensemble de données imbriquées.

metro_small_symbology_nested_tmap <- 
  metro_small_symbology_nested %>% 
  mutate(tm_layer = 
           pmap(list(data, border_color, border_width), my_layer_point_border, my_palette = my_palette))

metro_small_symbology_nested_tmap
## # A tibble: 3 × 4
##   border_color border_width data           tm_layer
##   <chr>               <dbl> <list>         <list>  
## 1 black                 0.5 <sf [14 × 5]>  <tmap>  
## 2 transparent           0   <sf [7 × 5]>   <tmap>  
## 3 forestgreen           1   <sf [415 × 5]> <tmap>

Ensuite, extraire la colonne créée, combiner et dessiner les couches, indépendamment …

metro_small_symbology_borders <- metro_small_symbology_nested_tmap[["tm_layer"]] %>% 
  reduce(`+`)

metro_small_symbology_borders

… ou avec le Monde derrière.

tm_shape(World) + 
    tm_polygons() + 
  metro_small_symbology_borders

S’occuper de la légende

Le problème de l’utilisation de plusieurs couches pour une seule est que la légende est séparée. Par conséquent, nous devons créer la nôtre avec tm_add_legend() à partir de notre symbologie.

tm_shape(World) + 
    tm_polygons() + 
  metro_small_symbology_borders +
  tm_add_legend(type = "symbol", 
                title = "City Letter start",
                labels = symbology[["city_letter"]], 
                col = symbology[["color"]],
                border.col = symbology[["border_color"]],
                border.lwd = symbology[["border_width"]]
  )

La carte finale avec les couleurs et les tailles des bordures

  • Nous pouvons créer la légende à partir de votre couche, puisque tous les niveaux de la symbologie ne sont pas utilisés.
  • Nous allons également changer la fonction pour cacher la légende automatique des 3 couches
#' A custom symbol layer with no legend
#' 
#' @param data sf layer with column 'city_letter' at least
#' @param border_color A unique color value
#' @param border_width A unique width value
#' @param my_palette a named vector of colours associated to 'city_letter'
my_layer_point_border_no_legend <- function(data, 
                                  border_color, 
                                  border_width, 
                                  my_palette) {
  tm_shape(data) +
    tm_symbols(col = "city_letter", 
               palette = my_palette,
               border.col = border_color, 
               border.lwd = border_width, 
               legend.col.show = FALSE, 
               size = 0.5)
}

# Full pipe creation of tmap layers
metro_small_tmap_layer <- 
  metro_small_symbology %>% 
  # nest
  nest(data = -c(border_color, border_width)) %>% 
  # Calculate tmap shapes
  mutate(tm_layer = 
           pmap(list(data, border_color, border_width), my_layer_point_border_no_legend, my_palette = my_palette)) %>% 
  pull(tm_layer) %>% 
  reduce(`+`)

# Create symbology from the original layer
layer_symbology <- metro_small_symbology %>% 
  st_drop_geometry() %>% 
  distinct(city_letter, color, border_color, border_width)

# Draw the map
tm_shape(World) + 
    tm_polygons() + 
  metro_small_tmap_layer + # layer with points
  tm_add_legend(type = "symbol", 
                title = "City Letter start",
                labels = layer_symbology[["city_letter"]], 
                col = layer_symbology[["color"]],
                border.col = layer_symbology[["border_color"]],
                border.lwd = layer_symbology[["border_width"]]
  )

Et voilà !
A plus tard pour d’autres trucs et astuces sur les cartes ou le développement de packages…



Citation :

Merci de citer ce travail avec :
Rochette Sébastien. (2022, avr.. 28). "Ajouter une couche géographique de points dans {tmap} avec plusieurs formats de bordures". Retrieved from https://statnmap.com/fr/2022-04-28-tmap-point-layer-with-multiple-symbol-border-colors-and-width/.


Citation BibTex :
@misc{Roche2022Ajout,
    author = {Rochette Sébastien},
    title = {Ajouter une couche géographique de points dans {tmap} avec plusieurs formats de bordures},
    url = {https://statnmap.com/fr/2022-04-28-tmap-point-layer-with-multiple-symbol-border-colors-and-width/},
    year = {2022}
  }