Cette partie vise à mettre en forme et préparer les données qui seront utilisées dans les analyses à l’échelle des communes françaises :

  • La partie couches géographiques et données socio-économiques extrait les indicateurs socio-économiques et zonages contextuels en 1999 et 2016 utiles pour caractériser les communes françaises (emploi, structure démographique, niveaux de diplôme, etc.)
  • La partie hôpitaux géolocalise les hôpitaux grâce à l’adresse spécifiée dans le fichier d’entrée et la librairie banr.
  • La partie temps de parcours estime les distances (temps routier) des chefs lieux (mairies) de chacune des communes aux hôpitaux les plus proches via les caractéristiques du réseau OpenStreetMap et la librairie osrm.
  • La partie capacités hospitalières évalue le nombre de lits et de places accessibles dans un voisinage fonctionnel (temps de parcours routier théorique) de 15mn, 30mn, 45mn et 1 heure par commune.
  • La partie modèle cartographique propose une fonction pour mettre en forme les cartes à l’échelle communale pour la France métropolitaine.

Cette section se clonclue par l’export de l’ensemble des données utiles aux analyses qui suivront. Toutes ces donnnées sont regroupées dans le fichier geom.gpkg qui contient différentes couches organisées thématiquement.

Cette section n’a pas vocation à être rejouée (temps de calculs assez longs) mais permet de comprendre les pré-requis nécessaires à la constitution de la base de données de référence utilisée dans ce site Web.

Tous les indicateurs extraits ou créés sont documentés dans la partie métadonnées du site Web.

Librairies utilisées dans la préparation des données :

library(sf) # Manipulation de données spatiales
## Linking to GEOS 3.9.0, GDAL 3.2.1, PROJ 7.2.1
library(readxl) # Importer les fichers tabulaires
library(banR) # Géocodage
library(dplyr) # Pour faire tourner banR
## 
## Attachement du package : 'dplyr'
## Les objets suivants sont masqués depuis 'package:stats':
## 
##     filter, lag
## Les objets suivants sont masqués depuis 'package:base':
## 
##     intersect, setdiff, setequal, union
library(cartography) # Création du modèle carto
## This project is in maintenance mode. 
## Core functionalities of `cartography` can be found in `mapsf`.
## https://riatelab.github.io/mapsf/
library(leaflet) # Visualisation des résultats de géocodage
library(osrm) # Calcul routier via OSM 
## Data: (c) OpenStreetMap contributors, ODbL 1.0 - http://www.openstreetmap.org/copyright
## Routing: OSRM - http://project-osrm.org/


1 Couches géographiques IGN et données INSEE

Les géométries communales et départementales fournies par l’IGN sont importées. Elles correspondent aux géographies du 1er janvier 2018 afin d’être compatibles avec les géographies des données longitudinales de l’INSEE que nous allons associer par la suite.

La localisation des chefs-lieux (mairies, points) sont aussi importées et seront utilisées pour les calculs de distance (hôpitaux-communes et communes-communes).

Pour finir, les polygones des pays voisins à la France sont importées pour réaliser le modèle cartographique.

# Géométries - IGN 
com <- st_read('data-raw/geom/COMMUNE_CARTO.shp', quiet = TRUE)
dep <- st_read('data-raw/geom/DEPARTEMENT_CARTO.shp', quiet = TRUE)
chefL <- st_read('data-raw/geom/CHEF_LIEU.shp', quiet = TRUE)

# Pays voisins (modèle carto) - Natural Earth
country <- st_read("data-raw/geom/ne_10m_admin_0_countries.shp", quiet = TRUE)
country <- st_transform(country, crs = 2154)

Les géométries communales sont enrichies par des données socio-économiques afin de pouvoir qualifier ces disparités d’accès aux lits et places en chirurgie autour de 2000 et 2018. Plusieurs indicateurs sont extraits des tables de référence INSEE pour 1999 et 2016, ainsi que les découpages géographiques de référence (IGN) au millésime du 1er janvier 2018. Les données INSEE communales sont disponibles dans le découpage géographique en géographie courante (en vigueur à la date des recensements).

# Données INSEE
pop99 <- data.frame(read_excel("data-raw/insee/pop-sexe-age-quinquennal6816.xls", 
                               sheet = "COM_1999", skip = 13))
pop16 <- data.frame(read_excel("data-raw/insee/pop-sexe-age-quinquennal6816.xls", 
                               sheet = "COM_2016", skip = 13))
csp99 <- data.frame(read_excel("data-raw/insee/pop-act2554-csp-dipl-cd-6816.xls", 
                               sheet = "COM_1999", skip = 15))
csp16 <- data.frame(read_excel("data-raw/insee/pop-act2554-csp-dipl-cd-6816.xls", 
                               sheet = "COM_2016", skip = 15))
emp99 <- data.frame(read_excel("data-raw/insee/pop-act2554-empl-sexe-cd-6816.xls", 
                               sheet = "COM_1999", skip = 15))
emp16 <- data.frame(read_excel("data-raw/insee/pop-act2554-empl-sexe-cd-6816.xls", 
                               sheet = "COM_2016", skip = 15))
dip99 <- data.frame(read_excel("data-raw/insee/pop-16ans-dipl6816.xls", 
                               sheet = "COM_1999", skip = 16))
dip16 <- data.frame(read_excel("data-raw/insee/pop-16ans-dipl6816.xls", 
                               sheet = "COM_2016", skip = 16))
log11 <- data.frame(read_excel("data-raw/insee/base_cc_logement-2016.xls", 
                               sheet = "COM_2011", skip = 5))
log16 <- data.frame(read_excel("data-raw/insee/base_cc_logement-2016.xls", 
                               sheet = "COM_2016", skip = 5))
rev <- data.frame(read_excel("data-raw/insee/FILO2017_DISP_COM.xlsx", 
                             sheet = "ENSEMBLE", skip = 5))
pov <- data.frame(read_excel("data-raw/insee/FILO2017_DISP_Pauvres_COM.xlsx", 
                             sheet = "ENSEMBLE", skip = 5))
urb <- data.frame(read_excel("data-raw/insee/table-appartenance-geo-communes-18_V2.xls", 
                             sheet = "COM", skip = 5))

# Fonction pour agréger les données des arrondissements parisiens
parArr <- function(x, colNum, FUN = sum){
  
  # Sélection 20 arrondisements  
  par <- c("75101", "75102", "75103", "75104", "75105", "75106", "75107", "75108",
           "75109", "75110", "75111", "75112", "75113", "75114", "75115", "75116",
           "75117", "75118", "75119", "75120") 
  
  xpar <- x[x[,"INSEE_COM"] %in% par,] # Les extraires du dataframe
  xpar$INSEE_COM <- "75056" # Remplacer par le code INSEE parisien
  xpar <- aggregate(xpar[,colNum], by = list(xpar$INSEE_COM), FUN = FUN) # Agréger
  colnames(xpar)[1] <- "INSEE_COM" 
  x <- x[!x[,"INSEE_COM"] %in% par,] # Supprimer du jeu d'entrée les arrondissements
  x <- rbind(x, xpar) # rajouter paris agrégé
  
  return(x)
  }


