FAIRE DES CARTES DE FLUX DANS R
L’objectif de cette séance est de présenter la construction de différentes cartes de flux décrivant des flux migratoires internationaux observés à l’échelle mondiale. Pour cela, nous mobilisons une matrice de flux origine-destination (OD) internationale (pays * pays) asymétrique, ainsi qu’un fond de carte des pays du monde. Ces données statistiques et géographiques vont être traitées afin d’enrichir la représentation. L’ensemble des étapes est codé dans R, sous une forme qui n’est pas toujours optimisée et beaucoup des traitements réalisés mobilisent {R base}. Le présent document présente l’ensemble de la chaîne de traitement : de la préparation des matrices OD, celle des fonds de carte à la représentation des flux du point de vue de lieux d’origine (ou de destination) et/ou des échanges entre OD, entraînant beaucoup de manipulations. L’idée n’est donc pas de commenter le code in extenso, mais d’expliciter une démarche, c’est-à-dire de montrer comment on peut réaliser des cartes de flux dans R selon différentes perspectives, dans le cadre démarche traçable, partageable et reproductible
- Créez un projet R et un script R.
- Créez un repertoire data pour stocker les données.
- Créez un répertoire maps dans lequel seront stockées les cartes
Ce document est accessible à l’adresse suivante https://transcarto.github.io/rflows/TRANSCARTO_flows.html
Le code source est disponible ici https://github.com/transcarto/rflows
Les packages
Avant de commencer, voici la liste des packages à installer et à charger. Les 3 packages les plus importants sont sf, mapsf et ttt.
install.packages("sf")
install.packages("remotes")
install.packages("smoothr")
install.packages("readxl")
install.packages("comparator")
install.packages("reshape2")
install.packages("dplyr")
library("remotes")
#install_github("riatelab/mapsf")
install.packages("mapsf")
install.packages("cartograflow")
install_github("tributetotobler/ttt")
library("sf")
library("mapsf")
library("ttt")
library("readxl")
library("comparator")
library("reshape2")
Les données
Données géométriques
Ici, nous utilisons des données géométriques sur mesure préparées en amont, qui permettent de coller exactement avec les données à cartographier. Il s’agit d’un fond de carte des pays du monde dont la nomenclature correspond à celle des données statistiques fournies par les Nations unies.
<- st_read("https://raw.githubusercontent.com/transcarto/rflows/master/data/world/geom/countries.geojson")
countries <- st_read("https://raw.githubusercontent.com/transcarto/rflows/master/data/world/geom/graticule.geojson")
graticule <- st_read("https://raw.githubusercontent.com/transcarto/rflows/master/data/world/geom/bbox.geojson")
bbox
<-
crs "+proj=aeqd +lat_0=90 +lon_0=50 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs "
<- st_transform(x = countries, crs = crs)
countries <- st_transform(x = graticule, crs = crs)
graticule <- st_transform(x = bbox, crs = crs)
bbox <- st_union(countries) land
Réalisation d’un template cartographique avec mapsf
= "#ffc524"
col = paste0(
credit "Françoise Bahoken & Nicolas Lambert, 2021\n",
"Source: United Nations, Department of Economic\n",
"and Social Affairs, Population Division (2019)"
)
<- mf_theme(
theme x = "default",
bg = "#3b3b3b",
fg = "#ffc524",
mar = c(0, 0, 2, 0),
tab = TRUE,
pos = "left",
inner = FALSE,
line = 2,
cex = 1.9,
font = 3
)
= function(title, file) {
template mf_export(
countries,export = "png",
width = 1000,
filename = file,
res = 96,
theme = theme,
expandBB = c(-.02, 0, -.02, 0)
)mf_map(
bbox,col = "#3b3b3b",
border = NA,
lwd = 0.5,
add = TRUE
)mf_map(graticule,
col = "#FFFFFF50",
lwd = 0.5,
add = TRUE)
mf_map(
countries,col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)# mf_map(links, col = NA,border = "#317691", lwd = 0.5, add = TRUE)
mf_credits(
txt = credit,
pos = "bottomright",
col = "#1a2640",
cex = 0.7,
font = 3,
bg = "#ffffff30"
)mf_title(title)
}
template("Template cartographique", "maps/template.png")
dev.off()
Données de flux Origine-Destination
Nous utilisons un jeu de données sur les migrations internationales. Migration Stock at subregional level, 2019 Source : United Nations, Department of Economic and Social Affairs, Population Division (2019).
Celui-ci est proposé au format xls. Nous l’importons et le mettons en forme via le code ci-dessous.
Précisions sur les données : Ce jeu décrit l’effectif de populations partie ou acceuillie dans un pays autre que le leur, autorisant ainsi une représentation sous la forme de stocks et/ou sous la forme de flux de populations étrangères. Ces flux mettent en relation des pays de résidence (ceux de destination, placés en lignes dans le fichier .xls) avec des pays d’origine (ceux de départ, placés en colonnes dans le fichier .xls), correspondant à ceux dont les personnes recensées en tant qu’étrangères portent la nationalité. Il reconstruit par là une donnée origine-destination (OD) à partir d’effectifs de migrants que l’on est autorisés de représenter sous la forme de flux.
Téléchargez le fichier UN_MigrantStockByOriginAndDestination_2019.xlsx et placez-le dans votre répertoire data.
Cette opération peut se faire avec le code suivant :
<-
data_url "https://raw.githubusercontent.com/transcarto/rflows/master/data/world/UN_MigrantStockByOriginAndDestination_2019.xlsx"
<- "data/UN_MigrantStockByOriginAndDestination_2019.xlsx"
file if (!file.exists(file)) {
download.file(url = data_url, destfile = file)
}
Choix de la feuille et de l’année de référence
<- "Table 1"
sheet <- 2019 year
Import et mise en forme
<- data.frame(read_excel(file, skip = 15, sheet = sheet))
migr <- migr[migr[, 1] == year, ]
migr
<- migr[!is.na(migr[, 6]), ]
migr <-
migr subset(migr,
select = -c(...1, ...2, ...5, ...4, ...6, Total, Other.North, Other.South))
colnames(migr)[1] <- "i"
<- migr[order(migr[, "i"], decreasing = FALSE), ]
migr for (i in 2:length(colnames(migr))) {
<- as.numeric(migr[, i])
migr[, i] }
Affectation des codes ISO du fond du carte en ligne et en colonne
<- countries[,2:4] %>% st_drop_geometry()
ctr <- ctr[order(ctr[,"label"], decreasing =FALSE),]
ctr <- ctr$adm0_a3_is
codes
# Verification manuelle
$rows <- migr[,"i"]
ctr$cols <- colnames(migr)[-1]
ctrfor(i in 1:nrow(ctr)){
$rows_test[i] = LCS(similarity = TRUE)(ctr$label[i], ctr$rows[i]) / ((nchar(ctr$label[i]) + nchar(ctr$rows[i])) / 2) * 100
ctr$cols_test[i] = LCS(similarity = TRUE)(ctr$label[i], ctr$cols[i]) / ((nchar(ctr$label[i]) + nchar(ctr$cols[i])) / 2) * 100
ctr }
::kable(ctr[c(0:10),], row.names = F, digits = 1) knitr
un_a3 | adm0_a3_is | label | rows | cols | rows_test | cols_test |
---|---|---|---|---|---|---|
4 | AFG | Afghanistan | Afghanistan | Afghanistan | 100 | 100.0 |
8 | ALB | Albania | Albania | Albania | 100 | 100.0 |
12 | DZA | Algeria | Algeria | Algeria | 100 | 100.0 |
16 | ASM | American Samoa | American Samoa | American.Samoa | 100 | 92.9 |
20 | AND | Andorra | Andorra | Andorra | 100 | 100.0 |
24 | AGO | Angola | Angola | Angola | 100 | 100.0 |
660 | AIA | Anguilla | Anguilla | Anguilla | 100 | 100.0 |
28 | ATG | Antigua and Barbuda | Antigua and Barbuda | Antigua.and.Barbuda | 100 | 89.5 |
32 | ARG | Argentina | Argentina | Argentina | 100 | 100.0 |
51 | ARM | Armenia | Armenia | Armenia | 100 | 100.0 |
rownames(migr) <- codes
colnames(migr) <- c("i",codes)
<- migr[,-1] migr
::kable(migr[c(0:15),c(0:15)], row.names = T, digits = 1) knitr
AFG | ALB | DZA | ASM | AND | AGO | AIA | ATG | ARG | ARM | ABW | AUS | AUT | AZE | BHS | |
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
AFG | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
ALB | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
DZA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
ASM | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
AND | NA | NA | NA | NA | NA | NA | NA | NA | 727 | NA | NA | 69 | NA | NA | NA |
AGO | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
AIA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
ATG | NA | NA | NA | NA | NA | NA | 40 | NA | NA | NA | 5 | 7 | NA | NA | 2 |
ARG | 9 | 67 | 105 | NA | 1 | 9 | NA | NA | NA | 570 | 1 | 279 | 1039 | NA | NA |
ARM | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | 78478 | NA |
ABW | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
AUS | 59798 | 3872 | 1745 | 0 | 31 | 592 | NA | 63 | 17583 | 1629 | 74 | NA | 18091 | 740 | 327 |
AUT | 20561 | 3715 | 1522 | NA | 2 | 402 | NA | 8 | 1797 | 3601 | NA | 2939 | NA | 1270 | 25 |
AZE | 178 | NA | NA | NA | NA | NA | NA | NA | NA | 142650 | NA | NA | NA | NA | NA |
BHS | NA | NA | NA | NA | NA | NA | NA | 14 | 117 | NA | NA | 88 | 42 | NA | NA |
Transposition de la matrice
<- t(migr) migr
Passage de la matrice du format large (wide) au format long (liste) i, j, fij
<- melt(migr)
migr colnames(migr) = c("i", "j", "fij")
= migr[!is.na(migr$fij), ]
migr = migr[migr$fij > 0, ]
migr = migr[order(migr$fij, decreasing = TRUE), ] migr
::kable(migr[c(0:10),], row.names = F, digits = 1) knitr
i | j | fij |
---|---|---|
MEX | USA | 11489684 |
SYR | TUR | 3743494 |
IND | ARE | 3419875 |
RUS | UKR | 3308515 |
UKR | RUS | 3269248 |
BGD | IND | 3103664 |
CHN | USA | 2899267 |
IND | USA | 2661470 |
KAZ | RUS | 2559711 |
RUS | KAZ | 2458414 |
Sauvegarder du fichier mis en forme au format .csv
write.csv(migr, "data/migr.csv", row.names = FALSE)
Ce fichier de données correctement formaté est dorénavant accessible comme ceci.
<- read.csv("data/migr.csv") migr
Calculs d’indicateurs avec la package cartograflow. Ce package, développé par Françoise Bahoken, contient des fonctions permettant de préparer et de filtrer la matrice origine-destination à des fins de cartographie thématique des flux.
Vérification si la matrice est carrée, car le calcul des indicateurs s’appuie sur la propriété générale de symétrie de la matrice par rapport à la diagonale principale**
library("cartograflow")
<- migr
tabflow
#Verification si la matrice est carree et fermee
<- flowtabmat(tabflow, matlist = "M")
matflow
# Rendre la matrice carree
#---------------------
# on cree une liste des codes ISO de l'ensemble des entités
library("dplyr")
<- countries %>% select(adm0_a3_is)
liste <- as.data.frame(liste$adm0_a3_is)
liste
#on s'en sert pour creer la matrice
<- flowcarre(
tabflow2 tab = tabflow,
liste = liste,
origin = "i",
dest = "j",
valflow = "fij",
format = "L",
diagonale = TRUE,
empty.sq = FALSE
)
## 'data.frame': 232 obs. of 1 variable:
## $ liste$adm0_a3_is: chr "BGR" "MMR" "BDI" "BLR" ...
#on renomme les variables correctement
colnames(tabflow2) <- c("i", "j", "fij")
$i <- as.character(tabflow2$i)
tabflow2$j <- as.character(tabflow2$j)
tabflow2$fij <- as.numeric(tabflow2$fij)
tabflow2
# On calcule des indicateurs fondés sur la symétrie
# Volume bilateral as Tobler
<- flowtype(
flow_vol2
tabflow2,origin = "i",
destination = "j",
fij = "fij",
format = "L",
x = "bivolum"
)
# solde/balance bilateral as Tobler
<- flowtype(
flow_net2
tabflow2,origin = "i",
destination = "j",
fij = "fij",
format = "L",
x = "bibal"
)
#calcul de plusieurs indicateurs
<-
flow_indic flowtype(
tabflow2,origin = "i",
destination = "j",
fij = "fij",
format = "L",
x = "alltypes"
)
#suppression des NA car divisions par zero
for (i in 1:nrow(flow_indic))
for (j in 1:ncol(flow_indic))
{if (is.na.data.frame(flow_indic[i, j]) == TRUE) {
<- 0
flow_indic[i, j]
}
}
head(flow_indic)
## i j Fij Fji FSij FBij FAij minFij maxFij rangeFij FDij
## 1 ABW ABW 0 0 0 0 0 0 0 0 0
## 2 ABW AFG 0 0 0 0 0 0 0 0 0
## 3 ABW AGO 0 0 0 0 0 0 0 0 0
## 4 ABW AIA 0 0 0 0 0 0 0 0 0
## 5 ABW ALB 0 0 0 0 0 0 0 0 0
## 6 ABW AND 0 0 0 0 0 0 0 0 0
Sauvegarde de la matrice carree et fermée avec des zéros. C’est important car permet de calculer la densité de la matrice (tx de remplissage) = nb de liens renseignes / nb de liens theoriques. Ce qui est un premier indicateur**
Sauvegarde du fichier (matrice carrée incluant les zero) mis en forme au format .csv
write.csv(tabflow2, "data/migr2.csv", row.names = FALSE)
Ce fichier de données correctement formaté est dorénavant accesible comme ceci.
<- read.csv("data/migr2.csv") tabflow2
Tout est prêt. Avançons …
Premières explorations
On considère la matrice migr : elle est formée de 11305 couples d’OD et de 3 variables.
<- read.csv("data/migr.csv")
migr dim(migr)
## [1] 11305 3
L’effet Spaghetti
Création d’une couche de liens correspondant aux 11305 lignes de la matrice migr
<-
links mf_get_links(
x = countries,
df = migr,
x_id = "adm0_a3_is",
df_id = c("i", "j")
)
Cartographie de ces liens en utilisant le template. La carte spaghetti.png est enregistrée dans le répertoire ./maps
template("L'effet Spaghetti ", "maps/spaghetti.png")
mf_map(links, col = col, add = TRUE)
mf_map(land,
col = NA,
border = "#3b3b3b",
add = TRUE)
dev.off()
Pour simplifier l’image de ces flux (réduire le nombre de signes représentés), plusieurs possibilités sont envisageables. L’une d’entre elles consiste à sélectionner les signes à représenter en raisonant soit sur les lignes/colonnes de la matrice (donc sur les lieux d’origine/destination) et/ou soit sur le coeur de la matrice (sur les relations).
Commençons par raisonner sur les lieux.
Choix d’un pays de référence
Pour simplifier la carte, choisissons un seul pays de référence depuis/vers lequel on observe les flux.
<- "FRA"
ISO3 = "France" label
Création d’une sous-matrice migrFRA des flux à destination de la France, jointure et mise en forme des données
<- countries[, c("adm0_a3_is", "label")]
countr <- migr[migr$j == ISO3, ]
migrFRA $fij <- as.numeric(migrFRA$fij)
migrFRA= max(migrFRA$fij)
maxval = round(sum(migrFRA$fij) / 1000000,1)
total <-
countr merge(
x = countr,
y = migrFRA,
by.x = "adm0_a3_is",
by.y = "i",
all.x = TRUE
)<- countr[-3]
countr colnames(countr) <- c("id", "label", "fij", "geometry")
::kable(countr[c(0:10),], row.names = F, digits = 1) knitr
id | label | fij | geometry |
---|---|---|---|
ABW | Aruba | 11 | MULTIPOLYGON (((-7476945 42… |
AFG | Afghanistan | 6887 | MULTIPOLYGON (((2474775 -53… |
AGO | Angola | 23438 | MULTIPOLYGON (((-4917506 -1… |
AIA | Anguilla | 10 | MULTIPOLYGON (((-7351488 31… |
ALB | Albania | 7371 | MULTIPOLYGON (((-2639654 -4… |
AND | Andorra | 1079 | MULTIPOLYGON (((-3952645 -3… |
ARE | United Arab Emirates | 862 | MULTIPOLYGON (((785851 -712… |
ARG | Argentina | 14253 | MULTIPOLYGON (((-14113355 7… |
ARM | Armenia | 21012 | MULTIPOLYGON (((-348529.3 -… |
ASM | American Samoa | 1 | MULTIPOLYGON (((7561304 878… |
Réalisation d’une première carte de stocks sur le nombre d’étrangers présents en France : ; elle correspond à la somme marginale de la colonne iso3=FRA.
template(paste0("En 2019, il y avait ",total, " millions d'étrangers en France"),
"maps/prop1.png")
#mf_map(countr[countr$id == ISO3,], col = col, border = "red", lwd = 2, add = TRUE)
mf_map(
$id != ISO3, ],
countr[countrvar = "fij",
col = col,
border = "white",
type = "prop",
val_max = maxval,
inches = 0.4,
leg_title_cex = 1.2,
leg_val_cex = 0.8,
leg_pos = "bottomleft",
leg_title = "Nombre de personnes"
)mf_map(
$id == ISO3, ],
countr[countrcol = NA,
border = "#e36019",
lwd = 2,
add = TRUE
)dev.off()
Création d’une sous-matrice migrFRA des flux originaires de la France, jointure et mise en forme des données
<- countries[, c("adm0_a3_is", "label")]
countr <- migr[migr$i == ISO3, ]
migrFRA $fij <- as.numeric(migrFRA$fij)
migrFRA= round(sum(migrFRA$fij) / 1000000,1)
total <-
countr merge(
x = countr,
y = migrFRA,
by.x = "adm0_a3_is",
by.y = "j",
all.x = TRUE
)<- countr[-3]
countr colnames(countr) <- c("id", "label", "fij", "geometry")
Réalisation d’une seconde carte de stocks sur le nombre de français à l’étranger ; elle correspond à la somme marginale de la ligne iso3=FRA.
template(paste0("En 2019, il y avait ",total, " millions de Français à l'étranger"),
"maps/prop2.png")
mf_map(
$id != ISO3, ],
countr[countrvar = "fij",
col = col,
border = "white",
type = "prop",
val_max = maxval,
inches = 0.4,
leg_title_cex = 1.2,
leg_val_cex = 0.8,
leg_pos = "bottomleft",
leg_title = "Nombre de personnes"
)mf_map(
$id == ISO3, ],
countr[countrcol = NA,
border = "#e36019",
lwd = 2,
add = TRUE
)dev.off()
Raisonnons maintenant sur les relations entre les lieux.
Choix des relations avec un pays de référence
Réalisation d’une troisième carte mettant en relation la France avec les pays d’origine des étrangers qui résident sur le territoire national, et pondération de ces liens en fonction du nombre de personnes concernées.
Préparation d’une sous-matrice migrtoFRA formée des liens entrant dans la colonne iso3=FRA.
<- "FRA"
ISO3 = "France"
label <- migr[migr$j == ISO3,]
migrtoFRA $fij <- as.numeric(migrtoFRA$fij) migrtoFRA
Création de la couche de liens correspondante
<-
links mf_get_links(
x = countries,
df = migrtoFRA,
x_id = "adm0_a3_is",
df_id = c("i", "j")
)
Cartographie de ces liens avec une dimension de largeur proportionnelle à l’effectif de fij
template(
paste0("Origine des personnes étrangères vivant en ", label, " en 2019"),
"maps/links1.png"
)mf_map(
links,var = "fij",
col = col,
border = "white",
type = "prop",
inches = 10,
leg_title_cex = 1.2,
leg_val_cex = 0.8,
leg_pos = "bottomleft",
leg_title = "Nombre de personnes"
)mf_map(
$adm0_a3_is == ISO3, ],
countries[countriescol = "#4e4f4f",
border = col,
lwd = 1.5,
add = TRUE
)dev.off()
La matrice étant orientée, il est possible de raisonner selon les flux entre les lieux, qu’il convient de préparer
Filtrages et indicateurs
Le principe général est de sélectionner les liens à représenter pour ne représenter que ceux jugés “significatifs”. Le filtrage peut être soit global (on applique une valeur unique en deça/au-dessus de laquelle les flux ne seront pas représentés) ou soit local, concernant les lieux (on filtre les flux en fonction de considérations sur les l’origie et/ou la destination).
Application d’un critère global
Tobler indique que seuls les flux supérieurs à la moyenne devront être représentés. On peut faire un test. Ce critère n’est pas toujours suffisant, car dépend de la densité de la matrice. Il est plus prudent de sélectionner un critère selon les quantile.
<- read.csv("data/migr2.csv")
tabflow2
<- (tabflow2$fij)
fij
<- mean(fij) #as Tobler
mean
#Q3<-quantile(flow$fij,0.75) #25% of the most important migrations
#Q95<-quantile(flow$fij, 0.95) # 5% of the most important migrations
#Q98<-quantile(flow$fij, 0.98) # 2% of the most important migrations
Flux supérieurs à la moyenne
Vers des cartes un peu plus graphiques
Une carte un peu plus sophistiquée avec packcircles
Avec le code ci-dessous, on cherche à réaliser une carte à la façon de cette application interactive.
<- "FRA"
ISO3 = "France"
label <- migr[migr$j == ISO3,]
migrFRA $fij <- as.numeric(migrFRA$fij)
migrFRA<-
migrFRA rbind.data.frame(migrFRA, c(
i = ISO3,
j = ISO3,
fij = sum(as.numeric(migrFRA$fij))
))<- countries[, "adm0_a3_is"]
countr <-
countr merge(
x = countr,
y = migrFRA,
by.x = "adm0_a3_is",
by.y = "i",
all.x = TRUE
)colnames(countr) <- c("i", "j", "fij", "geometry")
::kable(countr[c(0:10),], row.names = F, digits = 1) knitr
i | j | fij | geometry |
---|---|---|---|
ABW | FRA | 11 | MULTIPOLYGON (((-7476945 42… |
AFG | FRA | 6887 | MULTIPOLYGON (((2474775 -53… |
AGO | FRA | 23438 | MULTIPOLYGON (((-4917506 -1… |
AIA | FRA | 10 | MULTIPOLYGON (((-7351488 31… |
ALB | FRA | 7371 | MULTIPOLYGON (((-2639654 -4… |
AND | FRA | 1079 | MULTIPOLYGON (((-3952645 -3… |
ARE | FRA | 862 | MULTIPOLYGON (((785851 -712… |
ARG | FRA | 14253 | MULTIPOLYGON (((-14113355 7… |
ARM | FRA | 21012 | MULTIPOLYGON (((-348529.3 -… |
ASM | FRA | 1 | MULTIPOLYGON (((7561304 878… |
Cercles avec packcircles (Dorling style)
library("packcircles")
= countr
dots st_geometry(dots) <-
st_centroid(sf::st_geometry(dots), of_largest_polygon = TRUE)
<- data.frame(dots$i, dots["fij"], st_coordinates(dots))
dots = dots[, c("dots.i", "X", "Y", "fij")]
dots colnames(dots) <- c("id", "x", "y", "v")
<- dots[!is.na(dots$v), ]
dots
= 700000 # pour ajuster la taille des cercles
k = 10 # nombre d'iterations
itermax = 35000
delta <- dots[, c("x", "y", "v", "id")]
dat.init $v <- sqrt(as.numeric(dat.init$v) * k)
dat.init<- circleRepelLayout(
simulation x = dat.init,
xysizecols = 1:3,
wrap = FALSE,
sizetype = "radius",
maxiter = itermax,
weights = 1
$layout
)<- st_buffer(sf::st_as_sf(
circles
simulation,coords = c('x', 'y'),
crs = sf::st_crs(countries)
),dist = simulation$radius - delta)
$v = dots$v
circles$id = dots$id circles
Links
# Links
$j = "FRA"
dots
<-
links mf_get_links(
x = circles,
df = migrFRA,
x_id = "id",
df_id = c("i", "j")
)$fij = as.numeric(links$fij) links
Réalisation de la carte
template("Les étrangers en France, 2019", "maps/migrexplorer1.png")
= "#4e4f4f"
col2
mf_map(
land,col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)
mf_map(
links,var = "fij",
col = col,
border = "#3b3b3b",
type = "prop",
lwd_max = 160,
leg_pos = "n",
add = TRUE
)
mf_map(
$id != ISO3, ],
circles[circlesvar = "fij",
col = col,
border = "#3b3b3b",
lwd = 1.5,
add = TRUE
)
mf_map(
$id == ISO3, ],
circles[circlesvar = "fij",
col = col2,
border = col,
lwd = 2.5,
add = TRUE
)
= circles[circles$id != ISO3, ]
t mf_label(
t,var = "id",
halo = FALSE,
cex = sqrt(as.numeric(t$v) / 1200000),
col = col2,
overlap = TRUE,
lines = FALSE
)
= circles[circles$id == ISO3, ]
t mf_label(
t,var = "id",
halo = FALSE,
cex = sqrt(as.numeric(t$v) / 1200000),
col = col,
overlap = TRUE,
lines = FALSE
)
dev.off()
Comme précédemment, on peut faire la carte des français présents à l’étranger, en regardant la destination
<- "FRA"
ISO3 = "France"
label <- migr[migr$i == ISO3,] # ici
migrFRA $fij <- as.numeric(migrFRA$fij)
migrFRA<-
migrFRA rbind.data.frame(migrFRA, c(
i = ISO3,
j = ISO3,
fij = sum(as.numeric(migrFRA$fij))
))<- countries[, "adm0_a3_is"]
countr <-
countr merge(
x = countr,
y = migrFRA,
by.x = "adm0_a3_is",
by.y = "j", # là
all.x = TRUE
)colnames(countr) <- c("i", "j", "fij", "geometry")
= countr
dots st_geometry(dots) <-
st_centroid(sf::st_geometry(dots), of_largest_polygon = TRUE)
<- data.frame(dots$i, dots["fij"], st_coordinates(dots))
dots = dots[, c("dots.i", "X", "Y", "fij")]
dots colnames(dots) <- c("id", "x", "y", "v")
<- dots[!is.na(dots$v), ]
dots
= 700000 # pour ajuster la taille des cercles
k = 10 # nombre d'iterations
itermax = 35000
delta <- dots[, c("x", "y", "v", "id")]
dat.init $v <- sqrt(as.numeric(dat.init$v) * k)
dat.init<- circleRepelLayout(
simulation x = dat.init,
xysizecols = 1:3,
wrap = FALSE,
sizetype = "radius",
maxiter = itermax,
weights = 1
$layout
)<- st_buffer(sf::st_as_sf(
circles
simulation,coords = c('x', 'y'),
crs = sf::st_crs(countries)
),dist = simulation$radius - delta)
$v = dots$v
circles$id = dots$id circles
Links
# Links
$j = "FRA"
dots
<-
links mf_get_links(
x = circles,
df = migrFRA,
x_id = "id",
df_id = c("i", "j")
)$fij = as.numeric(links$fij) links
Réalisation de la carte
template("Les français à l'étranger, 2019", "maps/migrexplorer2.png")
= "#4e4f4f"
col2
mf_map(
land,col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)
mf_map(
links,var = "fij",
col = col,
border = "#3b3b3b",
type = "prop",
lwd_max = 160,
leg_pos = "n",
add = TRUE
)
mf_map(
$id != ISO3, ],
circles[circlesvar = "fij",
col = col,
border = "#3b3b3b",
lwd = 1.5,
add = TRUE
)
mf_map(
$id == ISO3, ],
circles[circlesvar = "fij",
col = col2,
border = col,
lwd = 2.5,
add = TRUE
)
= circles[circles$id != ISO3, ]
t mf_label(
t,var = "id",
halo = FALSE,
cex = sqrt(as.numeric(t$v) / 1200000),
col = col2,
overlap = TRUE,
lines = FALSE
)
= circles[circles$id == ISO3, ]
t mf_label(
t,var = "id",
halo = FALSE,
cex = sqrt(as.numeric(t$v) / 1200000),
col = col,
overlap = TRUE,
lines = FALSE
)
dev.off()
Ces cartes, on peut les retrouver dans l’application MigrExplorer mise en ligne via R shiny.
https://gitlab.huma-num.fr/nlambert/migrexplorer/-/tree/master
Changer de maillage
Contrairement aux cartes réalisées à l’échelle internationale (pays * pays), cartographier les flux au niveau régional permet parfois de mieux percevoir la logique d’ensemble de ces mobilités internationales. Cette carte, pas très élégante, a été réalisée et présentée par François Héran dans ses cours au Collège de France.
Et si on essayait de la reproduire avec R ?
Pour cela, nous construisons des données de migrations internationales, en agrégeant les flux internationaux au niveau subrégional, à partir d’une clé d’aggrégation contenue dans le fichier countries.
::kable(countries[c(0:10),c("adm0_a3_is", "label","Code2","Label2")], row.names = F, digits = 1) knitr
adm0_a3_is | label | Code2 | Label2 | geometry |
---|---|---|---|---|
BGR | Bulgaria | 923 | Eastern Europe | MULTIPOLYGON (((-1882818 -4… |
MMR | Myanmar | 920 | South-Eastern Asia | MULTIPOLYGON (((5416951 -56… |
BDI | Burundi | 910 | Eastern Africa | MULTIPOLYGON (((-3418256 -9… |
BLR | Belarus | 923 | Eastern Europe | MULTIPOLYGON (((-1406024 -3… |
KHM | Cambodia | 920 | South-Eastern Asia | MULTIPOLYGON (((7198820 -51… |
DZA | Algeria | 912 | Northern Africa | MULTIPOLYGON (((-3911770 -4… |
CMR | Cameroon | 911 | Middle Africa | MULTIPOLYGON (((-5196562 -7… |
CAN | Canada | 918 | Northern America | MULTIPOLYGON (((-2925928 15… |
CPV | Cabo Verde | 914 | Western Africa | MULTIPOLYGON (((-7996256 -2… |
CYM | Cayman Islands | 915 | Caribbean | MULTIPOLYGON (((-5899896 51… |
Géométries
<-
subregions aggregate(countries, by = list(countries$Code2), FUN = head, 1)
<- subregions[, c("Code2", "Label2")]
subregions st_geometry(subregions) <-
st_cast(subregions$geometry, "MULTIPOLYGON")
colnames(subregions) <- c("id", "label", "geometry")
template("Subregions", "maps/subregions.png")
mf_map(
subregions,col = "#4e4f4f",
border = col,
lwd = 0.5,
add = TRUE
)mf_label(
x = subregions,
var = "label",
halo = TRUE,
bg = "#4e4f4f",
cex = 0.8,
col = col,
overlap = TRUE,
lines = FALSE
)dev.off()
Données attributaires
<- data.frame(countries[, c("adm0_a3_is", "Code2")])
keys $geometry <- NULL
keys<- merge(x = migr,
migr y = keys,
by.x = "i",
by.y = "adm0_a3_is")
colnames(migr)[4] <- "subreg_i"
<- merge(x = migr,
migr y = keys,
by.x = "j",
by.y = "adm0_a3_is")
colnames(migr)[5] <- "subreg_j"
$id <- paste0(migr$subreg_i, "_", migr$subreg_j)
migr<- aggregate(migr$fij, by = list(migr$id), FUN = sum)
migr2 $i <- sapply(strsplit(migr2$Group.1, "_"), "[", 1)
migr2$j <- sapply(strsplit(migr2$Group.1, "_"), "[", 2)
migr2<- migr2[, c("i", "j", "x")]
migr2 colnames(migr2)[3] <- "fij"
$fij <- round(migr2$fij / 1000, 0) migr2
::kable(migr2[c(0:10),], row.names = F, digits = 1) knitr
i | j | fij |
---|---|---|
5500 | 5500 | 483 |
5500 | 5501 | 12 |
5500 | 906 | 28 |
5500 | 912 | 4 |
5500 | 913 | 0 |
5500 | 914 | 2 |
5500 | 915 | 0 |
5500 | 916 | 0 |
5500 | 918 | 137 |
5500 | 922 | 95 |
On ajoute au fond de carte les flux intrarégionaux
<- migr2[migr2$i == migr2$j,c("i","fij")]
flowsintra colnames(flowsintra) <- c("id","intra")
<- merge(x = subregions, y = flowsintra, by = "id") subregions
::kable(subregions[c(0:10),], row.names = F, digits = 1) knitr
id | label | intra | geometry |
---|---|---|---|
906 | Eastern Asia | 5202 | MULTIPOLYGON (((6806372 -37… |
910 | Eastern Africa | 5330 | MULTIPOLYGON (((1248754 -12… |
911 | Middle Africa | 1537 | MULTIPOLYGON (((-4917506 -1… |
912 | Northern Africa | 351 | MULTIPOLYGON (((-1719098 -7… |
913 | Southern Africa | 715 | MULTIPOLYGON (((-3989376 -1… |
914 | Western Africa | 6625 | MULTIPOLYGON (((-9723391 -6… |
915 | Caribbean | 864 | MULTIPOLYGON (((-8064806 28… |
916 | Central America | 641 | MULTIPOLYGON (((-7187560 54… |
918 | Northern America | 1114 | MULTIPOLYGON (((-1050627 -4… |
920 | South-Eastern Asia | 6856 | MULTIPOLYGON (((7061625 -67… |
Calcul du volume bilatéral d’interactions inter régionales (A -> B) + (B -> A) ou (fij)+(fji)
<- migr2[migr2$i != migr2$j,]
migr2 for (k in 1:length(migr2$i)) {
<- migr2$fij[k]
val1 <-
val2 $i == migr2$j[k] & migr2$j == migr2$i[k], "fij"]
migr2[migr2$interaction[k] <- sum(val1, val2)
migr2
}
# Suppression des doublons
= data.frame(matrix(
interactions ncol = 3,
nrow = 0,
dimnames = list(NULL, c("i", "j", "interaction"))
))for (k in 1:length(migr2$i)) {
= migr2$i[k]
idi = migr2$j[k]
idj = length(interactions[(interactions$i == idi &
test $j == idj) |
interactions$i == idj & interactions$j == idi), "interaction"])
(interactionsif (test == 0) {
<-
interactions rbind(interactions, data.frame(
i = idi,
j = idj,
interaction = migr2$interaction[k]
))
} }
::kable(interactions[c(0:10),], row.names = F, digits = 1) knitr
i | j | interaction |
---|---|---|
5500 | 5501 | 28 |
5500 | 906 | 130 |
5500 | 912 | 4 |
5500 | 913 | 0 |
5500 | 914 | 2 |
5500 | 915 | 0 |
5500 | 916 | 0 |
5500 | 918 | 137 |
5500 | 922 | 261 |
5500 | 923 | 9999 |
Choix du critère de sélection global
On décide d’éliminer les petits flux, c’est-à-dire les signes graphiques présentant des valeurs de flux faibles pour ne pas se trouver face à un effet spaghetti.
Tobler recommande en première intention de ne représenter que les flux qui sont supérieurs au flux moyen
<-mean(interactions$interaction) mean
Cependant, ce seuil à 829 personnes (flux interregional moyen) ne nous apparaît pas assez élevé car 1) il n’éclaircit pas suffisament la figure et 2) il ne nous permet pas de coller suffisament à la carte de F. Héran.
Nous changeons de logique et raisonnons selon les posiions, les déciles, pour ne représenter que la part en % de flux qui contribuent à une visualisation d’une part importante de l’interaction totale.
Nous décidons alors de ne représenter que les 10% de signes qui contribuent à l’interaction totale la plus forte
<-quantile(interactions$interaction, 0.90) #10% des migrations les plus importantes Q90
Pour simplifier, on fixe le critère de sélection à 2000
<- 2000
threshold <- interactions[interactions$interaction >= threshold,] interactions
construction des liens inter regionaux
<-
links mf_get_links(
x = subregions,
df = interactions,
x_id = "id",
df_id = c("i", "j")
)
Cartographie
template("L'Afrique, un continent encore isolé dans la mondialisation", "maps/heran.png")
= "#4e4f4f"
col2
mf_map(
subregions,col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)
mf_map(
links,var = "interaction",
col = col,
border = "#3b3b3b",
type = "prop",
lwd_max = 25,
leg_pos = "bottomleft",
leg_title = paste0("Migratons INTER régionales (interactions)\n(A -> B) + (B -> A)\nSeuil : ",threshold, "\nen milliers de personnes"),
add = TRUE
)
mf_map(
subregions,var = "intra",
col = "#3b3b3b",
border = col,
lwd = 1.5,
type = "prop",
symbol = "square",
leg_pos = "topright",
leg_title = "Migrations INTRA\nrégionale nen 2019\n(en milliers)",
add = TRUE
)
mf_label(
subregions,var = "intra",
halo = FALSE,
cex = sqrt(as.numeric(subregions$intra) / 12000),
col = col,
overlap = TRUE,
lines = FALSE
)
mf_label(
links,var = "interaction",
halo = TRUE,
cex = 0.5,
col = col2,
bg = col,
r = 0.1,
overlap = FALSE,
lines = FALSE
)
dev.off()
Problème : avec seulement mapsf, on a du mal à représenter des flèches et surtout, des flèches bilatérales A -> B et B -> A qui respectent les principes de la sémiologie cartographique des flux en étant parallèles et convergentes/divergentes vers/depuis les lieux. La solution : Flowmapper 👍
Flowmapper
flowmapper() est une fonction du package ttt (en cours de développement) dédié à la ré-écriture/extension de programmes initialement proposés par Tobler.
library("ttt")
Les données
Dans le package ttt, il y a des données d’exemple au niveau subrégional. Chargeons-les.
#subregions <- st_read(system.file("subregions.gpkg", package="flowmapper")) %>% st_transform(crs)
#migr <- read.csv(system.file("migrantstocks2019.csv", package="flowmapper"))
<- st_read(system.file("subregions.gpkg", package="ttt")) %>%
subregions st_transform(crs)
<- read.csv(system.file("migrantstocks2019.csv", package="ttt")) migr
Sélection des flux les plus importants (environ 1/3 des plus forts)
#mean_migr<-mean(migr$fij)
<-quantile(migr$fij, 0.65) #1/3 des migrations les plus importantes Q65_migr
<- 1500
threshold <- migr[migr$fij >= threshold, ] migr
::kable(migr[c(0:10),], row.names = F, digits = 1) knitr
i | j | fij |
---|---|---|
5500 | 923 | 5603 |
5501 | 5501 | 11177 |
5501 | 918 | 5334 |
5501 | 920 | 1666 |
5501 | 922 | 18402 |
5501 | 924 | 2551 |
906 | 906 | 5202 |
906 | 918 | 5700 |
910 | 910 | 5330 |
910 | 913 | 1538 |
<- ttt_flowmapper(
flows x = subregions,
xid = "id",
df = migr,
dfid = c("i", "j"),
dfvar = "fij",
plot = FALSE
)
Liens
template("ttt_flowmapper$links", "maps/ttt_links.png")
mf_map(
subregions,col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)mf_map(flows$links,
col = col,
lwd = 3,
add = TRUE)
dev.off()
Cercles
template("ttt_flowmapper$circles", "maps/ttt_circles.png")
mf_map(
subregions,col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)mf_map(flows$circles, col = col, add = TRUE)
dev.off()
Flèches
template("ttt_flowmapper$flows", "maps/ttt_arrows.png")
mf_map(
subregions,col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)mf_map(flows$flows, col = col, add = TRUE)
dev.off()
Visualisation par défaut
template("Visulaisation par défaut", "maps/ttt_flows.png")
mf_map(
subregions,col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)<- ttt_flowmapper(
flows x = subregions,
xid = "id",
type = "arrows",
df = migr,
dfid = c("i", "j"),
dfvar = "fij",
col = col,
border = "#424242",
border2 = col,
add = TRUE
)dev.off()
La VV taille, c’est aussi la surface
template("La surface des fleches", "maps/ttt_surface.png")
mf_map(
subregions,col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)ttt_flowmapper(
x = subregions,
xid = "id",
type = "arrows",
size = "area",
df = migr,
dfid = c("i", "j"),
dfvar = "fij",
col = col,
border = "#424242",
border2 = col,
add = TRUE
)dev.off()
Epaisseur vs Surface
Interactions (type = “rect”)
<- data.frame(i = integer(), j = integer(), fij = integer())
migr2
for (k in 1:length(migr$i)) {
<- migr$fij[k]
val1 <- migr[migr$i == migr$j[k] & migr$j == migr$i[k], "fij"]
val2 <- sum(val1, val2)
val = migr$i[k]
idi = migr$j[k]
idj <-
test length(migr2[(migr2$i == idi &
$j == idj) | (migr2$i == idj & migr2$j == idi), "fij"])
migr2if (test == 0) {
<- rbind(migr2, data.frame(i = idi, j = idj, fij = val))
migr2
}
}<- migr2[migr2$i != migr2$j, ] migr2
head(migr2)
## i j fij
## 1 5500 923 9999
## 3 5501 918 5334
## 4 5501 920 3221
## 5 5501 922 18402
## 6 5501 924 2551
## 8 906 918 5700
template("Interactions", "maps/ttt_interactions.png")
<- ttt_flowmapper(
c x = subregions,
xid = "id",
size = "thickness",
type = "rect",
df = migr2,
dfid = c("i", "j"),
dfvar = "fij",
col = col,
border = "#424242",
border2 = col,
add = TRUE
)dev.off()
Combiner flux intra et flux inter
<- migr[migr$i == migr$j, ]
intra <- intra[, c("i", "fij")]
intra colnames(intra) <- c("id", "nb")
::kable(intra, row.names = F, digits = 1) knitr
Calcul des flux (plot = FALSE)
<- ttt_flowmapper(
flows x = subregions,
xid = "id",
df = migr,
dfid = c("i", "j"),
dfvar = "fij",
size = "thickness",
type = "arrows",
decreasing = FALSE,
add = TRUE,
lwd = 1,
col = col,
border = "#424242",
k = NULL,
k2 = 60,
df2 = intra,
df2id = "id",
df2var = "nb",
col2 = "#3b3b3b",
border2 = col,
plot = FALSE
)
Affichage de la carte avec mapsf
template("Flux inter et flux intra", "maps/interintra.png")
mf_shadow(x = flows$flows, col = "grey70", cex = 0.2, add = TRUE)
mf_map(
$flows,
flowsvar = "fij",
col = col,
border = "#3b3b3b",
leg_pos = "n",
add = TRUE
)
mf_map(
$circles,
flowsvar = "fij",
col = "#3b3b3b",
border = col,
lwd = 1.5,
leg_pos = "n",
add = TRUE
)
mf_label(
$circles,
flowsvar = "nb",
halo = FALSE,
cex = sqrt(as.numeric(flows$circles$nb) / 18000),
#cex = 1,
col = col,
overlap = TRUE,
lines = FALSE
)
mf_label(
$flows,
flowsvar = "fij",
halo = TRUE,
cex = 0.7,
col = col2,
bg = col,
r = 0.1,
overlap = FALSE,
lines = FALSE
)
# La fonction légende :-)
ttt_flowmapperlegend(
x = flows,
title = "Flux inter",
title2 = "flux intra",
col = "#4e4f4f",
txtcol = col
)
dev.off()
Reprojection
1 - calcul en projection polaire
<- ttt_flowmapper(
tmp x = subregions,
xid = "id",
type = "arrows",
df = migr,
dfid = c("i", "j"),
dfvar = "fij",
col = "#ffc524",
border = "#424242",
border2 = "#ffc524",
plot = FALSE
)
2 - reprojection & nouveau template
<-
crs "+proj=ortho +lat_0=42.5333333333 +lon_0=-72.53333333339999 +x_0=0 +y_0=0 +a=6370997 +b=6370997 +units=m +no_defs"
<- smoothr::densify(tmp$flows, n = 30) %>% st_transform(crs)
flows <- st_transform(tmp$circles, crs)
dots <- st_transform(subregions, crs)
subregions <- st_transform(graticule, crs)
graticule <- st_transform(bbox, crs) bbox
3 - affichage
= "Flux sur Globe"
title = "maps/ttt_globe.png"
file
mf_export(
subregions,export = "png",
width = 1000,
filename = file,
res = 96,
theme = theme,
expandBB = c(-.02, 0,-.02, 0)
)
mf_map(
bbox,col = "#3b3b3b",
border = NA,
lwd = 0.5,
add = TRUE
)
mf_map(graticule,
col = "#FFFFFF50",
lwd = 0.5,
add = TRUE)
mf_map(
subregions,col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)
mf_credits(
txt = credit,
pos = "bottomright",
col = "#1a2640",
cex = 0.7,
font = 3,
bg = "#ffffff30"
)
mf_map(flows, col = col, add = TRUE)
mf_map(dots, col = col, add = TRUE)
mf_title(title)
dev.off()
A vous de jouer
Et si on essayait de faire des cartes de flux sur un fond de carte déformé. Ici, par la population en 2019.
Les données
<- read.csv("https://raw.githubusercontent.com/transcarto/rflows/master/data/world/cartogram/migr2019_T.csv")
migrCountries <- read.csv("https://raw.githubusercontent.com/transcarto/rflows/master/data/world/cartogram/migrSubregions2019_T.csv") migrSubregions
Les géométries
<- st_read("https://raw.githubusercontent.com/transcarto/rflows/master/data/world/cartogram/countriesPop.geojson")
countriesPop <- st_read("https://raw.githubusercontent.com/transcarto/rflows/master/data/world/cartogram/regionsPop.geojson")
subregionsPop <- st_read("https://raw.githubusercontent.com/transcarto/rflows/master/data/world/cartogram/grid.geojson") gridPop
Quelques variables d’affichage
= "#ffc524"
col = "Miles Davis & Frances Taylor, kings of cool, 1965" votrenom
= paste0(
credit "\n",
votrenom,"Source: United Nations, Department of Economic\n",
"and Social Affairs, Population Division (2019)"
)
<- mf_theme(
theme x = "default",
bg = "#3b3b3b",
fg = "#ffc524",
mar = c(0, 0, 2, 0),
tab = TRUE,
pos = "left",
inner = FALSE,
line = 2,
cex = 1.9,
font = 3
)
= function(title, file) {
template mf_export(
countriesPop,export = "png",
width = 1000,
filename = file,
res = 96,
theme = theme,
expandBB = c(-.02, 0, -.02, 0)
)
mf_map(gridPop,
col = "#FFFFFF70",
lwd = 0.4,
add = TRUE)
mf_map(
countriesPop,col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)
mf_map(
subregionsPop,col = "NA",
border = col,
lwd = 0.5,
add = TRUE
)# mf_map(links, col = NA,border = "#317691", lwd = 0.5, add = TRUE)
mf_credits(
txt = credit,
pos = "bottomright",
col = "#1a2640",
cex = 0.5,
font = 3,
bg = "#ffffff30"
)mf_title(title)
}
A vous de jouer…
template("World Population, 2019", "maps/cartogram.png")
# METTEZ DES TRUCS ICI !
dev.off()