“Le Groupement d’Intérêt Public « Objectif Meuse » est un établissement public créé en 2000. Cela fait suite à la création d’un laboratoire souterrain de recherches par l’ANDRA à Bure. Le GIP Objectif Meuse a vocation à soutenir, dans les limites du département de la Meuse, des actions de développement du tissu industriel et économique, d’aménagement du territoire, de formation, de développement des connaissances scientifiques et technologiques, et des actions en lien avec la transition énergétique. Les actions conduites le sont notamment dans les domaines utiles au laboratoire souterrain de l’ANDRA ou au projet CIGEO” (source : https://www.objectifmeuse.org/).

Dans ce document méthodologique, nous cherchons à quantifier et cartographier et les montants des dotations alloués dans le département de la Meuse, dans une démarche transparente, documentée et reproductible.

Chargement des packages

library(sf)
## Linking to GEOS 3.6.1, GDAL 2.2.3, PROJ 4.9.3
library(cartography)
library(readxl)
library(cartogram)
## Warning: package 'cartogram' was built under R version 3.5.2
library(png)

Import et configuration du fond de carte

# import
#  (shapefiles disponibles sur le site web de l'IGN : http://professionnels.ign.fr/adminexpress)
departements <- st_read(dsn = "data/geofla/DEPARTEMENT.shp", stringsAsFactors = F)
## Reading layer `DEPARTEMENT' from data source `C:\Users\bob\Dropbox\GIP\Meuse\data\geofla\DEPARTEMENT.shp' using driver `ESRI Shapefile'
## Simple feature collection with 96 features and 11 fields
## geometry type:  MULTIPOLYGON
## dimension:      XY
## bbox:           xmin: 99217.1 ymin: 6049646 xmax: 1242417 ymax: 7110480
## epsg (SRID):    NA
## proj4string:    +proj=lcc +lat_1=44 +lat_2=49 +lat_0=46.5 +lon_0=3 +x_0=700000 +y_0=6600000 +ellps=GRS80 +units=m +no_defs
communes <- st_read(dsn = "data/geofla/COMMUNE.shp", stringsAsFactors = F)
## Reading layer `COMMUNE' from data source `C:\Users\bob\Dropbox\GIP\Meuse\data\geofla\COMMUNE.shp' using driver `ESRI Shapefile'
## Simple feature collection with 36571 features and 18 fields
## geometry type:  MULTIPOLYGON
## dimension:      XY
## bbox:           xmin: 99217.1 ymin: 6049646 xmax: 1242417 ymax: 7110480
## epsg (SRID):    NA
## proj4string:    +proj=lcc +lat_1=44 +lat_2=49 +lat_0=46.5 +lon_0=3 +x_0=700000 +y_0=6600000 +ellps=GRS80 +units=m +no_defs
# Selection
dpt55 <- departements[departements$CODE_DEPT == "55",]
com55 <- communes[communes$CODE_DEPT == "55",]
com55 <- com55[c("INSEE_COM","NOM_COM","geometry")]
colnames(com55) <- c("id","name","geometry")

# Bure
bure <-communes[communes$INSEE_COM == 55087,]
bure2 <- st_centroid(x = bure)
## Warning in st_centroid.sf(x = bure): st_centroid assumes attributes are
## constant over geometries of x
# projection
prj <- 2154
departements <- st_transform(departements, prj)
dpt55 <- st_transform(dpt55, prj)
com55 <- st_transform(com55, prj)
bure <- st_transform(bure, prj)
bure2 <- st_transform(bure2, prj)

Import des données

# Données INSEE
insee <- read_excel("data/DONNEES INSEE 52 55/ensemble.xls", sheet = "Communes", skip = 7)
insee <- data.frame(insee)
insee$insee <- paste0(insee$Code.département,insee$Code.commune)
insee <- insee[,c("insee","Population.totale")]
colnames(insee) <- c("id","pop2015")

# Données GIP
GIP <- data.frame(read_excel("data/GIP_Meuse_2000_2017.xls", sheet = "data2000_2017", skip = 0))
GIP <- GIP[GIP$CARTO=="OUI",]
# GIP_indiv <- data.frame(read_excel("data/GIP_Meuse_actions.xls", sheet = "individus", skip = 0))
# GIP <- merge(GIP, GIP_indiv[,c("ID","dossier_recoded")], by="ID",  all.x=TRUE)
#GIP$Axe <- substr(GIP$Axe,1,5)

Création du template cartographique

par(mar = c(0,0,1.2,0))
plot(st_geometry(com55), col="#ede5e1", border="white",lwd=0.5)
plot(st_geometry(departements), col=NA, border="#efe8e6",lwd=1,  add=T)
nuc <- readPNG('css/nuc.png')
offset <- 3000
rasterImage(nuc, st_coordinates(bure2)[1]-offset, st_coordinates(bure2)[2]-offset, st_coordinates(bure2)[1]+offset, st_coordinates(bure2)[2]+offset)
text(x = 868634.8, y = 6818000, labels = "BURE")
layoutLayer(frame = TRUE, scale = 20, north = F, 
            author = "L. BEAUGUITTE & N. LAMBERT, 2018", 
            title ="LA MEUSE (55)",
            source = "Compilation réalisée par Laurent Beauguitte, 2018")

Carte de population

com55 <- merge(com55, insee, by="id", all.x=TRUE)

par(mar = c(0,0,1.2,0))
plot(st_geometry(com55), col="#ede5e1", border="white",lwd=0.5)
plot(st_geometry(departements), col=NA, border="#efe8e6",lwd=1,  add=T)
propSymbolsLayer(x = com55, var = "pop2015", 
                 symbols = "circle", col =  "red",
                 legend.pos = "topright", border = "white",legend.frame=T,
                 legend.title.txt = "Nombre d'habitants",
                 legend.style = "c")
nuc <- readPNG('css/nuc.png')
offset <- 3000
rasterImage(nuc, st_coordinates(bure2)[1]-offset, st_coordinates(bure2)[2]-offset, st_coordinates(bure2)[1]+offset, st_coordinates(bure2)[2]+offset)
text(x = 868634.8, y = 6818000, labels = "BURE")
layoutLayer(frame = TRUE, scale = 20, north = F, 
            author = "L. BEAUGUITTE & N. LAMBERT, 2018", 
            title ="POPULATION TOTALE, 2015",
            source = "Compilation réalisée par Laurent Beauguitte, 2018")
labelLayer(x = com55[com55$pop2015 > 10000,], txt = "name", col= "black", cex = 0.7, font = 4,
           halo = TRUE, bg = "white", r = 0.1, 
           overlap = FALSE, show.lines = FALSE)

Création d’une fonction pour explorer/visualiser les données GIP Meuse

mapGIP <- function(x = GIP,com = com55, years = NULL, typo = NULL, benef = NULL, dossier = NULL, dotation = NULL, axe=NULL, Dotations_recode = "versements", fixmax=10000, inches=0.005, col = "red"){
  x <- GIP[GIP$Dotations_recode %in% Dotations_recode,]
  if (!is.null(typo)){x <- x[x$Typo_recode %in% typo,]}
  if (!is.null(years)){x <- x[x$Année %in% years,]}
  if (!is.null(benef)){x <- x[x$Bénéficiaire_rec_anon %in% benef,]}
  if (!is.null(dotation)){x <- x[x$Dotations_recode %in% dotation,]}
  if (!is.null(axe)){x <- x[x$Axe %in% axe,]}
  if (!is.null(dossier)){x <- x[x$dossier_recoded %in% dossier,]}
  x <- x[,c("CodeINSEE","Montant_recoded")]
  x$Montant_recoded <- as.numeric(x$Montant_recoded)
  x <- aggregate(x$Montant_recoded, by=list(x$CodeINSEE), FUN = sum)
  colnames(x) <- c("id","montant")
  x <- merge(com, x, by="id", all.x=TRUE)
  
  if(is.na(x[x$id == 55087,"montant"])){x[x$id == 55087,"montant"] <- 0.01}
  par(mar = c(0,0,1.2,0))
  plot(st_geometry(com), col="#ede5e1", border="white",lwd=0.5)
  plot(st_geometry(departements), col=NA, border="#efe8e6",lwd=1,  add=TRUE)
  propSymbolsLayer(x = x, var = "montant",
                   symbols = "circle", col =  col,
                   legend.pos = "topright", border = "white",legend.frame=T,
                   legend.title.txt = "Montant (€)",
                   legend.style = "c",
                   fixmax = fixmax,
                   inches = inches)
nuc <- readPNG('css/nuc.png')
offset <- 3000
rasterImage(nuc, st_coordinates(bure2)[1]-offset, st_coordinates(bure2)[2]-offset, st_coordinates(bure2)[1]+offset, st_coordinates(bure2)[2]+offset)
text(x = 868634.8, y = 6818000, labels = "BURE")
  
  if(is.null(years)){years <- ""}else{years <- paste(years,collapse=", ")}
  if(is.null(typo)){typo <- ""}else{typo <- paste(typo,collapse=", ")}
  if(is.null(benef)){benef <- ""}else{benef <- paste(benef,collapse=", ")}
  if(is.null(dotation)){dotation <- ""}else{dotation <- paste(dotation,collapse=", ")}
  if(is.null(axe)){axe <- ""}else{axe <- paste(axe,collapse=", ")}
  if(is.null(dossier)){dossier <- ""}else{dossier <- paste(dossier,collapse=", ")}
  txt <- paste(years,typo,benef,dotation,axe,dossier, sep = " ")
  layoutLayer(frame = TRUE, scale = 20, north = F,
              author = "L. BEAUGUITTE & N. LAMBERT, 2018",
              title =txt,
              source = "Compilation réalisée par Laurent Beauguitte, 2018")
  }

Cartographie par année

years_all <-unique(GIP$Année)
l <- length(years_all)-1
 for (i in 1:l){
   mapGIP(years=years_all[i], col="#bc318e", inches=0.01 )

 }

Cartographie par type de bénéficiaire

types_all <- levels(as.factor(GIP$Typo_recode))
 for (i in 1:length(types_all)){
   mapGIP(typo=types_all[i], col="#206d1c", inches=0.01 )

 mapGIP(typo=types_all[i], col="#206d1c", inches=0.01 )
 }

Cartographie par axes

axes_all <- levels(as.factor(GIP$Axe))

 for (i in 1:length(axes_all)){
   mapGIP(axe=axes_all[i], col="#bc318e", inches=0.01 )
}

Rénovations individuelles par années

Selection des données

GIP_indiv <- GIP[GIP$Dossier_ind_recode != "NA",]
GIP_indiv <- GIP_indiv[GIP_indiv$Dotations_recode == "versements",]

com55_centroid <- st_centroid(com55)
GIP_indiv <- merge(GIP_indiv, com55_centroid,by.x="CodeINSEE",by.y="id",  all.x=TRUE)
GIP_indiv <- st_sf(GIP_indiv,GIP_indiv$geometry)
GIP_indiv$num <- 1

Bar plot

tot <- aggregate(GIP_indiv$num,list(GIP_indiv$Année), sum, simplify = TRUE )
barplot(tot$x, main="Nombre de rénovations par année (logements individuels)", xlab="Années", ylab="Nombre", names.arg=tot$Group.1, border="#991313",col="red")

years <- levels(as.factor(GIP_indiv$Année))

dots <- cartogram_dorling(x = st_jitter(GIP_indiv), "num", k = 0.02, m_weight = 1, itermax = 100)
# plot(st_geometry(com55))
# plot(dots, col="red", add=T)
j <- 1

for (i in years) {
  dots$typo <- 0
  dots$typo[dots$Année == i] <- 1
  par(mar = c(0,0,1.2,0))
  plot(st_geometry(com55), col="#ede5e1", border="white",lwd=0.2)
  plot(st_geometry(departements), col=NA, border="#efe8e6",lwd=1,  add=T)
  typoLayer(x = dots, var="typo",  
            col = c("red", "#CCCCCC"),border = "white",lwd=0.2,
            legend.values.order = c(1,0), legend.pos = "n", add=T)
  
  layoutLayer(frame = TRUE, scale = 20, north = F,
              author = "L. BEAUGUITTE & N. LAMBERT, 2018",
              title = paste0(tot[j,2]," rénovations de logements en ",i),
              source = "Compilation réalisée par Laurent Beauguitte, 2018")
  j <- j+1
          }