# Pyramide des âges
pop99$POP_TOT_99 <- apply(pop99[,c(7:length(pop99))], 1, sum, na.rm = TRUE)
pop99$POP_014_99 <- apply(pop99[,c(7:12)], 1, sum, na.rm = TRUE)
pop99$POP_1529_99 <- apply(pop99[,c(13:18)], 1, sum, na.rm = TRUE)
pop99$POP_65_99 <- apply(pop99[,c(33:46)], 1, sum, na.rm = TRUE)
pop99$POP_80_99 <- apply(pop99[,c(39:46)], 1, sum, na.rm = TRUE)
pop99$INSEE_COM <- paste0(pop99$DR, pop99$CR)

pop16$POP_TOT_16 <- apply(pop16[,c(7:length(pop16))], 1, sum, na.rm = TRUE)
pop16$POP_014_16 <- apply(pop16[,c(7:12)], 1, sum, na.rm = TRUE)
pop16$POP_1529_16 <- apply(pop16[,c(13:18)], 1, sum, na.rm = TRUE)
pop16$POP_65_16 <- apply(pop16[,c(33:46)], 1, sum, na.rm = TRUE)
pop16$POP_80_16 <- apply(pop16[,c(39:46)], 1, sum, na.rm = TRUE)
pop16$INSEE_COM <- paste0(pop16$DR, pop16$CR)

pop <- merge(pop99[,c(47:52)], pop16[,c(47:52)],
             by = "INSEE_COM", all.y = TRUE)
pop <- parArr(x = pop, colNum = c(2:11))


# CSP 25-54 ANS
csp99$ACT_TOT_99 <- apply(csp99[,c(7:length(csp99))], 1, sum, na.rm = TRUE)
csp99$ACT_AGR_99 <- apply(csp99[,c(7:10)], 1, sum, na.rm = TRUE)  
csp99$ACT_ART_99 <- apply(csp99[,c(11:14)], 1, sum, na.rm = TRUE)  
csp99$ACT_CAD_99 <- apply(csp99[,c(15:18)], 1, sum, na.rm = TRUE)
csp99$ACT_INT_99 <- apply(csp99[,c(19:22)], 1, sum, na.rm = TRUE)
csp99$ACT_EMP_99 <- apply(csp99[,c(23:26)], 1, sum, na.rm = TRUE)
csp99$ACT_OUV_99 <- apply(csp99[,c(27:30)], 1, sum, na.rm = TRUE) 
csp99$INSEE_COM <- paste0(csp99$DR, csp99$CR)

csp16$ACT_TOT_16 <- apply(csp16[,c(7:length(csp16))], 1, sum, na.rm = TRUE)
csp16$ACT_AGR_16 <- apply(csp16[,c(7:10)], 1, sum, na.rm = TRUE)  
csp16$ACT_ART_16 <- apply(csp16[,c(11:14)], 1, sum, na.rm = TRUE)  
csp16$ACT_CAD_16 <- apply(csp16[,c(15:18)], 1, sum, na.rm = TRUE)
csp16$ACT_INT_16 <- apply(csp16[,c(19:22)], 1, sum, na.rm = TRUE)
csp16$ACT_EMP_16 <- apply(csp16[,c(23:26)], 1, sum, na.rm = TRUE)
csp16$ACT_OUV_16 <- apply(csp16[,c(27:30)], 1, sum, na.rm = TRUE)   
csp16$INSEE_COM <- paste0(csp16$DR, csp16$CR)

csp <- merge(csp99[,c(31:38)], csp16[,c(31:38)],
             by = "INSEE_COM", all.y = TRUE)
csp <- parArr(x = csp, colNum = c(2:15))


# EMPLOI
emp99$EMP_99 <- apply(emp99[,c(7,9)], 1, sum, na.rm = TRUE)
emp99$CHOM_99 <- apply(emp99[,c(8,10)], 1, sum, na.rm = TRUE)
emp99$INSEE_COM <- paste0(emp99$DR, emp99$CR)

emp16$EMP_16 <- apply(emp16[,c(7,9)], 1, sum, na.rm = TRUE)
emp16$CHOM_16 <- apply(emp16[,c(8,10)], 1, sum, na.rm = TRUE)
emp16$INSEE_COM <- paste0(emp16$DR, emp16$CR)

emp <- merge(emp99[,c(11:13)], emp16[,c(11:13)],
             by = "INSEE_COM", all.y = TRUE)
emp <- parArr(x = emp, colNum = c(2:5))


# DIPLOMES
dip99$DIP_A_99 <- apply(dip99[,c(7:10)], 1, sum, na.rm = TRUE)
dip99$DIP_B_99 <- apply(dip99[,c(11:14)], 1, sum, na.rm = TRUE)
dip99$DIP_C_99 <- apply(dip99[,c(15:18)], 1, sum, na.rm = TRUE) 
dip99$DIP_D_99 <- apply(dip99[,c(19:22)], 1, sum, na.rm = TRUE)  
dip99$INSEE_COM <- paste0(dip99$DR, dip99$CR)

dip16$DIP_A_16 <- apply(dip16[,c(7:10)], 1, sum, na.rm = TRUE)
dip16$DIP_B_16 <- apply(dip16[,c(11:14)], 1, sum, na.rm = TRUE)
dip16$DIP_C_16 <- apply(dip16[,c(15:18)], 1, sum, na.rm = TRUE) 
dip16$DIP_D_16 <- apply(dip16[,c(19:22)], 1, sum, na.rm = TRUE)  
dip16$INSEE_COM <- paste0(dip16$DR, dip16$CR)

dip <- merge(dip99[,c(23:27)], dip16[,c(23:27)],
             by = "INSEE_COM", all.y = TRUE)
dip <- parArr(x = dip, colNum = c(2:9))

# MOTORISATION
log <- merge(log11[,c(1,21,63)], log16[,c(1,40,82)], 
             by.x = "CODGEO", all.y = TRUE)
colnames(log) <- c("INSEE_COM","MEN_11","VOIT_11","MEN_16","VOIT_16")


# REVENU ET PAUVRETE
rev <- rev[,c(1,7)]
colnames(rev) <- c("INSEE_COM","REV_DISP_17")

pov <- pov[,c(1,7)]
colnames(pov) <- c("INSEE_COM", "PAUV_INT_17")

# Zonages
urb <- urb[,c(1,4:5,9:16)]
colnames(urb)[1] <- "INSEE_COM"

# Jointures de toutes les tables
com <- merge(com, pop, by = "INSEE_COM", all.x = TRUE)
com <- merge(com, csp, by = "INSEE_COM", all.x = TRUE)
com <- merge(com, emp, by = "INSEE_COM", all.x = TRUE)
com <- merge(com, dip, by = "INSEE_COM", all.x = TRUE)
com <- merge(com, log, by = "INSEE_COM", all.x = TRUE)
com <- merge(com, rev, by = "INSEE_COM", all.x = TRUE)
com <- merge(com, pov, by = "INSEE_COM", all.x = TRUE)
com <- merge(com, urb, by = "INSEE_COM", all.x = TRUE)

