4.2 Position des communes fusionnantes au regard de la moyenne
française et de leur ZAU d’appartenance
On s’intéresse ici à caractériser globalement les communes
fusionnantes au regard d’une variable (potentiel financier ou taux de
chômage). Grâce au package MTA, nous commençons par réaliser deux
représentations cartographiques. La première pour évaluer la position
des communes nouvelles au regard de l’ensemble de ces communes.
La seconde pour observer uniquement la situation des communes
fusionnantes entre elles. Ceci afin de mettre en évidence quelles sont
celles qui disposent du plus de potentiel financier entre elles.
cette analyse permet d’identifier 3 cas d’étude qui semblent
intéressants : Normandie et dep 49 (situations défavorables) ; communes
nouvelles de Savoie (qui s’en tirent toutes bien) > ne serait-ce pas
des communes abritant des stations de ski ?
# Visualisation des déviations générales et territoriales
cols <- carto.pal(pal1 = "blue.pal", n1 = 3, pal2 = "wine.pal", n2 = 3)
# plot a choropleth map of the relative global deviation
par(mfrow = c(1,2), mar = c(0,0,1.2,0))
choroLayer(x = geomfus2011, var = "gdevfr", legend.pos = "topleft",
legend.title.txt = "Déviation relative\n(100 = moyenne française)",
legend.title.cex = 0.7,
breaks = c(min(geomfus2011$gdevfr, na.rm = TRUE),
75, 90, 100, 111, 133,
max(geomfus2011$gdevfr, na.rm = TRUE)),
border = NA, col = cols)
plot(st_geometry(dep), col = NA, add = TRUE)
layoutLayer(#title = "Potentiel financier\nécart à la moyenne française",
title = paste0(nomnum, "\nécart à la moyenne française"),
sources = "INSEE, 2009-2011.", author = "G. Bideau, R. Ysebaert, 2021.",
scale = FALSE, tabtitle = TRUE, frame = FALSE, col = "white", coltitle = "black")
dev.print(device = svg, file = paste0("figures/Dev ", num, " ecart_Fr", ".svg"))
## png
## 2
choroLayer(x = geomfus2011, var = "mdevfr", legend.pos = "topleft",
legend.title.txt = "Déviation relative\n(100 = moyenne de la catégorie de ZAU d'appartenance)",
legend.title.cex = 0.7,
breaks = c(min(geomfus2011$mdevfr, na.rm = TRUE),
75, 90, 100, 111, 133,
max(geomfus2011$mdevfr, na.rm = TRUE)),
border = NA, col = cols)
plot(st_geometry(dep), col = NA, add = TRUE)
layoutLayer(#title = "Potentiel financier\nÉcart à la moyenne de la ZAU d'appartenance",
title = paste0(nomnum, "\nécart à la moyenne française"),
tabtitle = TRUE, frame = FALSE, col = "white", coltitle = "black")
dev.print(device = svg, file = paste0("figures/Dev ", num, " ecart_ZAU", ".svg"))
## png
## 2
La fonction bidev présente la synthèse du positionnement
des communes nouvelles sur ces deux déviations. Ce graphique reprend une
des fonctionnalités d’HyperAtlas, le
logiciel de référence historique qui permet l’analyse des inégalités
territoriales. Cette fonction est désormais implémentée dans le package
MTA.
Pour synthétiser la positionnement des communes nouvelles sur deux
déviations, on commence par les situer dans un repère orthonormé : les
communes représentées en rouge sont celles dont la moyenne du potentiel
financier par habitant se situe au dessus de la moyenne française et de
leur ZAU d’appartenance ; celles représentées en bleu en dessous de la
moyenne pour les deux contextes ; et en jaune et vert dans des
situations contradictoires en fonction des contextes spatiaux.
On s’intéresse aussi ici à l’éloignement statistique au regard des
valeurs moyennes : plus la valeur des communes se situe loin des valeurs
moyennes des contextes, plus la tonalité de couleur est saturée. Les
communes qui se situent autour des valeurs moyennes (compris entre 75 et
125 sur les deux contextes, 100 représentant la moyenne) sont
représentées en blanc.
Un graphique est associé à la représentation cartographique afin de
visualiser le nuage de point sur lequel porte la représentation
cartographique. Les communes de chaque même ZAU s’alignent alors selon
un segment de droite dont la longueur exprime l’importance des
disparités des communes qui ont fusionné et la pente la différence entre
la moyenne de la ZAU et la moyenne nationale (Grasland (2004)) L’alignement des points selon
différentes courbures de droites dans le repère permet ici d’apprécier
l’effet de l’appartenance à une ZAU sur les inégalités induites par le
potentiel financier. Basiquement, plus la pente du nuage de point de
communes de même ZAU est importante, moins les régions qui la compose
sont différenciées (les écarts intra-zone globaux étant faibles).
RY : référence de C.Grasland à rajouter en biblio sur ce point si on
retient l’analyse. La lecture de cet article peut donner des billes pour
interpréter correctement ces sorties d’ailleurs: Claude Grasland. Les
inégalités régionales dans une Europe élargie. Les incertitudes du grand
élargissement : L’Europe centrale et balte dans l’intégration
européenne, L’Harmattan, pp.181-214, 2004, “ Pays de l’Est ”.
# Supprimer 0 (transformations log impossible)
geomfus2011 <- geomfus2011[geomfus2011$gdevfr != 0,]
geomfus2011 <- geomfus2011[geomfus2011$mdevfr != 0,]
# Calculer map_bidev
xx <- map_bidev(x = geomfus2011, dev1 = "gdevfr", dev2 = "mdevfr",
breaks = c(75, 150, 300))
# Générer les géométries et le vecteur de couleur
com <- xx$geom
cols <- xx$cols
par(mfrow = c(1,2), mar = c(0,4,0,0))
typoLayer(x = com, var = "bidev", border = NA, col = cols, lwd = 0.2,
legend.pos = "n")
plot(dep$geom, col = NA, lwd = 1, add = TRUE)
layoutLayer(title = paste0("Synthèse des deux déviations.\nVariable : ", num),
author = "Source : INSEE, 2021.", scale = 50, col = "white", coltitle = "black")
plot_bidev(x = com, dev1 = "gdevfr", dev2 = "mdevfr",
dev1.lab = "Déviation nationale",
dev2.lab = "Déviation aux ZAU de même appartenance",
cex.lab = 0.8, breaks = c(75, 150, 300), cex.pt = 0.2, cex.axis = 0.5)
4.3 Zoom
On prend ici 4 cas d’étude : communes de l’ancienne région
Rhône-Alpes (qui présente des situations contrastées), avec un zoom sur
sa partie Est (la plus touchée par les communes nouvelles), la région
Normandie (dont le potentiel financier des communes est visiblement
faible au regard contextes spatiaux identifiés en partie précédente),
tout comme le département 49 (très dense en communes nouvelles).
4.3.1 Préparation des données et calcul des déviations
Les trois déviations suivantes sont calculées : - Déviation générale
: situation du potentiel financier par habitant au regard de la moyenne
régionale (ou départementale pour le 49) - Déviation intermédiaire :
situation au regard des communes de même région (ou département)
appartenant aux mêmes catégories de ZAU. - Déviation locale : situation
au regard des communes contigues.
Ces trois déviations sont calculées simultanément grâce à la fonction
mst du package MTA. La fonction renvoie une
typologie codée de 0 à 7 qui renvoie la position de chaque commune sur
les trois déviations, en fonction d’un seuil (threshold)
prédéfini et d’une relation de supériorité ou d’infériorité
(superior).
On souhaite cibler les situations extrêmes (faibles ressources et
importantes ressources). Nous calculons donc cette typologie pour les
communes en situation favorable
(threshold = 125 , superior = TRUE) et défavorable
(threshold = 75, superior = FALSE).
: A noter qu’au lieu du critère de contiguité on pourrait aussi prendre
un critère de distance à vol d’oiseau. On pourrait aussi mesurer les
écarts territoriaux (tdev) au regard de le moyenne du département ou de
la zone d’emploi d’appartenance. A voir ce qui est le plus pertinent au
regard des objectifs théoriques du papier consolidé.
GB : Le critère de contiguité est cohérent puisque les communes
nouvelles doivent être “continues et sans enclave”. En revanche,
j’aurais bien observé la situation systématiquement vis-à-vis de la
moyenne départementale (plutôt que de la région).
# Extraction cas d'étude
norm <- subset (geom2011, REG == "23" | REG == "25") # Normandie
normCN <- subset (geomCN_new, REG == "28")
dep49 <- subset (geom2011, CODE_DEPT == "49" ) # Dep 49
dep49CN <- subset (geomCN_new, CODE_DEPT == "49")
ralp <- subset (geom2011, REG == "82") # Rhône-Alpes
ralpCN <- subset (geomCN_new, CODE_DEPT == "69" | CODE_DEPT == "73"
| CODE_DEPT == "74" | CODE_DEPT == "38"
| CODE_DEPT == "42" | CODE_DEPT == "01"
| CODE_DEPT == "26" | CODE_DEPT == "07")
ralppartiel <- subset (geom2011, CODE_DEPT == "69" | CODE_DEPT == "73"
| CODE_DEPT == "74" | CODE_DEPT == "38" | CODE_DEPT == "01") # Rhône-Alpes partiel
ralppartielCN <- subset (geomCN_new, CODE_DEPT == "69" | CODE_DEPT == "73"
| CODE_DEPT == "74" | CODE_DEPT == "38" | CODE_DEPT == "01")
On crée la fonction colmst pour gérer les couleurs et
légendes des cartes de typologie qui suivent. Puis on représente les
régions respectivement au-dessus et en-dessous des indices 125 et 75
(100 = moyenne) pour les trois contextes.
# Gestion des couleurs et des labels
colsmst <- function(x){
coldf <- data.frame(colvec = c("#f0f0f0", "#fdc785","#ffffab","#fba9b0",
"#addea6","#ffa100","#fff226","#e30020"),
mst = seq(0,7,1),
leg_val = c("∅","R - - "," - Z - ","R - Z - "," - - C", "R - - C", " - Z - C", "R - Z - C"), # ligne pour disposer les lettres de manière plus lisible
# leg_val = c("0","R","Z","R-Z","C", "R-C", "Z-C", "R-Z-C"), # ligne d'origine
stringsAsFactors = FALSE)
xx <- st_set_geometry(x, NULL)
xx <- coldf[coldf$mst %in% xx[,"mst"],]
cols <- xx$colvec
leg_val <- as.vector(xx$leg_val)
return(list("cols" = cols, "leg_val" = leg_val))
}
4.3.2 Normandie
# Calculer les trois déviations
norm$gdev <- gdev(x = norm, var1 = num, var2 = denom)
norm$tdev <- tdev(x = norm, var1 = num, var2 = denom, key = "CATAEU2010")
norm$sdev <- sdev(x = norm, var1 = num, var2 = denom, order = 1)
# Situation supérieur à 125 (souvent favorable)
mst <- map_mst(x = norm, gdevrel = "gdev", tdevrel = "tdev", sdevrel = "sdev",
threshold = 125, superior = TRUE)
# Unlist outputs of the function
com <- mst$geom
# Ne garder que les communes fusionnantes
fuz <- st_set_geometry(geomfus2011, NULL)
fuz$fuz <- 1
com <- merge(com, fuz[,c("CODGEO", "fuz")], by.x = "CODGEO",
by.y = "CODGEO", all.x = TRUE)
com <- com[!is.na(com$fuz),]
com <- com[order(com$mst),]
# Légende et couleurs
xx <- colsmst(x = com)
cols <- xx$cols
leg_val <- xx$leg_val
# Cartographie
par(mar = c(0,0,0,0), mfrow = c(1,1))
bb <- st_bbox(com)
bb <- st_as_sfc(st_bbox(bb + c(-60000,0,0,0), crs = 3035))
com <- com[!is.na(com$LIBGEO),]
# Aire d'étude pour faciliter la lisibilité
study_area <-subset (dep, CODE_DEPT == "27" | CODE_DEPT == "50"
| CODE_DEPT == "14" | CODE_DEPT == "61" | CODE_DEPT == "76" | CODE_DEPT == "35" )
plot(st_geometry(study_area), border = NA)
typoLayer(x = com, var = "mst", border = "grey50",
col = cols, lwd = 0.2, legend.pos = "n", add = TRUE)
depnorm <- subset (dep, CODE_DEPT == "27" | CODE_DEPT == "50"
| CODE_DEPT == "14" | CODE_DEPT == "61" | CODE_DEPT == "76")
plot(st_geometry(depnorm), lwd = 1, col = NA, add = TRUE)
legendTypo(col = cols, categ = leg_val,
title.txt = "Communes fusionnantes\nau-dessus de l'indice 125 :",
nodata = FALSE, pos = c(3410000, 2930000), title.cex = .7, values.cex = .6)
toponymes <- com[com$mst == 7,] # Sélection des noms des communes correspondant à la classe 7
toponymes <- toponymes[sample(1:nrow(toponymes), 6),]# Sélection, au hasard, de 6 toponymes
labelLayer(toponymes, txt = "LIBGEO", halo = TRUE, overlap = FALSE, cex = 0.6)
layoutLayer(# title = paste0(nomnum, " : Communes nouvelles en situation favorable (Normandie)"),
title = paste0("\n\n\n\n\n\n", nomnum), postitle = "center",
tabtitle = TRUE, frame = FALSE, col = "white", coltitle = "black",
source = "Source : INSEE, 2021.", author = "G. Bideau, R. Ysebaert, 2021.
100: Moyenne des déviations
R: Situation au regard de la moyenne des communes de l'espace d'étude (région)
Z: Situation au regard de la moyenne des ZAU d'appartenance sur l'espace d'étude.
C: Situation au regard des communes contigues")
# dev.print(device = svg, file = paste0("figures/Dev ", "NORM ", num, " sit_fav", ".svg"))
# Intégration des données de déviation pour sauvegarde
st_geometry(com) <- NULL # On supprime les géométries car sinon fusion impossible
norm <- merge (norm, com[, c("CODGEO", "mst")], by = "CODGEO", all.x = TRUE)
colnames(norm)[length(norm)-1] <- "mst_sup" # Classification selon déviation supérieur à 125
# Situation inférieur à 75 (souvent défavorable)
mst <- map_mst(x = norm, gdevrel = "gdev", tdevrel = "tdev", sdevrel = "sdev",
threshold = 75, superior = FALSE)
# Unlist outputs of the function
com <- mst$geom
# Ne garder que les communes fusionnantes
com <- merge(com, fuz[,c("CODGEO", "fuz")], by.x = "CODGEO",
by.y = "CODGEO", all.x = TRUE)
com <- com[!is.na(com$fuz),]
com <- com[order(com$mst),]
# Légende et couleurs
xx <- colsmst(x = com)
cols <- xx$cols
leg_val <- xx$leg_val
# Cartographie
par(mar = c(0,0,0,0), mfrow = c(1,1))
bb <- st_bbox(com)
bb <- st_as_sfc(st_bbox(bb + c(-60000,0,0,0), crs = 3035))
com <- com[!is.na(com$LIBGEO),]
plot(st_geometry(study_area), border = NA)
typoLayer(x = com, var = "mst", border = "grey50",
col = cols, lwd = 0.2, legend.pos = "n", add = TRUE)
plot(st_geometry(depnorm), lwd = 1, col = NA, add = TRUE)
legendTypo(col = cols, categ = leg_val,
title.txt = "Communes fusionnantes\nen-dessous de l'indice 75 :",
nodata = FALSE, pos = c(3410000, 2940000), title.cex = .7, values.cex = .6)
toponymes <- com[com$mst == 7,] # Sélection des noms des communes correspondant à la classe 7
toponymes <- toponymes[sample(1:nrow(toponymes), 6),]# Sélection, au hasard, de 6 toponymes
labelLayer(toponymes, txt = "LIBGEO", halo = TRUE, overlap = FALSE, cex = 0.6)
layoutLayer(# title = paste0(nomnum, " : Communes nouvelles en situation défavorable (Normandie)"),
title = paste0("\n\n\n\n\n\n", nomnum), postitle = "center",
tabtitle = TRUE, frame = FALSE, col = "white", coltitle = "black",
source = "Source : INSEE, 2021.", author = "G. Bideau, R. Ysebaert, 2021.
100: Moyenne des déviations
R: Situation au regard de la moyenne des communes de l'espace d'étude (région)
Z: Situation au regard de la moyenne des ZAU d'appartenance sur l'espace d'étude.
C: Situation au regard des communes contigues")
# dev.print(device = svg, file = paste0("figures/Dev ", "NORM ", num, " sit_defav", ".svg"))
# Intégration des données de déviation pour sauvegarde
st_geometry(com) <- NULL # On supprime les géométries car sinon fusion impossible
norm <- merge (norm, com[, c("CODGEO", "mst")], by = "CODGEO", all.x = TRUE)
colnames(norm)[length(norm)-1] <- "mst_inf" # Classification selon déviation inférieur à 75
4.3.3 Maine-et-Loire
# Calculer les trois déviations
dep49$gdev <- gdev(x = dep49, var1 = num, var2 = denom)
dep49$tdev <- tdev(x = dep49, var1 = num, var2 = denom, key = "CATAEU2010")
dep49$sdev <- sdev(x = dep49, var1 = num, var2 = denom, order = 1)
# Situation supérieur à 125 (souvent favorable)
mst <- map_mst(x = dep49, gdevrel = "gdev", tdevrel = "tdev", sdevrel = "sdev",
threshold = 125, superior = TRUE)
# Unlist outputs of the function
com <- mst$geom
# Ne garder que les communes fusionnantes
fuz <- st_set_geometry(geomfus2011, NULL)
fuz$fuz <- 1
com <- merge(com, fuz[,c("CODGEO", "fuz")], by.x = "CODGEO",
by.y = "CODGEO", all.x = TRUE)
com <- com[!is.na(com$fuz),]
com <- com[order(com$mst),]
# Légende et couleurs
xx <- colsmst(x = com)
cols <- xx$cols
leg_val <- xx$leg_val
# Cartographie
par(mar = c(0,0,0,0), mfrow = c(1,1))
bb <- st_bbox(com)
bb <- st_as_sfc(st_bbox(bb + c(-60000,0,0,0), crs = 3035))
com <- com[!is.na(com$LIBGEO),]
typoLayer(x = com, var = "mst", border = "grey50",
col = cols, lwd = 0.2, legend.pos = "n")
depfig <- subset (dep, CODE_DEPT == "49")
plot(st_geometry(depfig), lwd = 1, col = NA, add = TRUE)
legendTypo(col = cols, categ = leg_val,
title.txt = "Communes fusionnantes\nau-dessus de l'indice 125 :",
nodata = FALSE, pos = "topleft", title.cex = .7, values.cex = .6)
toponymes <- com[com$mst == 7,] # Sélection des noms des communes correspondant à la classe 7
toponymes <- toponymes[sample(1:nrow(toponymes), 6),]# Sélection, au hasard, de 6 toponymes
labelLayer(toponymes, txt = "LIBGEO", halo = TRUE, overlap = FALSE, cex = 0.6)
layoutLayer(# title = paste0(nomnum, " : Communes nouvelles en situation favorable (Maine-et-Loire)"),
title = paste0("\n\n\n\n\n\n", nomnum), postitle = "right",
tabtitle = TRUE, frame = FALSE, col = "white", coltitle = "black",
source = "Source : INSEE, 2021.", author = "G. Bideau, R. Ysebaert, 2021.
100: Moyenne des déviations
R: Situation au regard de la moyenne des communes de l'espace d'étude (région)
Z: Situation au regard de la moyenne des ZAU d'appartenance sur l'espace d'étude.
C: Situation au regard des communes contigues")
# dev.print(device = svg, file = paste0("figures/Dev ", "49 ", num, " sit_fav", ".svg"))
# Intégration des données de déviation pour sauvegarde
st_geometry(com) <- NULL # On supprime les géométries car sinon fusion impossible
dep49 <- merge (dep49, com[, c("CODGEO", "mst")], by = "CODGEO", all.x = TRUE)
colnames(dep49)[length(dep49)-1] <- "mst_sup" # Classification selon déviation supérieur à 125
# Situation inférieur à 75 (souvent défavorable)
mst <- map_mst(x = dep49, gdevrel = "gdev", tdevrel = "tdev", sdevrel = "sdev",
threshold = 75, superior = FALSE)
# Unlist outputs of the function
com <- mst$geom
# Ne garder que les communes fusionnantes
com <- merge(com, fuz[,c("CODGEO", "fuz")], by.x = "CODGEO",
by.y = "CODGEO", all.x = TRUE)
com <- com[!is.na(com$fuz),]
com <- com[order(com$mst),]
# Légende et couleurs
xx <- colsmst(x = com)
cols <- xx$cols
leg_val <- xx$leg_val
# Cartographie
par(mar = c(0,0,0,0), mfrow = c(1,1))
bb <- st_bbox(com)
bb <- st_as_sfc(st_bbox(bb + c(-60000,0,0,0), crs = 3035))
com <- com[!is.na(com$LIBGEO),]
typoLayer(x = com, var = "mst", border = "grey50",
col = cols, lwd = 0.2, legend.pos = "n")
plot(st_geometry(depfig), lwd = 1, col = NA, add = TRUE)
legendTypo(col = cols, categ = leg_val,
title.txt = "Communes fusionnantes\nen-dessous de l'indice 75 :",
nodata = FALSE, pos = "topleft", title.cex = .7, values.cex = .6)
toponymes <- com[com$mst == 7,] # Sélection des noms des communes correspondant à la classe 7
toponymes <- toponymes[sample(1:nrow(toponymes), 6),]# Sélection, au hasard, de 6 toponymes
labelLayer(toponymes, txt = "LIBGEO", halo = TRUE, overlap = FALSE, cex = 0.6)
layoutLayer(# title = paste0(nomnum, " : Communes nouvelles en situation défavorable (Maine-et-Loire)"),
title = paste0("\n\n\n\n\n\n", nomnum), postitle = "right",
tabtitle = TRUE, frame = FALSE, col = "white", coltitle = "black",
source = "Source : INSEE, 2021.", author = "G. Bideau, R. Ysebaert, 2021.
100: Moyenne des déviations
R: Situation au regard de la moyenne des communes de l'espace d'étude (région)
Z: Situation au regard de la moyenne des ZAU d'appartenance sur l'espace d'étude.
C: Situation au regard des communes contigues")
# dev.print(device = svg, file = paste0("figures/Dev ", "49 ", num, " sit_defav", ".svg"))
# Intégration des données de déviation pour sauvegarde
st_geometry(com) <- NULL # On supprime les géométries car sinon fusion impossible
dep49 <- merge (dep49, com[, c("CODGEO", "mst")], by = "CODGEO", all.x = TRUE)
colnames(dep49)[length(dep49)-1] <- "mst_inf" # Classification selon déviation inférieur à 75
4.3.4 Rhône-Alpes
# Calculer les trois déviations
ralp$gdev <- gdev(x = ralp, var1 = num, var2 = denom)
ralp$tdev <- tdev(x = ralp, var1 = num, var2 = denom, key = "CATAEU2010")
ralp$sdev <- sdev(x = ralp, var1 = num, var2 = denom, order = 1)
# Situation supérieur à 125 (souvent favorable)
mst <- map_mst(x = ralp, gdevrel = "gdev", tdevrel = "tdev", sdevrel = "sdev",
threshold = 125, superior = TRUE)
# Unlist outputs of the function
com <- mst$geom
# Ne garder que les communes fusionnantes
fuz <- st_set_geometry(geomfus2011, NULL)
fuz$fuz <- 1
com <- merge(com, fuz[,c("CODGEO", "fuz")], by.x = "CODGEO",
by.y = "CODGEO", all.x = TRUE)
com <- com[!is.na(com$fuz),]
com <- com[order(com$mst),]
# Légende et couleurs
xx <- colsmst(x = com)
cols <- xx$cols
leg_val <- xx$leg_val
# Cartographie
par(mar = c(0,0,0,0), mfrow = c(1,1))
bb <- st_bbox(com)
bb <- st_as_sfc(st_bbox(bb + c(-60000,0,0,0), crs = 3035))
com <- com[!is.na(com$LIBGEO),]
typoLayer(x = com, var = "mst", border = "grey50",
col = cols, lwd = 0.2, legend.pos = "n")
depfig <- subset (dep, CODE_DEPT == "69" | CODE_DEPT == "73"
| CODE_DEPT == "74" | CODE_DEPT == "38"
| CODE_DEPT == "42" | CODE_DEPT == "01"
| CODE_DEPT == "26" | CODE_DEPT == "07")
plot(st_geometry(depfig), lwd = 1, col = NA, add = TRUE)
legendTypo(col = cols, categ = leg_val,
title.txt = "Communes fusionnantes\nau-dessus de l'indice 125 :",
nodata = FALSE, pos = "topleft", title.cex = .7, values.cex = .6)
toponymes <- com[com$mst == 7,] # Sélection des noms des communes correspondant à la classe 7
toponymes <- toponymes[sample(1:nrow(toponymes), 6),]# Sélection, au hasard, de 6 toponymes
labelLayer(toponymes, txt = "LIBGEO", halo = TRUE, overlap = FALSE, cex = 0.6)
layoutLayer(# title = paste0(nomnum, " : Communes nouvelles en situation favorable (Rhône-Alpes)"),
title = paste0("\n\n\n\n\n\n", nomnum), postitle = "right",
tabtitle = TRUE, frame = FALSE, col = "white", coltitle = "black",
source = "Source : INSEE, 2021.", author = "G. Bideau, R. Ysebaert, 2021.
100: Moyenne des déviations
R: Situation au regard de la moyenne des communes de l'espace d'étude (région)
Z: Situation au regard de la moyenne des ZAU d'appartenance sur l'espace d'étude.
C: Situation au regard des communes contigues")
# dev.print(device = svg, file = paste0("figures/Dev ", "RALP ", num, " sit_fav", ".svg"))
# Intégration des données de déviation pour sauvegarde
st_geometry(com) <- NULL # On supprime les géométries car sinon fusion impossible
ralp <- merge (ralp, com[, c("CODGEO", "mst")], by = "CODGEO", all.x = TRUE)
colnames(ralp)[length(ralp)-1] <- "mst_sup" # Classification selon déviation supérieur à 125
# Situation inférieur à 75 (souvent défavorable)
mst <- map_mst(x = ralp, gdevrel = "gdev", tdevrel = "tdev", sdevrel = "sdev",
threshold = 75, superior = FALSE)
# Unlist outputs of the function
com <- mst$geom
# Ne garder que les communes fusionnantes
com <- merge(com, fuz[,c("CODGEO", "fuz")], by.x = "CODGEO",
by.y = "CODGEO", all.x = TRUE)
com <- com[!is.na(com$fuz),]
com <- com[order(com$mst),]
# Légende et couleurs
xx <- colsmst(x = com)
cols <- xx$cols
leg_val <- xx$leg_val
# Cartographie
par(mar = c(0,0,0,0), mfrow = c(1,1))
bb <- st_bbox(com)
bb <- st_as_sfc(st_bbox(bb + c(-60000,0,0,0), crs = 3035))
com <- com[!is.na(com$LIBGEO),]
typoLayer(x = com, var = "mst", border = "grey50",
col = cols, lwd = 0.2, legend.pos = "n")
plot(st_geometry(depfig), lwd = 1, col = NA, add = TRUE)
legendTypo(col = cols, categ = leg_val,
title.txt = "Communes fusionnantes\nen-dessous de l'indice 75 :",
nodata = FALSE, pos = "topleft", title.cex = .7, values.cex = .6)
toponymes <- com[com$mst == 7,] # Sélection des noms des communes correspondant à la classe 7
toponymes <- toponymes[sample(1:nrow(toponymes), 6),]# Sélection, au hasard, de 6 toponymes
labelLayer(toponymes, txt = "LIBGEO", halo = TRUE, overlap = FALSE, cex = 0.6)
layoutLayer(# title = paste0(nomnum, " : Communes nouvelles en situation défavorable (Rhône-Alpes)"),
title = paste0("\n\n\n\n\n\n", nomnum), postitle = "right",
tabtitle = TRUE, frame = FALSE, col = "white", coltitle = "black",
source = "Source : INSEE, 2021.", author = "G. Bideau, R. Ysebaert, 2021.
100: Moyenne des déviations
R: Situation au regard de la moyenne des communes de l'espace d'étude (région)
Z: Situation au regard de la moyenne des ZAU d'appartenance sur l'espace d'étude.
C: Situation au regard des communes contigues")
# dev.print(device = svg, file = paste0("figures/Dev ", "RALP ", num, " sit_defav", ".svg"))
# Intégration des données de déviation pour sauvegarde
st_geometry(com) <- NULL # On supprime les géométries car sinon fusion impossible
ralp <- merge (ralp, com[, c("CODGEO", "mst")], by = "CODGEO", all.x = TRUE)
colnames(ralp)[length(ralp)-1] <- "mst_inf" # Classification selon déviation inférieur à 75
4.3.5 Rhône-Alpes partiel (cinq départements les plus à l’Est)
# Calculer les trois déviations
ralppartiel$gdev <- gdev(x = ralppartiel, var1 = num, var2 = denom)
ralppartiel$tdev <- tdev(x = ralppartiel, var1 = num, var2 = denom, key = "CATAEU2010")
ralppartiel$sdev <- sdev(x = ralppartiel, var1 = num, var2 = denom, order = 1)
# Situation supérieur à 125 (souvent favorable)
mst <- map_mst(x = ralppartiel, gdevrel = "gdev", tdevrel = "tdev", sdevrel = "sdev",
threshold = 125, superior = TRUE)
# Unlist outputs of the function
com <- mst$geom
# Ne garder que les communes fusionnantes
fuz <- st_set_geometry(geomfus2011, NULL)
fuz$fuz <- 1
com <- merge(com, fuz[,c("CODGEO", "fuz")], by.x = "CODGEO",
by.y = "CODGEO", all.x = TRUE)
com <- com[!is.na(com$fuz),]
com <- com[order(com$mst),]
# Légende et couleurs
xx <- colsmst(x = com)
cols <- xx$cols
leg_val <- xx$leg_val
# Cartographie
par(mar = c(0,0,0,0), mfrow = c(1,1))
bb <- st_bbox(com)
bb <- st_as_sfc(st_bbox(bb + c(-60000,0,0,0), crs = 3035))
com <- com[!is.na(com$LIBGEO),]
typoLayer(x = com, var = "mst", border = "grey50",
col = cols, lwd = 0.2, legend.pos = "n")
depfig <- subset (dep, CODE_DEPT == "69" | CODE_DEPT == "73"
| CODE_DEPT == "74" | CODE_DEPT == "38" | CODE_DEPT == "01")
plot(st_geometry(depfig), lwd = 1, col = NA, add = TRUE)
legendTypo(col = cols, categ = leg_val,
title.txt = "Communes fusionnantes\nau-dessus de l'indice 125 :",
nodata = FALSE, pos = "topleft", title.cex = .7, values.cex = .6)
toponymes <- com[com$mst == 7,] # Sélection des noms des communes correspondant à la classe 7
toponymes <- toponymes[sample(1:nrow(toponymes), 4),]# Sélection, au hasard, de 4 toponymes
labelLayer(toponymes, txt = "LIBGEO", halo = TRUE, overlap = FALSE, cex = 0.6)
layoutLayer(# title = paste0(nomnum, " : Communes nouvelles en situation favorable (Rhône-Ain-Isère-Savoies)"),
title = paste0("\n\n\n\n\n\n", nomnum), postitle = "right",
tabtitle = TRUE, frame = FALSE, col = "white", coltitle = "black",
source = "Source : INSEE, 2021.", author = "G. Bideau, R. Ysebaert, 2021.
100: Moyenne des déviations
R: Situation au regard de la moyenne des communes de l'espace d'étude (région)
Z: Situation au regard de la moyenne des ZAU d'appartenance sur l'espace d'étude.
C: Situation au regard des communes contigues")
# dev.print(device = svg, file = paste0("figures/Dev ", "RALP-Partiel ", num, " sit_fav", ".svg"))
# Intégration des données de déviation pour sauvegarde
st_geometry(com) <- NULL # On supprime les géométries car sinon fusion impossible
ralppartiel <- merge (ralppartiel, com[, c("CODGEO", "mst")], by = "CODGEO", all.x = TRUE)
colnames(ralppartiel)[length(ralppartiel)-1] <- "mst_sup" # Classification selon déviation supérieur à 125
# Situation inférieur à 75 (souvent défavorable)
mst <- map_mst(x = ralppartiel, gdevrel = "gdev", tdevrel = "tdev", sdevrel = "sdev",
threshold = 75, superior = FALSE)
# Unlist outputs of the function
com <- mst$geom
# Ne garder que les communes fusionnantes
com <- merge(com, fuz[,c("CODGEO", "fuz")], by.x = "CODGEO",
by.y = "CODGEO", all.x = TRUE)
com <- com[!is.na(com$fuz),]
com <- com[order(com$mst),]
# Légende et couleurs
xx <- colsmst(x = com)
cols <- xx$cols
leg_val <- xx$leg_val
# Cartographie
par(mar = c(0,0,0,0), mfrow = c(1,1))
bb <- st_bbox(com)
bb <- st_as_sfc(st_bbox(bb + c(-60000,0,0,0), crs = 3035))
com <- com[!is.na(com$LIBGEO),]
typoLayer(x = com, var = "mst", border = "grey50",
col = cols, lwd = 0.2, legend.pos = "n")
plot(st_geometry(depfig), lwd = 1, col = NA, add = TRUE)
legendTypo(col = cols, categ = leg_val,
title.txt = "Communes fusionnantes\nen-dessous de l'indice 75 :",
nodata = FALSE, pos = "topleft", title.cex = .7, values.cex = .6)
toponymes <- com[com$mst == 7,] # Sélection des noms des communes correspondant à la classe 7
toponymes <- toponymes[sample(1:nrow(toponymes), 6),]# Sélection, au hasard, de 6 toponymes
labelLayer(toponymes, txt = "LIBGEO", halo = TRUE, overlap = FALSE, cex = 0.6)
layoutLayer(# title = paste0(nomnum, " : Communes nouvelles en situation défavorable (Rhône-Ain-Isère-Savoies)"),
title = paste0("\n\n\n\n\n\n", nomnum), postitle = "right",
tabtitle = TRUE, frame = FALSE, col = "white", coltitle = "black",
source = "Source : INSEE, 2021.", author = "G. Bideau, R. Ysebaert, 2021.
100: Moyenne des déviations
R: Situation au regard de la moyenne des communes de l'espace d'étude (région)
Z: Situation au regard de la moyenne des ZAU d'appartenance sur l'espace d'étude.
C: Situation au regard des communes contigues")
# dev.print(device = svg, file = paste0("figures/Dev ", "RALP-Partiel ", num, " sit_defav", ".svg"))
# Intégration des données de déviation pour sauvegarde
st_geometry(com) <- NULL # On supprime les géométries car sinon fusion impossible
ralppartiel <- merge (ralppartiel, com[, c("CODGEO", "mst")], by = "CODGEO", all.x = TRUE)
colnames(ralppartiel)[length(ralppartiel)-1] <- "mst_inf" # Classification selon déviation inférieur à 75
4.3.6 Sauvegarde des données obtenues
st_write(obj = norm [, c("CODGEO", "LIBGEO", "CODGEO_new", "LIBGEO_new", "mst_sup", "mst_inf")], dsn = paste0("sorties/norm_", num, ".gpkg"), layer = "norm", delete_layer = TRUE, quiet = TRUE)
st_write(obj = dep49 [, c("CODGEO", "LIBGEO", "CODGEO_new", "LIBGEO_new", "mst_sup", "mst_inf")], dsn = paste0("sorties/dep49_", num, ".gpkg"), layer = "dep49", delete_layer = TRUE, quiet = TRUE)
st_write(obj = ralp [, c("CODGEO", "LIBGEO", "CODGEO_new", "LIBGEO_new", "mst_sup", "mst_inf")], dsn = paste0("sorties/ralp_", num, ".gpkg"), layer = "ralp", delete_layer = TRUE, quiet = TRUE)
# Pour importer les données concernant le taux de chômage
norm_P09_CHOM1564 <- st_read("sorties/norm_P09_CHOM1564.gpkg", layer = "norm", quiet = TRUE)
dep49_P09_CHOM1564 <- st_read("sorties/dep49_P09_CHOM1564.gpkg", layer = "dep49", quiet = TRUE)
ralp_P09_CHOM1564 <- st_read("sorties/ralp_P09_CHOM1564.gpkg", layer = "ralp", quiet = TRUE)
# Pour importer les données concernant le potentiel financier
norm_P11_POT_FIN <- st_read("sorties/norm_P11_POT_FIN.gpkg", layer = "norm", quiet = TRUE)
dep49_P11_POT_FIN <- st_read("sorties/dep49_P11_POT_FIN.gpkg", layer = "dep49", quiet = TRUE)
ralp_P11_POT_FIN <- st_read("sorties/ralp_P11_POT_FIN.gpkg", layer = "ralp", quiet = TRUE)
4.3.7 Croisement de différentes données
Certaines communes ont des situations très contrastées, c’est-à-dire
une situation favorable vis-à-vis de certains contextes et défavorables
vis-à-vis d’autres.
dep49_P11_POT_FIN <- as.data.frame(dep49_P11_POT_FIN) # Pour que le sf devienne un simple data frame (sinon, on peut aussi utiliser st_geometry(data) <- NULL qui retire/supprime la géométrie
dep49Croisement <- merge (dep49_P09_CHOM1564, dep49_P11_POT_FIN[, c("CODGEO", "mst_sup", "mst_inf")], by = "CODGEO")
colnames(dep49Croisement) <- c("CODGEO", "LIBGEO", "CODGEO_new", "LIBGEO_new", "mst_sup_CHOM", "mst_inf_Chom", "mst_sup_PotFin", "mst_inf_PotFin","geometry")
summary(dep49Croisement$mst_inf_Chom >0)
OLD - À supprimer certainement
: Tout ce qui était en 3.2 est ici. Je pense que l’on peut supprimer ce
bout de code, mais je te laisse la responsabilité de le faire.
# Définition de la variable à étudier
geom2011$variableproxim <- geom2011$P11_POT_FIN
# Définition de l'ensemble de référence choisi
# Choisir "Fusion" si on souhaite comparer à l'ensemble des communes fusionnantes, "REG" aux régions etc
geom2011$CATAEUFusion <- interaction (geom2011$CATAEU2010, geom2011$FUSION)
geom2011$key <- geom2011$CATAEUFusion
geom2011$Reference <- geom2011$P09_POP
# Déviation globale
geom2011$gdevrel <- gdev(x = geom2011,
var1 = "variableproxim",
var2 = "Reference",
type = "rel")
# general absolute deviation
geom2011$gdevabs <- gdev(x = geom2011,
var1 = "variableproxim",
var2 = "Reference",
type = "abs")
# general deviation in million Euros
geom2011$gdevabsmil <- geom2011$gdevabs / 1000000
#### Cartography ----
prcarto<-subset(geom2011, FUSION == "OUI")
# margins
#par(mar = c(0, 0, 1.2, 0))
# Plot territories
plot(st_geometry(geom2011), col = "grey70", border = "#EDEDED", lwd = 0.25)
#plot(st_geometry(ept), border = "#1A1A19", lwd = 1, add = TRUE)
# Global deviation (relative and absolute) cartography
propSymbolsChoroLayer(x = prcarto,
var = "gdevabsmil", var2 = "gdevrel",
add = TRUE,
inches = 0.1,
col = carto.pal(pal1 = "blue.pal", n1 = 3,
pal2 = "wine.pal", n2 = 3),
breaks = c(min(prcarto$gdevrel, na.rm = TRUE),
75, 90, 100, 111, 133,
max(prcarto$gdevrel, na.rm = TRUE)),
#border = "#f0f0f0",
#lwd = 0.25,
legend.var.pos = "left", legend.var2.pos = "topleft",
legend.var.title.txt = "Potentiel financier (millions d'euros)",
legend.var2.title.txt = "Déviation par rapport au contexte global (100 = Ensemble des communes françaises)",
legend.var.style = "e",
legend.var.values.rnd = 0,
legend.var2.values.rnd = 0)
# layout
layoutLayer(title = "Global deviation - Potentiel financier",
sources = "INSEE, 2009-2011.",
north = TRUE, scale = 5, tabtitle = TRUE, frame = FALSE, theme = "red.pal",
author = "!!!")
Peut être l’ensemble des communes nouvelles, l’ensemble des communes
d’une région etc Point 6 dans la présentation du package MTA https://cran.r-project.org/web/packages/MTA/vignettes/MTA_Scenario.html
# Territorial relative deviation calculation
geom2011$mdevrel <- tdev(x = geom2011,
var1 = "variableproxim",
var2 = "Reference",
type = "rel",
key = "key")
# Territorial absolute deviation calculation
geom2011$mdevabs <- tdev(x = geom2011,
var1 = "variableproxim",
var2 = "Reference",
type = "abs",
key = "key")
# Territorial deviation in million Euros
geom2011$mdevabsmil <- geom2011$mdevabs / 1000000
#### Cartography ----
# Plot layout
par(mfrow = c(1, 1))
prcarto<-subset(geom2011, FUSION == "OUI")
prcarto<- na.omit(prcarto)
# Plot territories
plot(st_geometry((geom2011)), col = "grey70", border = "#EDEDED",lwd = 0.25)
plot(st_geometry((dep)), border = "#1A1A19", lwd = 1)
# Territorial deviation (relative and absolute) cartography
propSymbolsChoroLayer(x = prcarto,
var = "mdevabsmil", var2 = "mdevrel",
add = TRUE,
inches = 0.3,
col = carto.pal(pal1 = "blue.pal", n1 = 3,
pal2 = "wine.pal", n2 = 3),
breaks = c(min(prcarto$mdevrel, na.rm = TRUE),
75, 90, 100, 111, 133,
max(prcarto$mdevrel, na.rm = TRUE)),
border = "#f0f0f0",
lwd = 0.25,
legend.var.pos = "left", legend.var2.pos = "topleft",
legend.var.title.txt = "Potentiel financier (millions d'euros)",
legend.var2.title.txt = "Déviation par rapport à l'ensemble régional (100 = moyenne des communes de la région)",
legend.var.style = "e",
legend.var.values.rnd = 0,
legend.var2.values.rnd = 0)
# layout
layoutLayer(title = "!!!!",
sources = "!!!!",
north = TRUE, scale = 5, tabtitle = TRUE, frame = FALSE, theme = "red.pal",
author = "!!!!")
#### Réalisation d'un box-plot pour faciliter la visualisation ----
par(cex.lab = 1)
par(cex.axis = 0.75)
par(mar = c(4, 4, 2, 2))
# Drop geometries
df <- st_set_geometry(geom2011, NULL)
# Reorder EPT according to gdev value
df$key <- with(df, reorder(key, gdevrel, mean, na.rm = TRUE))
df$key <- with(df, reorder(key, CATAEUFUSION, na.rm = TRUE))
# Colors management
col <- carto.pal(pal1 = "red.pal", n1 = (nlevels(df$key) / 2),
pal2 = "green.pal", n2 = (nlevels(df$key) / 2),
middle = FALSE, transparency = TRUE)
library(ggplot2)
ggplot(df, aes(x=CATAEU2010, y=gdevrel, fill=FUSION)) +
geom_violin() +
geom_boxplot()
toto<- subset(df, gdevrel >= 600)
# Boxplot
boxplot(df$gdevrel ~ df$key,
col = col,
ylab = "Global deviation",
xlab = "Territorial deviation",
varwidth = TRUE,
range = 1,
outline = TRUE,
las = 1)
# Horizontal Ablines
abline (h = seq(40, 300, 10), col = "#00000060", lwd = 0.5, lty = 3)
# Plot mean values
xi<- tapply(df$gdevrel, df$key, mean, na.rm = TRUE)
points(xi, col = "navy", pch = 19)
head(df)
# Plot mean values (Communes nouvelles)
dfCfus <- subset(df, COM_NOUV == "OUI")
xi<- tapply(dfCfus$gdevrel, dfCfus$key, mean, na.rm = TRUE)
points(xi, col = "#7C0000", pch = 19)
# Legend for the boxplot
# df$EPTName<- as.factor(df$LIBEPT)
# df$EPTName <- with(df, reorder(EPTName, gdevrel, mean, na.rm = TRUE))
# legend("topleft",
# legend = levels(df$REG),
# pch = 15,
# col = col,
# cex = 0.6,
# pt.cex = 1,
# title = "Territorial contexts (ordered by mean value of global deviation)")
# Spatial relative deviation calculation
geom2011$ldevrel <- sdev(x = geom2011, xid = "CODGEO", var1 = "variableproxim", var2 = "P09_POP",
order = 1, type = "rel")
# Spatial absolute deviation calculation
geom2011$ldevabs <- sdev(x = geom2011, xid = "CODGEO", var1 = "variableproxim", var2 = "P09_POP",
order = 1, type = "abs")
# Spatial deviation in million Euros
geom2011$ldevabsmil <- geom2011$ldevabs / 1000000
# Cartography
# Plot layout
par(mfrow = c(1, 1), mar = c(0, 0, 1.2, 0))
# Plot territories
plot(st_geometry(geom2011), col = "grey70", border = "#EDEDED",lwd = 0.25)
plot(st_geometry(dep), border = "#1A1A19",lwd = 1, add = T)
# Territorial deviation (relative and absolute) cartography
propSymbolsChoroLayer(x = geom2011,
var = "ldevabsmil", var2 = "ldevrel",
add = TRUE,
inches = 0.3,
col = carto.pal(pal1 = "blue.pal", n1 = 3,
pal2 = "wine.pal", n2 = 3),
breaks = c(min(geom2011$ldevrel, na.rm = TRUE),
75, 90, 100, 111, 133,
max(geom2011$ldevrel, na.rm = TRUE)),
border = "#f0f0f0",
lwd = 0.25,
legend.var.pos = "left", legend.var2.pos = "topleft",
legend.var.title.txt = "Redistribution (Million euros)",
legend.var2.title.txt = "Deviation to the spatial context
(100 = average of the contiguous territorial units - order 1)",
legend.var.style = "e",
legend.var.values.rnd = 0,
legend.var2.values.rnd = 0)
# layout
layoutLayer(title = "Spatial deviation - xxxxxxxxxxxxxxx",
sources = "x.xxxxx",
north = TRUE, scale = 5, tabtitle = TRUE, frame = FALSE, theme = "red.pal",
author = "xxxx")
# Drop geometries
df <- st_set_geometry(geom2011, NULL)
# Spatial deviation - Top 10 of the potential contributors as regards to their total amount of income
df$ldevabsPerc<- df$ldevabs / df$variableproxim * 100
df<-df[order(df$ldevabsPerc, decreasing = TRUE), ]
df[1:10, c("ldevabsmil","ldevabsPerc")]
# Spatial deviation - Top 10 of the potential receivers as regards to their total amount of income
df<-df[order(df$ldevabsPerc, decreasing = FALSE), ]
df[1:10, c("ldevabsmil","ldevabsPerc")]
