Ç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_a3commence parAseront dessinées avec un disque bleu, avec une bordure sombre de largeur 1. - Les villes dont le code
iso_a3commence parDseront 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 1Maintenant je peux associer ma symbologie à ma couche :
- Premièrement, je dois créer une nouvelle colonne qui correspondra à la colonne
city_letterde 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}
}