# Nettoyage
com <- com[,-c(2,4:6,11)]

# Jointure région d'appartenance (chefs lieux)
chefL <- merge(chefL, urb[,c("INSEE_COM","REG")], by = "INSEE_COM", all.x = TRUE)


2 Hôpitaux

Le fichier contenant la localisation des établissements disposant de places et lits en chirurgie en 2000 et 2018 a été communiqué par Benoit Conti le 9 mars 2020. La localisation géographique est établie à partir des adresses des établissements.

Ces adresses sont géocodées via la librairie banR. Le numéro, le type et le nom de voie sont concaténés puis associés au code postal et au libellé de la commune (rattaché au code postal?). La fonction geocode_tbl renvoie la latitude, la longitude et la qualité du géoréférencement (result_score).

Le résultat du géocodage est représenté avec la librairie leaflet afin d’éventuellement contrôler la validité du géocodage. Le code couleur utilisé renvoie au score de géocodage, normé entre 0 et 1 (1 = géocodage parfait). Ce score est calculé en comparant la chaîne de caractères en entrée (adresse) avec les résultats possibles dans la commune spécifiée (avec le code communal). Plus le nombre de possibilités est important, plus le score tendra vers 0. En théorie, si le code INSEE spécifié est bon, le point renvoyé sera néanmoins localisé dans la commune désirée.

# Import des données
hop00 <- as.data.frame(read_excel("data-raw/hopital/base_ChirAcc_v1.xlsx", 
                                  sheet = "base_2000", 
                                  col_types = c(rep("text",11), rep("numeric",2))))
hop18 <- as.data.frame(read_excel("data-raw/hopital/base_ChirAcc_v1.xlsx", 
                                  sheet = "base_2018", 
                                  col_types = c(rep("text",11), rep("numeric",2))))

# Regroupement des deux jeux de données
hop <- rbind(hop00, hop18)

# Retirer les valeurs manquantes pour constitution adresse
hop$NUMVOI[is.na(hop$NUMVOI)] <- ""
hop$TYPVOI[is.na(hop$TYPVOI)] <- ""
hop$NOMVOI[is.na(hop$NOMVOI)] <- ""

# Géoréférencement
hop <- hop %>%
  mutate(adresse = paste0(hop$NUMVOI, " ",hop$TYPVOI, " ", 
                          hop$NOMVOI, ", ", hop$LIBCOM),
         code_insee = COMINSEE) %>%
  geocode_tbl(adresse = adresse, code_insee = code_insee)

hop <- as.data.frame(hop)

# Transformation en objet sf
hop <- st_as_sf(hop, coords = c("longitude", "latitude"), crs = 4326)

# Ne conserver que les champs d'intérêt
hop <- hop[,c("fi","year","rs", "stjr", "COMINSEE","LIBCOM","adresse",
              "LIT","PLACE","result_score")]
# Visualisation / check adress
pal <- colorBin(palette = c("#d7191c","#fdae61","#abd9e9","#2c7bb6"), 
                      bins= c(0,0.5,0.75, 0.95, 1), na.color = "#808080")

hop00 <- hop[hop$year == "2000",] # Base de données en 2000
hop18 <- hop[hop$year == "2018",] # Base de données en 2018

leaflet() %>%
  addTiles() %>%
  addProviderTiles(providers$OpenStreetMap.HOT) %>%
  
  addCircleMarkers(data = hop00,
    radius = 6, weight = 1, stroke = TRUE,
    fillColor = ~pal(result_score),
    group = "Hôpitaux 2000", color = "#000000",  fillOpacity = 1,
    popup = paste("Nom :", hop00$rs, "<br>","Adresse :", hop00$adresse, 
    "<br>","Geocoding score :", hop00$result_score)) %>%
  
  addCircleMarkers(data = hop18,
    radius = 6, weight = 1, stroke = TRUE,
    fillColor = ~pal(result_score),
    group = "Hôpitaux 2018", color = "#000000",  fillOpacity = 1,
    popup = paste("Nom :", hop18$rs, "<br>","Adresse :", hop18$adresse, 
    "<br>","Geocoding score :", hop18$result_score)) %>%
  
  addLayersControl(overlayGroups =c("Hôpitaux 2000", "Hôpitaux 2018")) %>%
  
  addLegend(position = "bottomright", pal = pal, values = c(0,0.5,0.75,0.95,1), 
            title = "Geocoding score",opacity = 1)
# Transformation en Lambert 93
hop <- st_transform(hop, crs = 2154)

# Régions d'appartenance
df <- st_set_geometry(com, NULL)
hop <- merge(hop, df[,c("INSEE_COM","INSEE_REG","NOM_REG")], by.x = "COMINSEE", by.y = "INSEE_COM",
             all.x = TRUE)


3 Temps de parcours

La zone d’étude comprend l’ensemble des communes de France métropolitaine, excepté la Corse. On cherche ici à calculer le temps de parcours de chacune des communes vers l’hôpital (ou le second hôpital) le plus proche, en 2000 et en 2018 et en fonction du type de structure (public, privé, tout confondu).

Ces calculs sont réalisés avec la librairie osrm. Compte-tenu de l’importance de la base de données (35 228 communes * 2193 hôpitaux pour 2000 et 2018), la procédure d’extraction nécessite d’être optimisée. Voici les étapes suivies :

    1. Extraction des hôpitaux situés à moins de 50 km de chaque département. Ceci est réalisé afin de réduire les calculs et éviter de considérer les itinéraires des communes vers des hôpitaux situés à l’autre bout de la France.
    1. Département par département, calcul du temps de parcours par la route du chef lieux de commune (localisation de la mairie) vers l’ensemble des hôpitaux du périmètre départemental, dans la limite de 50 km à vol d’oiseau autour de celui-ci, et ce quelque soit le statut de l’hôpital (privé ou public) ou sa validité temporelle (2000 ou 2018) . Cette opération est réalisée grâce au package osrm qui évalue les temps de parcours routier à partir de la base de données OpenStreetMap. Elle génère une liste organisée par départements qui délivre les temps de parcours de chaque commune vers les hôpitaux de la zone d’étude. Pour réaliser ces calculs, une version d’OSRM a prélablement été installée sur un serveur du RIATE.
    1. La liste est enregistrée dans le fichier com_hop_road_time.rds pour éviter d’avoir à la recalculer (temps de calcul : environ 10 minutes).
# Tout sauf la Corse
dep <- dep[dep$INSEE_REG != "94",]
depVal <- dep$INSEE_DEP

# Un identifiant unique par hôpital (fi-année de référence)
hop$ID <- paste0(hop$fi, hop$year)
row.names(hop) <- hop$ID

# Département des chefs lieux
chefL$INSEE_DEP <- substr(chefL$INSEE_COM, 1, 2)

# Hôpitaux dans un rayon de 50 km autour de chaque département
st_agr(dep) = "constant"
st_agr(hop) = "constant"

