Quantcast
Channel: Ewen Gallic
Viewing all articles
Browse latest Browse all 25
↧

Communes proches avec R

February 28, 2018, 2:59 am
$
0
0

Rennes

Dans mes travaux actuels, j’ai besoin d’identifier pour une commune en particulier, quelles sont les autres communes proches, pour un rayon donné de 20km. Pour obtenir une telle information, je me suis appuyé sur les données de communes d’Open Street Map. L’idée est simple :

  • récupérer les frontières des communes ;
  • les étendre ;
  • regarder quelles communes sont en intersection avec les frontières étendues.

Pour commencer, je récupère les données via la plateforme ouverte des données publiques françaises data.gouv.fr. En particulier, je télécharge le shapefile le plus récent des communes (Janvier 2018 au moment de la rédaction de ce billet).

La suite se passe sur R. Je commence par charger des packages :

library(tidyverse)
library(lubridate)
library(stringr)
library(stringi)
library(data.table)
library(pbapply)
library(dplyrExtras)
library(stringdist)
library(sp)
library(rgeos)
library(maptools)
library(rgdal)

Ensuite, je charge les données :

communes <- readOGR(dsn="communes-20180101-shp/", layer="communes-20180101")
communes <- spTransform(communes, CRS( "+init=epsg:2154" ))

Je vais extraire les informations de chaque commune de l’objet communes. Il faut dans ce cas faire attention à un détail technique qui concerne la taille de chaque objet contenant les informations d’une seule commune. Si l’on se contente d’extraire telle quelle une commune, dans l’état actuel, l’objet créé occupera une lourde place en mémoire, puisqu’il contiendra de nombreuses (très nombreuses) informations inutiles. En effet, le slot data de l’objet communes contient des informations : les codes communes INSEE, les noms et le liens Wikipedia. Or, ces informations sont stockées sous forme de facteurs : R considère donc chaque valeur comme des entiers, et se réfère à un dictionnaire indiquant les niveaux correspondants. Lorsque l’on extrait un facteur d’un vecteur de facteurs en R, on récupère un sous-élément de ce vecteur… et le dictionnaire au complet ! Aussi, lorsque ce dictionnaire est très volumineux, on perd en efficacité. Ici, comme chaque ligne du slot data contient un code INSEE unique, un nom unique et un lien Wikipedia unique, il est sous-optimal de stocker ces informations sous forme de facteurs, de simples chaînes de caractères suffisent et se révèlent nettement plus efficace par la suite, lors des extractions de communes.

codes_insee <- unique(communes$insee) %>% as.character()
communes@data <- communes@data %>% 
  mutate(insee = as.character(insee),
         nom = as.character(nom),
         wikipedia = as.character(wikipedia))

Agrandissement des limites de communes

Je vais agrandir les polygones limitant chaque commune, selon une distance donnée. Pour ce faire, j’utilise la fonction gBuffer() du package rgeos. Je choisis d’étendre les frontières des communes de 20km.

distance <- 20000 # en metres

Je crée une fonction qui se chargera d’agrandir les frontières d’une commune, pour une distance donnée. Cette fonction retourne une liste contenant 4 objets :

  1. les coordonnées d’un rectangle délimitant les limites de la commune ;
  2. celles d’un rectangle délimitant les limites étendues de la commune ;
  3. les objets spatiaux contenant les coordonnées de la commune ;
  4. ceux contenant les coordonnées de la commune étendue.
#' communes_buffer
#' Obtenir la surface etendue de la commune
#' avec une distance donnee
#' @code_insee: (string) code INSEE de la commune
#' @distance: (num) distance pour etendre
communes_buffer <- function(code_insee, distance){
  tmp <- communes[communes$insee == code_insee,]
  tmp_buffer <- gBuffer(tmp, width = distance, byid = TRUE)
  bbox_commune <- bbox(tmp)
  bbox_commune_buffer <- bbox(tmp_buffer)
  tmp_buffer <- spTransform(tmp_buffer, CRS("+proj=longlat +datum=WGS84")) 
  tmp <- spTransform(tmp, CRS("+proj=longlat +datum=WGS84")) 
  list(bbox_commune = bbox_commune, bbox_commune_buffer = bbox_commune_buffer, tmp = tmp, tmp_buffer = tmp_buffer)
}# Fin de communes_buffer()