buff <- list()
for (i in depVal) {
  buff[[i]] <- st_intersection(hop, 
                               st_union(st_buffer
                                        (dep[dep$INSEE_DEP == i,], 50000)))
}

# Origines-destinations par département
# Calcul réalisé sur un serveur RIATE
options(osrm.server = "http://18x.1XX.XX.1X:5XX/", osrm.profile = "driving")
dist <- list()

for (i in 1:length(depVal)) {
  xx <- chefL[chefL$INSEE_DEP == depVal[i],] # Extraire chefs-lieux du dep
  row.names(xx) <- xx$INSEE_COM # identifiant x
  yy <- do.call(rbind, buff[depVal[i]]) # Extraire hôpitaux du dep
  row.names(yy) <- yy$ID # identifiant y
  tmp <- osrmTable(src = xx, dst = yy, measure = "duration")
  tmp <- tmp$durations
  dist[[i]] <- tmp 
}

# Export de l'objet dist
saveRDS(dist, file = "data/com_hop_road_time.rds")

Grâce à cette liste, nous disposons dorénavant des temps routiers de l’ensemble des communes d’un département vers les hôpitaux voisins (50 km autour du département)

La fonction get_dist permet de générer les indicateurs de distance en temps routiers cible pour l’ensemble des communes françaises. Elle prend en entrée la liste précédemment créée et filtre les calculs selon les spécificités de l’hôpital recherché (année de référence, privé ou public, 1er plus proche ou second le plus proche etc.). Voici le descriptif de ses arguments :

  • dist : la liste précédemment créée, qui comprend par département les temps de parcours de l’ensemble des chefs-lieux du département vers les hôpitaux situés dans un périmètre de 50 km autour du département.
  • hop : le dataframe comprenant les hôpitaux. Ils doivent avoir pour identifiant un code unique : concaténation du code hôpital (fi) et année de référence (2000 ou 2018) dans notre cas.
  • com : le nom du dataframe comprenant l’ensemble des communes françaises, identiques au fichier des chefs lieux à partir duquel les distances fonctionnelles ont été calculées
  • statut : un vecteur de c(1,2,3). 1 pour public, 2 pour privé lucratif et 3 pour privé non lucratif.
  • year : 2000 ou 2018
  • pos : compte-tenu des paramètres définis plus haut, “id” pour récupérer l’identifiant de l’hôpital le plus proche, “first” pour obtenir les temps de parcours du 1er hôpital le plus proche, “second” pour récupérer les temps de parcours du second hôpital le plus proche.
  • com.id : le nom de la variable de com qui comprend les identifiants communaux identiques à celui des chefs lieux pour réaliser la jointure au tableau final.
dist <- readRDS("data/com_hop_road_time.rds")

# Fonction d'extraction des distances minimales selon différents paramètres
get_dist <- function(dist, hop, com, statut, year, pos, com.id){
  
  # Ne conserver que les hôpitaux correspondant à la dimension souhaitée
  if(year == 2018){
    hopcs <- hop[hop$year == 2018,]
  }else{
    hopcs <- hop[hop$year == 2000,]
  } # années
  
  hopcs <- hopcs[hopcs$stjr %in% statut, ] # statut
  hopcs <- st_set_geometry(hopcs, NULL) 
  j <- hopcs$ID # Identifiant des hôpitaux cible
  
  # Extraire pour chaque commune de département les codes hôpitaux correspondant
  # à la sélection
  datalist = list()
  
  for (i in 1:length(dist)) {
  jhop <- j[j %in% colnames(dist[[i]])] # Extraire les hôpitaux conforme à la sélection
  target <- dist[[i]][,jhop] # Présenter les résultats de distance com*hop
  
  if(is.null(dim(target))){
  target <- t(as.data.frame(target))
  row.names(target) <- row.names(dist[[i]])
  }

  # Pour ceux-ci extraire l'hopital ou le second hopital le plus proche
  if(pos == "id"){
    out <- colnames(target)[apply(target, 1, which.min)]
  } # identifiant hôpital
  if(pos == "first"){
    out <- apply(target, 1, min)  
  } # valeur minimale
  if(pos == "second"){
    out <- apply(target, 1, function(x) (sort(x))[2])
  } # seconde valeur minimale > à revoir
  
  # Tous les résultats dans une liste
  out <- data.frame(out, stringsAsFactors = FALSE)
  out$id <- row.names(out)
  datalist[[i]] <- out # add it to your list
  }
  datalist
  # on ressort le vecteur ainsi créé
  output <- do.call(rbind, datalist)
  
  # Puis on retourne le résultat en fonction du dataframe d'entrée. 
  com <- merge(x = com, y = output, by.x = com.id, by.y = "id", all.x = TRUE)
  com <- st_set_geometry(com, NULL)
  v <- com[,length(com)]

  return(v)
}

12 indicateurs clé sont créés avec la fonction get_dist et combinent respectivement l’année de référence (2000 ou 2018), le type de structure (privé, public, privé et public) et décrivent le temps d’accès au premier ou second hôpital le plus proche.

La distance routière est exprimée en minutes selon les informations disponibles dans OpenStreetMap en 2020 (vitesse maximale autorisée sur les tronçons routiers, en prenant compte de la signalisation). Il s’agit d’un réseau qui ne prend pas en compte la congestion routière. Le réseau routier utilisé est le même pour 2000 et 2020 et ne permet en conséquence pas de statuer sur l’évolution des infrastructures routières durant la période.

head(com_dist)
# Identifiant unique pour les hôpitaux
hop$ID <- paste0(hop$fi, hop$year)
row.names(hop) <- hop$ID

dfdist <- com[,c("INSEE_COM", "NOM_COM")]
  
# Calcul des indicateurs cible
# Tout hôpital
dfdist$DIST1_ALL_2018 <- get_dist(dist = dist, hop = hop, com = dfdist, 
                                  statut = c(1,2,3), year = 2018, pos = "first",
                                  com.id = "INSEE_COM")

dfdist$DIST2_ALL_2018 <- get_dist(dist = dist, hop = hop, com = dfdist, 
                                  statut = c(1,2,3), year = 2018, pos = "second",
                                  com.id = "INSEE_COM")

dfdist$DIST1_ALL_2000 <- get_dist(dist = dist, hop = hop, com = dfdist, 
                                  statut = c(1,2,3), year = 2000, pos = "first",
                                  com.id = "INSEE_COM")

dfdist$DIST2_ALL_2000 <- get_dist(dist = dist, hop = hop, com = dfdist, 
                                  statut = c(1,2,3), year = 2000, pos = "second",
                                  com.id = "INSEE_COM")

# Public
dfdist$DIST1_PUB_2018 <- get_dist(dist = dist, hop = hop, com = dfdist, 
                                  statut = 1, year = 2018, pos = "first",
                                  com.id = "INSEE_COM")

dfdist$DIST2_PUB_2018 <- get_dist(dist = dist, hop = hop, com = dfdist, 
                                  statut = 1, year = 2018, pos = "second",
                                  com.id = "INSEE_COM")

dfdist$DIST1_PUB_2000 <- get_dist(dist = dist, hop = hop, com = dfdist, 
                                  statut = 1, year = 2000, pos = "first",
                                  com.id = "INSEE_COM")

dfdist$DIST2_PUB_2000 <- get_dist(dist = dist, hop = hop, com = dfdist, 
                                  statut = 1, year = 2000, pos = "second",
                                  com.id = "INSEE_COM")


# Privé
dfdist$DIST1_PRIV_2018 <- get_dist(dist = dist, hop = hop, com = dfdist, 
                                  statut = c(2,3), year = 2018, pos = "first",
                                  com.id = "INSEE_COM")

dfdist$DIST2_PRIV_2018 <- get_dist(dist = dist, hop = hop, com = dfdist, 
                                  statut = c(2,3), year = 2018, pos = "second",
                                  com.id = "INSEE_COM")

dfdist$DIST1_PRIV_2000 <- get_dist(dist = dist, hop = hop, com = dfdist, 
                                  statut = c(2,3), year = 2000, pos = "first",
                                  com.id = "INSEE_COM")

dfdist$DIST2_PRIV_2000 <- get_dist(dist = dist, hop = hop, com = dfdist, 
                                  statut = c(2,3), year = 2000, pos = "second",
                                  com.id = "INSEE_COM")

4 Capacités hospitalières

L’objectif consiste à extraire le nombre de places - lits accessibles depuis chaque chef-lieux (mairie) de commune à différents pas de temps routiers (15 minutes, 30 minutes, 45 minutes, une heure).

Pour cette mesure de capacité, on regroupe le nombre de places/lits par commune de rattachement. Cela signifie que le calcul de temps routier est effectué depuis le chef-lieu de chaque commune disposant d’un hôpital en 2000 ou 2018 vers le chef lieu de toutes les communes environnantes (dans un rayon de 80 km). On somme ensuite le nombre de places-lits disponibles en fonction du temps routier et des caractéristiques des hôpitaux présents dans la commune (privé ou public, en 2000 ou 2018).

Dans un premier sont identifiées les communes disposant d’un hôpital en 2000 ou 2018. Les chefs-lieu de ces communes constitueront les points d’origine des calculs de temps routier.

# Hôpitaux en 2000 et 2018
hop18 <- hop[hop$year == "2018",]
hop00 <- hop[hop$year == "2000",]

#  Nombre de lits - places par commune
hopcom18 <- aggregate(data = hop18, cbind(PLACE,LIT) ~ COMINSEE, sum)
colnames(hopcom18) <- c("INSEE_COM", "PLACE_18", "LIT_18")
hopcom00 <- aggregate(data = hop00, cbind(PLACE,LIT) ~ COMINSEE, sum)
colnames(hopcom00) <- c("INSEE_COM", "PLACE_00", "LIT_00")

# Chefs-lieux caractérisés par au moins un hôpital en 2000 ou 2018
chefLhop <- merge(chefL, hopcom18, by = "INSEE_COM", all.x = TRUE)
chefLhop <- merge(chefLhop, hopcom00, by = "INSEE_COM", all.x = TRUE)
chefLhop$hop <- ifelse(!is.na(chefLhop$PLACE_00) | !is.na(chefLhop$PLACE_18) |
                         !is.na(chefLhop$LIT_00) | !is.na(chefLhop$LIT_18),
                       "1", "0")
target.x <- chefLhop[chefLhop$hop == "1",]

# Liste des codes INSEE disposant d'au moins un hôpital en 2000 ou 2018
Val <- target.x$INSEE_COM

Toujours dans l’idée de limiter les calculs à ce qui est nécessaire, les communes situées à moins de 80 kilomètres à vol d’oiseau d’une commune comprenant un hôpital en 2000 ou 2018 sont extraites. Ce seuil de 80 kilomètres est défini comme une distance suffisante pour capter les communes jusqu’à 60 minutes d’une commune disposant d’un hôpital. Ce résultat est stocké sous forme de liste (un élément de liste par commune disposant d’un hôpital). Chaque élément de liste comprend les communes dont le chef-lieu se situe à moins de 80 kilomètres du centre.

Pour tous les éléments de la liste, on retire ensuite les géométries en convertissant en latitude-longitude les coordonnées géographiques des chefs-lieux afin d’aléger les calculs de distance via osrm qui suivent.

Le temps de calcul étant important, cette liste est enregistrée par ailleurs.

# Communes à moins de 80 km d'une commune disposant d'un hôpital
st_agr(target.x) = "constant"
st_agr(chefL) = "constant"

buff <- list()
for (i in 1:length(Val)) {
  buff[[i]] <- st_intersection(chefL, 
                               st_union(st_buffer
                                        (target.x[target.x$INSEE_COM == Val[i],], 80000)))
}

# Transformer les objets sf inclus dans la liste en df (id-lat-long)
for (i in 1:length(buff)){
  tmp <- buff[[i]] 
  tmp$id <- tmp$INSEE_COM
  tmp <- st_transform(tmp, 4326)
  tmp$lat <- st_coordinates(tmp)[,2]
  tmp$lon <- st_coordinates(tmp)[,1]
  tmp <- st_set_geometry(tmp, NULL)
  tmp <- tmp[,c("id","lon","lat")]
  buff[[i]] <- tmp 
}

# Enregistrer ce résultat
saveRDS(buff, file = "data/buf80k_comhop.rds")

Les temps routiers pour l’ensemble de ces couples de valeur définis dans la précédente liste sont calculés. Les résultats sont stockés sous forme de liste et enregistrés par ailleurs afin de ne pas rejouer la fonction osrmTable (temps de calcul : plusieurs dizaines dee minutes).

# 4. Origine des calculs routiers : chef-lieux des communes avec un hôpital
ori <- st_transform(chefL, 4326)
ori$id <- ori$INSEE_COM
ori$lat <- st_coordinates(ori)[,2]
ori$lon <- st_coordinates(ori)[,1]
ori <- st_set_geometry(ori, NULL)
ori <- ori[,c("id","lon","lat")]

# Destination des calculs routiers : chefs lieux à moins de 80 km d'un chef-lieu avec hôpital
dest <- readRDS("data/buf80k_comhop2.rds")

# Calcul des temps routiers
options(osrm.server = "http://1XX.1XX.XX.1XX:5XXX/", osrm.profile = "driving")
dist <- list()
for (i in 1:length(Val)) {
  xx <- ori[ori$id == Val[i],] # Extraire chef-lieu des communes avec hopitaux
  yy <- dest[[i]] # Extraire les chefs lieux dans la zone de 80k
  tmp <- osrmTable(src = xx[,c("id", "lon", "lat")], 
                   dst = yy[,c("id", "lon", "lat")], measure = "duration")
  tmp <- tmp$durations
  dist[[i]] <- tmp 
}

# Enregistrer les résultats
saveRDS(dist, file = "data/comhop_com_road_time.rds")

La fonction get_cap permet de construire les indicateurs cibles de capacité hospitalière (places et lits) grâce à la matrice de temps routier (chef-lieu avec hôpital > ensemble des chefs-lieux dans un rayon de 80 kilomètres) et les données hospitalières à l’échelle des communes.