Voici un exemple du résultat pour une commune en particulier, Rennes, avec un facteur d’agrandissement de 1km.

res_rennes <- communes_buffer(code_insee = "35238", distance = 1000)

Les coordonnées du cadre délimitant la commune, et celles du cadre délimitant la commune étendue :

        min       max
x  346353.8  356295.1
y 6785457.4 6793920.0
> res_rennes$bbox_commune_buffer
        min     max
x  345356.3  357295
y 6784457.4 6794920
>

Les limites de la commune et l’agrandissement :

plot(res_rennes$tmp_buffer, border = "red")
plot(res_rennes$tmp, add=TRUE)
Limites de la commune de Rennes et limites étendues de 1km.

Limites de la commune de Rennes et limites étendues de 1km.

Pour permettre à l’ordinateur d’avoir à gérer de moins gros objets, je sépare en 20 tronçons les 36 000 codes INSEE, applique la fonction communes_buffer() sur chaque code INSEE des tronçons, et sauvegarde le résultat de chaque tronçon.

chunk2 <- function(x,n) split(x, cut(seq_along(x), n, labels = FALSE)) 
a_parcourir <- chunk2(1:length(codes_insee), 20)

if(!(dir.exists(str_c("communes/")))) dir.create(str_c("communes/"), recursive = TRUE)
for(i in 1:length(a_parcourir)){
  communes_cercles_tmp <- 
    pblapply(codes_insee[a_parcourir[[i]]], communes_buffer, distance = distance)
  save(communes_cercles_tmp, file = str_c("communes/communes_cercles_tmp_", i, ".rda"))
  rm(communes_cercles_tmp)
}

Reste alors à charger les 20 résultats intermédiaires, pour obtenir les limites étendues de chaque communes :

communes_cercles <- 
  lapply(1:length(a_parcourir), function(i){
    load(str_c("communes/communes_cercles_tmp_", i, ".rda"))
    lapply(communes_cercles_tmp, function(x) x$tmp_buffer)
  })

communes_cercles <- unlist(communes_cercles)
names(communes_cercles) <- codes_insee

Puis celles des communes non étendues :

communes_sans_cercle <- 
  lapply(1:length(a_parcourir), function(i){
    load(str_c("communes/communes_cercles_tmp_", i, ".rda"))
    lapply(communes_cercles_tmp, function(x) x$tmp)
  })

communes_sans_cercle <- unlist(communes_sans_cercle)
names(communes_sans_cercle) <- codes_insee

Et enfin les rectangles délimitant les frontières des communes et des communes étendues :


communes_cercles_bbox <- 
  lapply(1:length(a_parcourir), function(i){
    load(str_c("communes/communes_cercles_tmp_", i, ".rda"))
    lapply(communes_cercles_tmp, function(x) x$bbox_commune_buffer)
  })

communes_cercles_bbox <- unlist(communes_cercles_bbox, recursive=FALSE)
names(communes_cercles_bbox) <- codes_insee

communes_bbox <- 
  lapply(1:length(a_parcourir), function(i){
    load(str_c("communes/communes_cercles_tmp_", i, ".rda"))
    lapply(communes_cercles_tmp, function(x) x$bbox_commune)
  })

communes_bbox <- unlist(communes_bbox, recursive=FALSE)
names(communes_bbox) <- codes_insee

Je transforme ensuite en tableaux de données les objets spatiaux contenant les limites des communes.

options(warn=-1)
communes_cercles_df <- 
  pblapply(communes_cercles, function(x){
    suppressMessages(broom::tidy(x, region = "insee"))
  }) %>% 
  bind_rows()
options(warn=1)

Je fais de même pour les communes :

communes <- spTransform(communes, CRS("+proj=longlat +datum=WGS84"))
communes_df <- broom::tidy(communes, region = "insee")
communes_df <- tbl_df(communes_df)

Communes proches