Elle prend en entrée :

  • mat : la liste précédemment créée, qui comprend par chef-lieu disposant des hôpitaux les temps de parcours vers l’ensemble des chefs-lieux dans un rayon de 80 kilomètres.
  • hop : le dataframe comprenant les hôpitaux. Ils doivent avoir pour identifiant un code unique : concaténation du code hôpital (fi) et année de référence (2000 ou 2018) dans notre cas.
  • com : le nom du dataframe comprenant l’ensemble des communes françaises, identiques au fichier des chefs lieux à partir duquel les distances fonctionnelles ont été calculées. Les indicateurs calculés seront générés dans ce dataframe d’entrée.
  • statut : un vecteur de c(1,2,3). 1 pour public, 2 pour privé lucratif et 3 pour privé non lucratif. hop est filtré en conséquence.
  • year : 2000 ou 2018. hop est filtré en conséquence.
  • time : Distance maximale en minutes, mat est filtré en conséquence.
  • coln : le nom des variables qui apparaitront dans com, un vecteur de deux éléments correspondant au nombre de places puis le nombre de lits.
# Filtrer l'hôpital
get_cap <- function(hop, com, statut, year, time, mat, coln){
  
  # Création des noms de colonne de sortie
  com[,coln[1]] <- 0
  com[,coln[2]] <- 0
  
    # Ne conserver que les hôpitaux correspondant à la dimension souhaitée
  if(year == 2018){
    hopcs <- hop[hop$year == 2018,]
  } else {
    hopcs <- hop[hop$year == 2000,]
  } # années
  
  hopcs <- hopcs[hopcs$stjr %in% statut, ] # statut
  hopcs <- st_set_geometry(hopcs, NULL) 
  
  # Agréger les résultats à la commune
  hopcs <- aggregate(data = hopcs, cbind(PLACE,LIT) ~ COMINSEE, sum)
  
  # Extraire pour chaque commune de département les codes hôpitaux correspondant
  for (i in 1:length(mat)){
    tmp <- mat[[i]]
    id <- row.names(tmp)
    tmp <- data.frame(t(tmp))
    
    tmp$INSEE_COM <- row.names(tmp)
    
    tmp <- tmp[tmp[,1] <= time,]
    
    if (id %in% hopcs[,"COMINSEE"] == TRUE) {
      val <- hopcs[hopcs[,"COMINSEE"] == id,]
      tmp$PLACE_tmp <- val[,"PLACE"]
      tmp$LIT_tmp <- val[,"LIT"]
      
      com <- merge(com, tmp[,c("INSEE_COM", "PLACE_tmp", "LIT_tmp")], 
                   by.x = "INSEE_COM", by.y = "INSEE_COM", all.x = TRUE)
      
      } else {com[,c("PLACE_tmp", "LIT_tmp")] <- 0}
    
    com[,c("PLACE_tmp","LIT_tmp")][is.na(com[,c("PLACE_tmp","LIT_tmp")])] <- 0
    
    com[,coln[1]] <- com[,coln[1]] + com$PLACE_tmp
    com[,coln[2]] <- com[,coln[2]] + com$LIT_tmp
    com <- com[,!(names(com) %in% c("LIT_tmp","PLACE_tmp"))]
  }
  
return(com)
}

60 indicateurs cibles sont ensuite calculés en fonction de 4 dimensions :

  • Temporelle : 2000 ou 2018.
  • Type de capacité : lit ou places.
  • Seuil de distance : 0 mn (places et lits disponibles dans les communes équipées), 15 mn, 30 mn, 45 mn et 60 mn.
  • Type de structure : Public, privé ou les deux.

On associe au final les géométries communales à cette base de données des capacités hospitalières.

colnames(com_cap)

# Préparer le tableau d'arrivée
com_cap <- com[,c("INSEE_COM", "NOM_COM"), drop = T]

com_cap <- get_cap(hop = hop, com = com_cap, statut = c("1","2","3"), 
                   year = 2000, time = 0, mat = cap,
                   coln = c("PLACE_ALL_2000", "LIT_ALL_2000"))

com_cap <- get_cap(hop = hop, com = com_cap, statut = c("1","2","3"), 
                   year = 2018, time = 0, mat = cap,
                   coln = c("PLACE_ALL_2018", "LIT_ALL_2018"))

com_cap <- get_cap(hop = hop, com = com_cap, statut = "1", 
                   year = 2000, time = 0, mat = cap,
                   coln = c("PLACE_PUB_2000", "LIT_PUB_2000"))

com_cap <- get_cap(hop = hop, com = com_cap, statut = "1", 
                   year = 2018, time = 0, mat = cap,
                   coln = c("PLACE_PUB_2018", "LIT_PUB_2018"))

com_cap <- get_cap(hop = hop, com = com_cap, statut = c("2", "3"), 
                   year = 2000, time = 0, mat = cap,
                   coln = c("PLACE_PRIV_2000", "LIT_PRIV_2000"))

com_cap <- get_cap(hop = hop, com = com_cap, statut = "1", 
                   year = 2018, time = 0, mat = cap,
                   coln = c("PLACE_PRIV_2018", "LIT_PRIV_2018"))


# Moins de 15 mn
com_cap <- get_cap(hop = hop, com = com_cap, statut = c("1","2","3"), 
                   year = 2000, time = 15, mat = cap,
                   coln = c("PLACE_15MN_ALL_2000", "LIT_15MN_ALL_2000"))

com_cap <- get_cap(hop = hop, com = com_cap, statut = c("1","2","3"), 
                   year = 2018, time = 15, mat = cap,
                   coln = c("PLACE_15MN_ALL_2018", "LIT_15MN_ALL_2018"))

com_cap <- get_cap(hop = hop, com = com_cap, statut = "1", 
                   year = 2000, time = 15, mat = cap,
                   coln = c("PLACE_15MN_PUB_2000", "LIT_15MN_PUB_2000"))

com_cap <- get_cap(hop = hop, com = com_cap, statut = "1", 
                   year = 2018, time = 15, mat = cap,
                   coln = c("PLACE_15MN_PUB_2018", "LIT_15MN_PUB_2018"))

com_cap <- get_cap(hop = hop, com = com_cap, statut = c("2","3"), 
                   year = 2000, time = 15, mat = cap,
                   coln = c("PLACE_15MN_PRIV_2000", "LIT_15MN_PRIV_2000"))

com_cap <- get_cap(hop = hop, com = com_cap, statut = c("2","3"), 
                   year = 2018, time = 15, mat = cap,
                   coln = c("PLACE_15MN_PRIV_2018", "LIT_15MN_PRIV_2018"))


# Moins de 30 mn
com_cap <- get_cap(hop = hop, com = com_cap, statut = c("1","2","3"), 
                   year = 2000, time = 30, mat = cap,
                   coln = c("PLACE_30MN_ALL_2000", "LIT_30MN_ALL_2000"))

com_cap <- get_cap(hop = hop, com = com_cap, statut = c("1","2","3"), 
                   year = 2018, time = 30, mat = cap,
                   coln = c("PLACE_30MN_ALL_2018", "LIT_30MN_ALL_2018"))

com_cap <- get_cap(hop = hop, com = com_cap, statut = "1", 
                   year = 2000, time = 30, mat = cap,
                   coln = c("PLACE_30MN_PUB_2000", "LIT_30MN_PUB_2000"))

com_cap <- get_cap(hop = hop, com = com_cap, statut = "1", 
                   year = 2018, time = 30, mat = cap,
                   coln = c("PLACE_30MN_PUB_2018", "LIT_30MN_PUB_2018"))

com_cap <- get_cap(hop = hop, com = com_cap, statut = c("2","3"), 
                   year = 2000, time = 30, mat = cap,
                   coln = c("PLACE_30MN_PRIV_2000", "LIT_30MN_PRIV_2000"))

com_cap <- get_cap(hop = hop, com = com_cap, statut = c("2","3"), 
                   year = 2018, time = 30, mat = cap,
                   coln = c("PLACE_30MN_PRIV_2018", "LIT_30MN_PRIV_2018"))


# Moins de 45 mn
com_cap <- get_cap(hop = hop, com = com_cap, statut = c("1","2","3"), 
                   year = 2000, time = 45, mat = cap,
                   coln = c("PLACE_45MN_ALL_2000", "LIT_45MN_ALL_2000"))

com_cap <- get_cap(hop = hop, com = com_cap, statut = c("1","2","3"), 
                   year = 2018, time = 45, mat = cap,
                   coln = c("PLACE_45MN_ALL_2018", "LIT_45MN_ALL_2018"))

com_cap <- get_cap(hop = hop, com = com_cap, statut = "1", 
                   year = 2000, time = 45, mat = cap,
                   coln = c("PLACE_45MN_PUB_2000", "LIT_45MN_PUB_2000"))

com_cap <- get_cap(hop = hop, com = com_cap, statut = "1", 
                   year = 2018, time = 45, mat = cap,
                   coln = c("PLACE_45MN_PUB_2018", "LIT_45MN_PUB_2018"))

com_cap <- get_cap(hop = hop, com = com_cap, statut = c("2","3"), 
                   year = 2000, time = 45, mat = cap,
                   coln = c("PLACE_45MN_PRIV_2000", "LIT_45MN_PRIV_2000"))

com_cap <- get_cap(hop = hop, com = com_cap, statut = c("2","3"), 
                   year = 2018, time = 45, mat = cap,
                   coln = c("PLACE_45MN_PRIV_2018", "LIT_45MN_PRIV_2018"))


# Moins de 60 mn
com_cap <- get_cap(hop = hop, com = com_cap, statut = c("1","2","3"), 
                   year = 2000, time = 60, mat = cap,
                   coln = c("PLACE_60MN_ALL_2000", "LIT_60MN_ALL_2000"))

com_cap <- get_cap(hop = hop, com = com_cap, statut = c("1","2","3"), 
                   year = 2018, time = 60, mat = cap,
                   coln = c("PLACE_60MN_ALL_2018", "LIT_60MN_ALL_2018"))

com_cap <- get_cap(hop = hop, com = com_cap, statut = "1", 
                   year = 2000, time = 60, mat = cap,
                   coln = c("PLACE_60MN_PUB_2000", "LIT_60MN_PUB_2000"))

com_cap <- get_cap(hop = hop, com = com_cap, statut = "1", 
                   year = 2018, time = 60, mat = cap,
                   coln = c("PLACE_60MN_PUB_2018", "LIT_60MN_PUB_2018"))

com_cap <- get_cap(hop = hop, com = com_cap, statut = c("2","3"), 
                   year = 2000, time = 60, mat = cap,
                   coln = c("PLACE_60MN_PRIV_2000", "LIT_60MN_PRIV_2000"))

com_cap <- get_cap(hop = hop, com = com_cap, statut = c("2","3"), 
                   year = 2018, time = 60, mat = cap,
                   coln = c("PLACE_60MN_PRIV_2018", "LIT_60MN_PRIV_2018"))

com_cap <- merge(com[,"INSEE_COM"], com_cap, by = "INSEE_COM", all.x = TRUE)

Les visualisations qui suivent synthétisent les opérations réalisées plus haut et permet d’apprécier les résultats issus de cette matrice de distance.

La fonction ci-dessous génère une carte et un graphique en vis à vis. La carte présente conjointement le nombre de lits en 2018 (cercles proportionnels) et la distance routière (de chef-lieu à chef-lieu) à partir d’une commune cible.

Le graphique en vis-à-vis dénombre à chaque pas de distance (0 - Moins de 15 mn - Moins de 30mn - Moins de 45mn - Moins de 60 mn) le nombre de lits d’hôpitaux accessibles.

# Matrice de distance depuis communes avec hôpitaux
cap <- readRDS("data/comhop_com_road_time.rds")

# Hôpitaux en 2018 (localisation précise)
hop18 <- hop[hop$year == "2018",]
hopcom18 <- aggregate(data = hop18, cbind(PLACE,LIT) ~ COMINSEE, sum)
colnames(hopcom18) <- c("INSEE_COM", "PLACE_18", "LIT_18")

# Capacités hospitalières agrégées à la commune par pas de distance
com_cap <- st_read(dsn = "data/geom.gpkg", layer = "com_cap", quiet = TRUE)

MapCap <- function (com.insee, cap, com, hopcom, val) {
  
  # Extraire distances cas d'étude
  cs <- match(com.insee, val)
  dist <- cap[[cs]]
  dist <- data.frame(t(dist))
  dist$INSEE_COM <- row.names(dist)
  colnames(dist)[1] <- "TIME"
  
  # Associer aux données communales et hospitalières
  csmap <- merge(com, dist, by = "INSEE_COM", all.y = TRUE)
  cshop <- merge(com, hopcom, by = "INSEE_COM", all.y = TRUE)
  
  # Extraire capacités cas d'étude
  cap1 <- com_cap[com_cap$INSEE_COM == com.insee,]
  cap1 <- st_set_geometry(cap1, NULL)
  cap1name <- cap1[,"NOM_COM"]
  cap1 <- cap1[,c("LIT_ALL_2018", "LIT_15MN_ALL_2018", "LIT_30MN_ALL_2018",
          "LIT_45MN_ALL_2018", "LIT_60MN_ALL_2018") ]
  colnames(cap1) <- c("0 mn", "0-15 mn", "0-30 mn", "0-45 mn", "0-60 mn")

  # 2 graphiques en vis à vis
  sizes <- getFigDim(x = dep, width = 3000, mar = c(0,0,1.2,0), res = 400)
  
  png(file = paste0("fig/prep_ex_", cap1name, ".png"), width = sizes[1]*2, 
      height = sizes[2], res = 400)
  
  par(mar = c(1.2,1.2,1.2,1.2), mfrow = c(1,2))
  
  ghostLayer(csmap)
  
  plot(st_geometry(dep), add = TRUE, col = "darkgrey", border = "white", lwd = .2)
  
  choroLayer(x = csmap, var = "TIME",
           breaks = c(0, 0.01, 15, 30, 45, 60, max(csmap$TIME)),
           col = c("black", "#7f0000", "#d7301f", "#fc8d59", "#fdd49e", "#fff7ec"),
           border = "white", lwd = .2,
           legend.pos = "topleft", legend.values.rnd = 0,
           legend.title.txt = paste0("Temps de parcours à ", cap1name,"\n(trajet mairie-mairie)"),
           add = TRUE)
  
  carto.pal(pal1 = "orange.pal", n1 = 6)
  
  plot(st_geometry(dep), add = TRUE, col = NA, border = "black", lwd = 1)
  
  propSymbolsLayer(x = cshop, var = "LIT_18",
                 symbols = "circle", col =  NA,
                 legend.pos = "bottomleft", border = "black",
                 legend.title.txt = "Nombre de lits disponible\nau niveau communal, 2018",
                 legend.style = "c", inches = .5, add = TRUE)
  
  layoutLayer(title = paste0(cap1name, " : capacités hospitalières et temps routier d'accès"), 
                             tabtitle = TRUE, col = "#d7301f")
  par(mar = c(4,4,4,4))
  barplot(as.matrix(cap1),
        col = c("black", "#7f0000", "#d7301f", "#fc8d59", "#fdd49e"),
        beside = TRUE,
        space = c(0,0,0,0,0),
        cex.axis = .7,
        cex.names = .7,
        ylab = "Nombre de lits accessibles en 2018 par la route",
        las = 2,
        ylim = c(0,max(cap1)))
  
  dev.off()
}