À présent, je peux utiliser les limites des communes étendues pour identifier, pour chacune des communes, les autres proches dans un rayon de 20km. Je crée une fonction qui fonctionne en deux temps, pour une commune donnée. Dans un premier, j'utilise les bounding box des communes pour réaliser un écrémage rapide des communes potentiellement proches de la commune de référence. Cette étape vise à accélérer la seconde étape qui consiste à utiliser la fonction gIntersects() du package rgeos. Cette fonction, qui n'est pas des plus rapides à s'exécuter, indique si deux polygones s'intersectent. Elle me permet donc d'identifier les communes en intersection avec la commune dont les limites ont été élargies de 20km.

#' trouver_intersection_commune
#' Pour la commune i de communes_cercles, retourne
#' l'indice Insee de cette commune et les indices Insee des
#' communes dans un rayon de 20km de cette commune
#' @i (int) : indice de la commune
trouver_intersection_commune <- function(i){
  comm_courante <- communes_cercles[[i]]
  comm_restantes <- communes_sans_cercle[-i]
  
  # On fait un premier ecremage à l'aide des box
  bbox_courante <- communes_cercles_bbox[[i]]
  bbox_restantes <- communes_bbox[-i]
  
  box_se_touchent <- function(x){
    # Est-ce que les box se touchent
    touche <- 
      bbox_courante["x", "min"] <= x["x", "max"] & bbox_courante["x", "max"] >= x["x", "min"] &
      bbox_courante["y", "min"] <= x["y", "max"] & bbox_courante["y", "max"] >= x["y", "min"]
    touche
  }# Fin de box_se_touchent()
  
  touchent <- sapply(bbox_restantes, box_se_touchent)
  
  inter <- sapply(comm_restantes[touchent], function(x){
    gIntersects(x, comm_courante)
  })
  
  insee_intersection <- names(comm_restantes)[which(touchent)[which(inter)]]
  
  list(insee = names(communes_cercles[i]), limitrophes_20 = insee_intersection)
}

J'applique cette fonction à toutes les communes. Pour accélérer les choses, je parallélise l'exécution.


library(parallel)
ncl <- detectCores()-1
(cl <- makeCluster(ncl))

invisible(clusterEvalQ(cl, library(tidyverse, warn.conflicts=FALSE, quietly=TRUE)))
invisible(clusterEvalQ(cl, library(geosphere, warn.conflicts=FALSE, quietly=TRUE)))
invisible(clusterEvalQ(cl, library(rgeos, warn.conflicts=FALSE, quietly=TRUE)))
clusterExport(cl, c("communes_cercles", "communes_sans_cercle"), envir=environment())
clusterExport(cl, c("communes_cercles_bbox", "communes_bbox"), envir=environment())

communes_proches_20km <- pblapply(1:length(communes_cercles), trouver_intersection_commune, cl = cl)
names(communes_proches_20km) <- names(communes_cercles)

stopCluster(cl)

Voici un aperçu du résultat, en prenant à nouveau l'exemple de Rennes, avec un rayon de 20km.


ind_rennes <- which(names(communes_cercles) == "35238")
proche_rennes_20 <- trouver_intersection_commune(i = ind_rennes)

map_rennes <- 
  ggplot(data = communes_df %>% 
           filter(id %in% unlist(proche_rennes_20)) %>% 
           mutate(limitrophe = ifelse(id %in% proche_rennes_20$limitrophes_20, yes = "limitrophe", no = "non"),
                  limitrophe = ifelse(id == proche_rennes_20$insee, yes = "focus", no = limitrophe))) +
  geom_polygon(data = map_data("france"), aes(x = long, y = lat, group = group), fill = NA, col = "white") +
  geom_polygon(aes(x = long, y= lat, group = group, fill = limitrophe)) +
  geom_polygon(data = communes_cercles[[ind_rennes]] %>% 
                 broom::tidy(region = "insee") %>% 
                 tbl_df(),
               aes(x = long, y=lat, group = group), fill = NA, col = "red", linetype = "dashed") +
  scale_fill_manual("", values = c("limitrophe" = "dodgerblue", "non" = "white", "focus" = "red"), guide = FALSE) +
  coord_quickmap(xlim = c(-5,0),
                 ylim = c(47.5,48.5))
Communes limitrophes de Rennes

Communes limitrophes de Rennes

Note : si on choisit une distance plus courte, le code peut être utilisé pour trouver les communes limitrophes...

↧
Search
Viewing all articles
Browse latest Browse all 25
Search