Voici le résultat pour Rennes. La commune regroupe un peu plus de 400 lits entre ses cliniques et ses hôpitaux. A moins de 15 minutes de la mairie de Rennes, cela permet d’atteindre le chef-lieu des communes périphériques de Rennes qui disposent également d’hôpitaux (700 lits à moins de 15 minutes). A moins d’une heure, sont accessibles les hôpitaux d’Avranches, Saint-Malo, Vitré, Laval, etc. Le nombre de lits d’hôpitaux accessibles depuis Rennes excède alors les 1200.

# Carto Rennes
MapCap(com.insee = "35238", cap = cap, hopcom = hopcom18, com = com, val = Val)

La situation n’est pas la même pour Gap, qui dispose certes de 80 lits d’hôpitaux dans la commune. Mais aucune commune à moins d’une heure en voiture accessible depuis Gap ne dispose de lits en chirurgie.

# Carto Gap
MapCap(com.insee = "05061", cap = cap, hopcom = hopcom18, com = com, val = Val)


5 Modèle cartographique

La fonction layChir permettra de réaliser les représentations cartographiques selon un modèle prédéfini sur l’ensemble du territoire national à l’échelle des communes.

# Couches de préparation du layout
border <- getBorders(dep) # Limites départementales
study_area <- st_union(dep) # background carto

# Modèle carto
layChir <- function(title = ""){
  par(mar = c(0,0,1.2,0))
  ghostLayer(study_area)
  
  layoutLayer(title = title,  col = "white", coltitle = "black", bg = "lightblue",
              scale = FALSE)  
  
  plot(country$geometry, col = "#d4d4d4", border = "white", lwd = 1, add = TRUE)

  plot(st_geometry(study_area) + c(5000, -5000), col= "#707070", border = NA, add = TRUE)
  layoutLayer(title = title, author =  "Réalisation : Ronan Ysebaert, Timothée Giraud, Nicolas Lambert (RIATE), Hugues Pécout (FR-CIST),\nSophie Baudet-Michel (Géographie-cités), Benoit Conti (ENPC), Charlène Le Neindre (IRDES), 2020", 
              col = "white", coltitle = "black",
              sources = "Sources : INSEE, IGN, DREES, (c) OSM et contributeurs, Natural Earth, 2020", scale = 50)
}


sizes <- getFigDim(x = dep, width = 3000, mar = c(0,0,1.2,0), res = 400)

png(file = "fig/template.png", width = sizes[1], height = sizes[2], res = 400)

layChir(title = "Temps d'accès aux soins en chirurgie, 2018")

choroLayer(x = dfdist, var = "DIST1_ALL_2018", method = "quantile",
           nclass = 8, border = NA, 
           col = carto.pal(pal1 = "green.pal", n1 = 4, pal2 = "red.pal", n2 = 4),
           legend.pos = "topleft", 
           legend.title.txt = "Temps d'accès (minutes) à l'hôpital le plus proche,\nquantiles, 2018",
           add = TRUE)

plot(st_geometry(border), col = "white", lwd = 1, add = TRUE)

dev.off()


6 Export

Toutes les couches géographiques consolidées et enrichies sont exportées dans le geopackage geom. Ce fichier comprend 9 couches géographiques, 4 pour la réalisation du modèle cartographique pour la France et 5 qui correspondent aux données utiles pour les analyses :

  • hop : base de données géoréférencée des hôpitaux.
  • com_insee : données socio-économiques en 1999 et 2016 au niveau communal.
  • com_dist : temps routiers à l’hôpital (ou le second) le plus proche.
  • com_cap : capacités hospitalières accessibles à différents pas de distance.
  • chefL : localisation des chefs-lieux (mairies) des communes françaises.

La description synthétique de leur contenu (code des indicateurs et labels) est renseignée dans la page de métadonnées du projet.

# Couches pour l'habillage carto 
st_write(obj = study_area, dsn = "data/geom.gpkg", layer = "study_area",
         delete_layer = TRUE, quiet = TRUE) # Emprise espace d'étude
st_write(obj = border, dsn = "data/geom.gpkg", layer = "border",
         delete_layer = TRUE, quiet = TRUE) # Limites départementales
st_write(obj = dep, dsn = "data/geom.gpkg", layer = "dep",
         delete_layer = TRUE, quiet = TRUE) # Polygones départements (France)
st_write(obj = country, dsn = "data/geom.gpkg", layer = "country",
         delete_layer = TRUE, quiet = TRUE) # Polygones pays limitrophes

# Couches avec données
st_write(obj = hop, dsn = "data/geom.gpkg", layer = "hop",
         delete_layer = TRUE, quiet = TRUE) # Hôpitaux (points)
st_write(obj = com, dsn = "data/geom.gpkg", layer = "com_insee",
         delete_layer = TRUE, quiet = TRUE) # Base de données socio-économique
st_write(obj = dfdist, dsn = "data/geom.gpkg", layer = "com_dist",
         delete_layer = TRUE, quiet = TRUE) # Temps routiers communaux aux hôpitaux
st_write(obj = com_cap, dsn = "data/geom.gpkg", layer = "com_cap",
         delete_layer = TRUE, quiet = TRUE) # Temps routiers communaux aux hôpitaux
st_write(obj = chefL, dsn = "data/geom.gpkg", layer = "chefL",
         delete_layer = TRUE, quiet = TRUE) # Chefs lieux de l'espace d'étude












Accessibilité aux soins de chirurgie