Analyses - Accessibilité
Un markdown pour les analyses de capacités / accessibilités… Travail en cours.
1 Import des données et librairies
1.1 Librairies
# Libraries
library(sf)
library(readxl)
library(cartography)
library(dplyr)
library(corrplot)1.2 Données
# Import données enrichies
com_insee <- st_read(dsn = "data/geom.gpkg", layer = "com_insee", quiet = TRUE)
com_dist <- st_read(dsn = "data/geom.gpkg", layer = "com_dist", quiet = TRUE)
com_cap <- st_read(dsn = "data/geom.gpkg", layer = "com_cap", quiet = TRUE)
hop <- st_read(dsn = "data/geom.gpkg", layer = "hop", quiet = TRUE)
# Jointures données socio-éco
tmp <- st_set_geometry(com_insee, NULL)
com_dist <- merge(com_dist, tmp, all.x = TRUE, by = "INSEE_COM")
com_cap <- merge(com_cap, tmp, all.x = TRUE, by = "INSEE_COM")
# Métadonnées
meta.insee <- data.frame(read_excel("data-raw/meta.xlsx", sheet = "insee"))
meta.dist <- data.frame(read_excel("data-raw/meta.xlsx", sheet = "dist"))
meta.cap <- data.frame(read_excel("data-raw/meta.xlsx", sheet = "cap"))
# Retirer la Corse
com_dist <- com_dist[com_dist$NOM_REG != "CORSE",]
com_cap <- com_cap[com_cap$NOM_REG != "CORSE",]1.3 Modèle carto
# Import couches pour modèle carto
study_area <- st_read(dsn = "data/geom.gpkg", layer = "study_area", quiet = TRUE)
border <- st_read(dsn = "data/geom.gpkg", layer = "border", quiet = TRUE)
dep <- st_read(dsn = "data/geom.gpkg", layer = "dep", quiet = TRUE)
country <- st_read(dsn = "data/geom.gpkg", layer = "country", quiet = TRUE)
# Dimension des cartes à l'export
sizes <- getFigDim(x = dep, width = 3000, mar = c(0,0,1.2,0), res = 400)
# 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$geom, col = "#d4d4d4", border = "white", lwd = 1, add = TRUE)
plot(st_geometry(study_area) + c(5000, -5000), col= "#707070", border = NA, add = TRUE)
plot(st_geometry(study_area), col = "white", 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), 2021",
col = "white", coltitle = "black",
sources = "Sources : INSEE, IGN, DREES, (c) OSM et contributeurs, Natural Earth, 2021", scale = 50)
}2 Analyses préliminaires
Intégration du script réalisé par SBM et BC.
2.1 Analyse sur les cadres
Communes avec plus de 10 % de cadres.
Calcul des indicateurs utiles
#Calcul de la part de cadres (ds les actifs) niveau communes
com_insee$partcad16 <- (com_insee$ACT_CAD_16 / com_insee$ACT_TOT_16)
### Sélection des communes avec plus de 10% de cadres en 2016
# Crétion d'une fonction f pour obtenir des résumés statistiques sur la variable du % de cadres
# (min, 1er décile, 1er quartile, moyenne, médiane, 2e quartile, 9e décile, maximum).
f <- function(x){
c(min = min(x, na.rm = TRUE),
quantile(x, probs = 0.1, na.rm = TRUE),
quantile(x, probs = 0.25, na.rm = TRUE),
Moy = mean(x, na.rm = TRUE) ,
Med = median(x, na.rm = TRUE),
quantile(x, probs = 0.75, na.rm = TRUE),
quantile(x, probs = 0.9, na.rm = TRUE),
Max = max(x, na.rm = TRUE))
}
af <- com_insee[,c("partcad16"),
drop = T]
af <- t(sapply(af, f))
#Sélection des 14616 communes > 10% de cadres (moyenne des communes)
com_insee_CAD16 <- filter(com_insee, partcad16 >= 0.10071159)
com_insee_CAD16 <- select(com_insee_CAD16,"INSEE_COM","NOM_REG")
#Fusion des fichiers de la sélection des communes cadres avec le fichier des distances only 2018
com_insee_CAD16 <- merge(com_insee_CAD16,
com_dist[,c("INSEE_COM", "DIST1_ALL_2018", "DIST2_ALL_2018", "DIST1_PUB_2018",
"DIST2_PUB_2018", "DIST1_PRIV_2018", "DIST2_PRIV_2018"), drop = T],
all.x = FALSE, by = "INSEE_COM")
#Calcul des différences de distance entre Hopital le plus proche et 2e le plus proche
com_insee_CAD16$D1_D2_ALL_2018 <- com_insee_CAD16$DIST2_ALL_2018 - com_insee_CAD16$DIST1_ALL_2018
com_insee_CAD16$D1_D2_PUB_2018 <- com_insee_CAD16$DIST2_PUB_2018 - com_insee_CAD16$DIST1_PUB_2018
com_insee_CAD16$D1_D2_PRIV_2018 <- com_insee_CAD16$DIST2_PRIV_2018 - com_insee_CAD16$DIST1_PRIV_2018
#Indication avec ifelse de la structure la plus proche : privé ou public
com_insee_CAD16$DIST_TYPE_2018 <- ifelse(com_insee_CAD16$DIST1_PUB_2018 < com_insee_CAD16$DIST1_PRIV_2018,
"Public", "Privé")
com_insee_CAD16$DIST_TYPE_2018 <- ifelse(abs(com_insee_CAD16$DIST1_PUB_2018 - com_insee_CAD16$DIST1_PRIV_2018) < 5,
"Peu de différences", com_insee_CAD16$DIST_TYPE_2018)
#Crétion du tableau résumé stat des 9 distances
df <- com_insee_CAD16[,c("DIST1_ALL_2018", "DIST2_ALL_2018", "DIST1_PUB_2018",
"DIST2_PUB_2018", "DIST1_PRIV_2018", "DIST2_PRIV_2018",
"D1_D2_ALL_2018", "D1_D2_PUB_2018", "D1_D2_PRIV_2018"),
drop = T]
df <- t(sapply(df, f))
knitr::kable(df, digits = 1) | min | 10% | 25% | Moy | Med | 75% | 90% | Max | |
|---|---|---|---|---|---|---|---|---|
| DIST1_ALL_2018 | 0.2 | 7.4 | 12.0 | 20.0 | 18.3 | 26.1 | 34.3 | 139.8 |
| DIST2_ALL_2018 | 1.1 | 10.9 | 16.4 | 26.0 | 24.3 | 33.5 | 42.7 | 143.2 |
| DIST1_PUB_2018 | 0.2 | 9.1 | 14.0 | 22.6 | 20.7 | 29.2 | 38.1 | 143.2 |
| DIST2_PUB_2018 | 1.8 | 19.2 | 25.9 | 35.6 | 34.1 | 43.5 | 53.8 | 156.8 |
| DIST1_PRIV_2018 | 0.5 | 8.9 | 14.3 | 25.3 | 22.5 | 32.9 | 45.1 | 139.8 |
| DIST2_PRIV_2018 | 1.1 | 14.5 | 21.9 | 35.3 | 32.8 | 45.5 | 58.7 | 156.1 |
| D1_D2_ALL_2018 | 0.0 | 0.3 | 0.9 | 6.0 | 2.6 | 7.2 | 18.2 | 81.8 |
| D1_D2_PUB_2018 | 0.0 | 1.2 | 3.8 | 13.0 | 10.5 | 19.6 | 28.3 | 81.8 |
| D1_D2_PRIV_2018 | 0.0 | 0.4 | 1.4 | 10.0 | 4.8 | 15.1 | 27.2 | 97.5 |
## Cartographie temps d'accès 2018 pour les communes avec plus de 10% de cadres ALL
png(file = "fig/ACCESS_01.png", width = sizes[1], height = sizes[2], res = 400)
layChir(title = "Temps d'accès l'hôpital le plus proche pour les communes avec > 10% cadres - 2018")
choroLayer(x = com_insee_CAD16, var = "DIST1_ALL_2018",
breaks = c(0, 15, 30, 45, 60 ,max(com_insee_CAD16$DIST1_ALL_2018, na.rm = TRUE)),
col = carto.pal(pal1 = "brown.pal", n1 = 5), border = NA,
legend.pos = "topleft", legend.values.rnd = 0,
legend.title.txt = "Temps d'accès par la route\n(source : OSRM)",
add = TRUE)
plot(st_geometry(border), col = "white", lwd = 1, add = TRUE)
plot(st_geometry(hop[hop$year == 2018,]), add = TRUE, pch = 21, cex = 0.2,
bg = "red", col = NA)
dev.off()
## Cartographie temps d'accès 2018 pour le 1er hosto le plus proche
# pour les communes avec plus de 10% de cadres PRIVE PUIS PUBLIC
png(file = "fig/ACCESS_02.png", width = sizes[1], height = sizes[2], res = 400)
layChir(title = "Temps d'acces à l'hôpital le plus proche (structure privée) CADRES - 2018")
choroLayer(x = com_insee_CAD16, var = "DIST1_PRIV_2018",
breaks = c(0, 15, 30, 45, 60, max(com_insee_CAD16$DIST1_PRIV_2018, na.rm = TRUE)),
col = carto.pal(pal1 = "brown.pal", n1 = 5), border = NA,
legend.pos = "topleft", legend.values.rnd = 0,
legend.title.txt = "Temps d'accès par la route\n(source : OSRM)",
add = TRUE)
plot(st_geometry(border), col = "white", lwd = 1, add = TRUE)
plot(st_geometry(hop[hop$year == 2018 & (hop$stjr == 2 |hop$stjr == 3),]),
add = TRUE, pch = 21, cex = 0.2, bg = "red", col = NA)
dev.off()
png(file = "fig/ACCESS_03.png", width = sizes[1], height = sizes[2], res = 400)
layChir(title = "Temps d'acces l'hôpital le plus proche (structure publique) CADRES - 2018")
choroLayer(x = com_insee_CAD16, var = "DIST1_PUB_2018",
breaks = c(0, 15, 30, 45, 60, max(com_insee_CAD16$DIST1_PUB_2018, na.rm = TRUE)),
col = carto.pal(pal1 = "brown.pal", n1 = 5), border = NA,
legend.pos = "topleft", legend.values.rnd = 0,
legend.title.txt = "Temps d'accès par la route\n(source : OSRM)",
add = TRUE)
plot(st_geometry(border), col = "white", lwd = 1, add = TRUE)
plot(st_geometry(hop[hop$year == 2018 & hop$stjr == 1,]),
add = TRUE, pch = 21, cex = 0.2, bg = "red", col = NA)
dev.off()
## Cartographie qu'est-ce qui est le plus proche : privé ou public
# pour les communes avec plus de 10% de cadres PRIVE PUIS PUBLIC
png(file = "fig/ACCESS_04.png", width = sizes[1], height = sizes[2], res = 400)
layChir(title = "Proximité aux structures privées ou publiques (2018) CADRES")
typoLayer(x = com_insee_CAD16, var = "DIST_TYPE_2018",
col = c("indianred1", "skyblue3", "lightgrey"),
legend.values.order = c("Public", "Privé", "Peu de différences"),
border = NA, lwd = .2, legend.pos = "topleft",
legend.title.txt = "Type de structure\nla plus proche par la route",
add = TRUE)
plot(st_geometry(hop[hop$year == 2018 & hop$stjr == 1,]),
add = TRUE, pch = 21, cex = .7, bg = "red3", col = "white")
plot(st_geometry(hop[hop$year == 2018 & (hop$stjr == 2 |hop$stjr == 3),]),
add = TRUE, pch = 21, cex = .7, bg = "blue3", col = "white")
plot(st_geometry(border), col = "#b59a82", lwd = 1, add = TRUE)
dev.off()
2.2 Nombres de lits accessibles pour les cadres
# Cartographie du nbre de lits et places accessibles à 30 mn
#D'abord création du fichier permettant la carte
com_insee_CAD16 <- merge(com_insee_CAD16,
com_cap [,c("INSEE_COM", "LIT_30MN_ALL_2018", "LIT_30MN_PUB_2018", "LIT_30MN_PRIV_2018",
"PLACE_30MN_ALL_2018", "PLACE_30MN_PUB_2018", "PLACE_30MN_PRIV_2018"), drop = T],
all.x = FALSE, by = "INSEE_COM")
#pour connaître la forme de la distribution
summary(com_insee_CAD16$LIT_30MN_ALL_2018)
quantile(com_insee_CAD16$LIT_30MN_ALL_2018)
quantile(com_insee_CAD16$LIT_30MN_ALL_2018, probs=seq(0,1,0.125))#Ensuite cartographie
# Lits all
png(file = "fig/ACCESS_05.png", width = sizes[1], height = sizes[2], res = 400)
layChir(title = "CADRES Nombre de lits accessibles dans un voisinage de 30 minutes, 2018")
choroLayer(x = com_insee_CAD16, var = "LIT_30MN_ALL_2018",
breaks = c(0,25,131,408,max(com_insee_CAD16$LIT_30MN_ALL_2018)),
col = carto.pal(pal1 = "sand.pal" , n1 = 4), border = NA,
legend.pos = "topleft", legend.values.rnd = 0,
legend.title.txt = "CADRES Lits accessibles depuis le chef-lieu de chaque commune\nà moins de 30 minutes par la route\nQuantiles",
add = TRUE)
plot(st_geometry(border), col = "white", lwd = 1, add = TRUE)
dev.off()
# Lits pub
quantile(com_insee_CAD16$LIT_30MN_PUB_2018, probs=seq(0,1,0.25))
png(file = "fig/ACCESS_06.png", width = sizes[1], height = sizes[2], res = 400)
layChir(title = "CADRES Nombre de lits PUB accessibles dans un voisinage de 30 minutes, 2018")
choroLayer(x = com_insee_CAD16, var = "LIT_30MN_PUB_2018",
breaks = c(0,0,60,176,max(com_insee_CAD16$LIT_30MN_PUB_2018)),
col = carto.pal(pal1 = "sand.pal" , n1 = 4), border = NA,
legend.pos = "topleft", legend.values.rnd = 0,
legend.title.txt = "CADRES Lits accessibles depuis le chef-lieu de chaque commune\nà moins de 30 minutes par la route\nQuantiles",
add = TRUE)
plot(st_geometry(border), col = "white", lwd = 1, add = TRUE)
dev.off()
# Lits Priv
quantile(com_insee_CAD16$LIT_30MN_PRIV_2018, probs=seq(0,1,0.25))
png(file = "fig/ACCESS_07.png", width = sizes[1], height = sizes[2], res = 400)
layChir(title = "CADRES Nombre de lits PRIV accessibles dans un voisinage de 30 minutes, 2018")
choroLayer(x = com_insee_CAD16, var = "LIT_30MN_PRIV_2018",
breaks = c(0,0,63,223,max(com_insee_CAD16$LIT_30MN_PRIV_2018)),
col = carto.pal(pal1 = "sand.pal" , n1 = 4), border = NA,
legend.pos = "topleft", legend.values.rnd = 0,
legend.title.txt = "CADRES Lits accessibles depuis le chef-lieu de chaque commune\nà moins de 30 minutes par la route\nQuantiles",
add = TRUE)
plot(st_geometry(border), col = "white", lwd = 1, add = TRUE)
dev.off()
# Contruire le fichier avec les variable d'intérêt pour tester la validité/distribution des variables
com_insee_test <- select(com_insee,"INSEE_COM","NOM_REG", "POP_TOT_16", "POP_TOT_99",
"ACT_CAD_16", "ACT_EMP_16", "ACT_INT_16", "ACT_TOT_16", "DIP_A_16", "DIP_B_16", "DIP_C_16", "DIP_D_16", "MEN_16", "VOIT_16", "REV_DISP_17",
"ACT_CAD_99", "ACT_EMP_99", "ACT_INT_99", "ACT_TOT_99", "DIP_A_99", "DIP_B_99", "DIP_C_99", "DIP_D_99", "MEN_11", "VOIT_11")
com_insee_test$partcad16 <- (com_insee_test$ACT_CAD_16 / com_insee_test$ACT_TOT_16)
com_insee_test$partemp16 <- (com_insee_test$ACT_EMP_16 / com_insee_test$ACT_TOT_16)
com_insee_test$partint16 <- (com_insee_test$ACT_INT_16 / com_insee_test$ACT_TOT_16)
com_insee_test$partcad99 <- (com_insee_test$ACT_CAD_99 / com_insee_test$ACT_TOT_99)
com_insee_test$partemp99 <- (com_insee_test$ACT_EMP_99 / com_insee_test$ACT_TOT_99)
com_insee_test$partint99 <- (com_insee_test$ACT_INT_99 / com_insee_test$ACT_TOT_99)
com_insee_test$totdip16 <- (com_insee_test$DIP_A_16 + com_insee_test$DIP_B_16 + com_insee_test$DIP_C_16 + com_insee_test$DIP_D_16)
com_insee_test$totdip99 <- (com_insee_test$DIP_A_99 + com_insee_test$DIP_B_99 + com_insee_test$DIP_C_99 + com_insee_test$DIP_D_99)
com_insee_test$partdipA16 <- (com_insee_test$DIP_A_16 / com_insee_test$totdip16)
com_insee_test$partdipB16 <- (com_insee_test$DIP_B_16 / com_insee_test$totdip16)
com_insee_test$partdipC16 <- (com_insee_test$DIP_C_16 / com_insee_test$totdip16)
com_insee_test$partdipD16 <- (com_insee_test$DIP_D_16 / com_insee_test$totdip16)
com_insee_test$partdipA99 <- (com_insee_test$DIP_A_99 / com_insee_test$totdip99)
com_insee_test$partdipB99 <- (com_insee_test$DIP_B_99 / com_insee_test$totdip99)
com_insee_test$partdipC99 <- (com_insee_test$DIP_C_99 / com_insee_test$totdip99)
com_insee_test$partdipD99 <- (com_insee_test$DIP_D_99 / com_insee_test$totdip99)
com_insee_test$partmot16 <- (com_insee_test$VOIT_16 / com_insee_test$MEN_16)
com_insee_test$partmot11 <- (com_insee_test$VOIT_11 / com_insee_test$MEN_11)
#Un summary pour voir si pbms ds le fichier
summary(com_insee_test) INSEE_COM NOM_REG POP_TOT_16 POP_TOT_99
Length:35228 Length:35228 Min. : 0.0 Min. : 0
Class :character Class :character 1st Qu.: 197.0 1st Qu.: 176
Mode :character Mode :character Median : 449.3 Median : 385
Mean : 1830.0 Mean : 1640
3rd Qu.: 1125.0 3rd Qu.: 948
Max. :2190108.5 Max. :2125017
ACT_CAD_16 ACT_EMP_16 ACT_INT_16 ACT_TOT_16
Min. : 0.0 Min. : 0.00 Min. : 0.00 Min. : 0.0
1st Qu.: 4.9 1st Qu.: 15.25 1st Qu.: 14.83 1st Qu.: 65.5
Median : 14.8 Median : 42.06 Median : 39.12 Median : 157.9
Mean : 109.9 Mean : 175.50 Mean : 165.17 Mean : 631.2
3rd Qu.: 41.2 3rd Qu.: 110.00 3rd Qu.: 104.97 3rd Qu.: 396.9
Max. :431616.3 Max. :160151.45 Max. :206810.62 Max. :902548.6
DIP_A_16 DIP_B_16 DIP_C_16
Min. : 0.00 Min. : 0.00 Min. : 0.00
1st Qu.: 44.37 1st Qu.: 44.58 1st Qu.: 25.26
Median : 96.76 Median : 103.11 Median : 60.64
Mean : 394.97 Mean : 336.27 Mean : 236.53
3rd Qu.: 242.29 3rd Qu.: 255.00 3rd Qu.: 153.87
Max. :292553.21 Max. :136777.23 Max. :226566.64
DIP_D_16 MEN_16 VOIT_16 REV_DISP_17
Min. : 0.0 Min. : 0.0 Min. : 0.0 Min. :11070
1st Qu.: 30.0 1st Qu.: 85.3 1st Qu.: 79.6 1st Qu.:19330
Median : 75.0 Median : 190.0 Median : 177.9 Median :20760
Mean : 408.3 Mean : 817.9 Mean : 664.6 Mean :21201
3rd Qu.: 200.0 3rd Qu.: 473.5 3rd Qu.: 438.9 3rd Qu.:22550
Max. :1032634.6 Max. :1140127.3 Max. :400836.7 Max. :48310
NA's :387 NA's :387 NA's :3586
ACT_CAD_99 ACT_EMP_99 ACT_INT_99 ACT_TOT_99
Min. : 0 Min. : 0.0 Min. : 0.0 Min. : 0.0
1st Qu.: 4 1st Qu.: 12.0 1st Qu.: 8.0 1st Qu.: 60.0
Median : 8 Median : 36.0 Median : 28.0 Median : 144.0
Mean : 78 Mean : 179.1 Mean : 140.4 Mean : 608.8
3rd Qu.: 28 3rd Qu.: 96.0 3rd Qu.: 76.0 3rd Qu.: 352.0
Max. :334718 Max. :217156.0 Max. :218296.0 Max. :914666.0
DIP_A_99 DIP_B_99 DIP_C_99 DIP_D_99
Min. : 0.0 Min. : 0.0 Min. : 0.0 Min. : 0.0
1st Qu.: 68.0 1st Qu.: 32.0 1st Qu.: 12.0 1st Qu.: 12.0
Median : 144.0 Median : 76.0 Median : 32.0 Median : 32.0
Mean : 540.8 Mean : 296.4 Mean : 146.1 Mean : 211.1
3rd Qu.: 340.0 3rd Qu.: 196.0 3rd Qu.: 80.0 3rd Qu.: 84.0
Max. :491715.0 Max. :185179.0 Max. :227563.0 Max. :704596.0
MEN_11 VOIT_11 geom partcad16
Min. : 0.0 Min. : 0.0 MULTIPOLYGON :35228 Min. :0.00000
1st Qu.: 82.6 1st Qu.: 76.0 epsg:2154 : 0 1st Qu.:0.03390
Median : 181.8 Median : 168.2 +proj=lcc ...: 0 Median :0.08511
Mean : 785.0 Mean : 635.5 Mean :0.10072
3rd Qu.: 450.8 3rd Qu.: 414.1 3rd Qu.:0.14286
Max. :1165541.2 Max. :456146.1 Max. :1.00000
NA's :390 NA's :390 NA's :149
partemp16 partint16 partcad99 partemp99
Min. :0.0000 Min. :0.0000 Min. :0.00000 Min. :0.0000
1st Qu.:0.2089 1st Qu.:0.1765 1st Qu.:0.02128 1st Qu.:0.2000
Median :0.2721 Median :0.2500 Median :0.06040 Median :0.2609
Mean :0.2696 Mean :0.2442 Mean :0.07186 Mean :0.2551
3rd Qu.:0.3333 3rd Qu.:0.3115 3rd Qu.:0.10000 3rd Qu.:0.3146
Max. :1.0000 Max. :1.0000 Max. :1.00000 Max. :1.0000
NA's :149 NA's :149 NA's :92 NA's :92
partint99 totdip16 totdip99 partdipA16
Min. :0.0000 Min. : 0.0 Min. : 0 Min. :0.0000
1st Qu.:0.1344 1st Qu.: 154.3 1st Qu.: 132 1st Qu.:0.2222
Median :0.1942 Median : 344.6 Median : 288 Median :0.2870
Mean :0.1944 Mean : 1376.1 Mean : 1194 Mean :0.2963
3rd Qu.:0.2500 3rd Qu.: 852.8 3rd Qu.: 704 3rd Qu.:0.3612
Max. :1.0000 Max. :1688531.7 Max. :1609053 Max. :1.0000
NA's :92 NA's :14
partdipB16 partdipC16 partdipD16 partdipA99
Min. :0.0000 Min. :0.0000 Min. :0.0000 Min. :0.0000
1st Qu.:0.2414 1st Qu.:0.1429 1st Qu.:0.1607 1st Qu.:0.4283
Median :0.2917 Median :0.1750 Median :0.2222 Median :0.5027
Mean :0.2927 Mean :0.1785 Mean :0.2325 Mean :0.5048
3rd Qu.:0.3413 3rd Qu.:0.2096 3rd Qu.:0.2930 3rd Qu.:0.5806
Max. :1.0000 Max. :1.0000 Max. :1.0000 Max. :1.0000
NA's :14 NA's :14 NA's :14 NA's :39
partdipB99 partdipC99 partdipD99 partmot16
Min. :0.0000 Min. :0.00000 Min. :0.00000 Min. :0.1573
1st Qu.:0.2180 1st Qu.:0.07895 1st Qu.:0.07065 1st Qu.:0.9050
Median :0.2640 Median :0.10909 Median :0.10746 Median :0.9361
Mean :0.2635 Mean :0.11221 Mean :0.11953 Mean :0.9250
3rd Qu.:0.3111 3rd Qu.:0.14173 3rd Qu.:0.15538 3rd Qu.:0.9581
Max. :1.0000 Max. :1.00000 Max. :1.00000 Max. :1.0000
NA's :39 NA's :39 NA's :39 NA's :393
partmot11
Min. :0.0250
1st Qu.:0.8913
Median :0.9254
Mean :0.9145
3rd Qu.:0.9505
Max. :1.0000
NA's :396 # Pbms : Paris 75056 pas renseigné pour certaines variables ;
# Certaines variables avec NA : ex partCad16 : 150 communes NA car le calcul de la part impossible car popact16=0# faire la carte des communes avec les taux > moyennes de cadres aux deux dates et regarder si l'évolution a une configuration
png(file = "fig/ACCESS_08.png", width = sizes[1], height = sizes[2], res = 400)
layChir(title = "% CADRES - 2016")
choroLayer(x = com_insee_test, var = "partcad16",
breaks = c(0, 0.033, 0.085, 0.14, 1),
col = carto.pal(pal1 = "brown.pal", n1 = 4), border = NA,
legend.pos = "topleft", legend.values.rnd = 3,
legend.title.txt = "part de cadres 2016\n(source : OSRM)",
add = TRUE)
plot(st_geometry(border), col = "white", lwd = 1, add = TRUE)
plot(st_geometry(hop[hop$year == 2018 & hop$stjr == 1,]),
add = TRUE, pch = 21, cex = 0.2, bg = "red", col = NA)
dev.off()
2.3 Analyse des corrélations
# Calcul des corrélations entre les variables d'intérêt et les variables de distances
# Constitution du fichier
com_insee_corr <- merge(com_insee_test,
com_dist[,c("INSEE_COM", "DIST1_ALL_2018", "DIST2_ALL_2018", "DIST1_PUB_2018",
"DIST2_PUB_2018", "DIST1_PRIV_2018", "DIST2_PRIV_2018"), drop = T],
all.x = FALSE, by = "INSEE_COM")
#Sélection de certaines variables pour faire les matrices de correlation
com_insee_corr2 <- select(com_insee_corr, POP_TOT_16:POP_TOT_99, ACT_TOT_16, ACT_TOT_99, partcad16:partdipD99, DIST1_ALL_2018:DIST2_PRIV_2018)
# Enlever la colonne geometry d'un sf.dataframe
Corr3 <- com_insee_corr2 %>% st_drop_geometry()
test <- filter(Corr3, ACT_TOT_16 > 0)
test <- filter(test, ACT_TOT_99 > 0)
test <- test[!is.na(test$DIST1_ALL_2018),]
#Corrélogramme
M <- cor(test)
corrplot(M, method = "circle")
3 Accès des populations à différents pas de distance
On cherche ici à présenter le temps routier nécessaire pour rejoindre l’hôpital le plus proches pour différentes catégories de population (par CSP, par niveau de diplôme).
3.1 Fonctions
3.1.1 Création de fréquences cumulées
La fonction freqCum ressort un graphique présentant l’effectif cumulé d’une catégorie de population en fonction d’une distance exprimée en minutes à l’hôpital disposant de lits en chirurgie le plus proche. Elle prend en entrée les arguments suivants :
x: un data frame qui comprend au minimum une variable exprimant la distance et une variable décrivant une population.dist: label de la variable de distance utilisée, comprise dansx.pop: label(s) des variables de population utilisées dans l’analyse, comprise(s) dansx.label.x: afficher un point (x,y) sur la courbe et son label en fonction d’une ou plusieurs valeurs de x (distance-temps).label.y: afficher un point (y,x) sur la courbe et son label en fonction d’une ou plusieurs valeurs de y (population).xlab: Label de l’axe des abscisses (temps routier).xlim: Emprise du graphique sur l’axe des abscisses (défaut : c(0, 100)).ylim: Emprise du graphique sur l’axe des ordonnées (défaut : c(0, 100)).lwd: Épaisseur de la ligne (défaut : 0.5).lty: Type de ligne (défaut : 1, ligne continue)add: Si TRUE, rajouter sur un graphique pré-existant l’affichage de fréquences cumulées (défaut = FALSE).
freqCum <- function(x, dist, pop, cols, label.x = NULL, label.y = NULL, xlab,
xlim = c(0, 100), ylim = c(0, 100), lwd = 0.5, lty = 1, add = FALSE){
# Sélectionner les valeurs
df <- x[,c(dist, pop)]
# Intervalles de temps (minute par minute)
brks <- seq(0, max(df[,dist], na.rm = TRUE), by = 0.1)
df$dist <- findInterval(df[,dist], vec = brks)
df$dist <- brks[df$dist+1]
# Supprimer valeurs manquantes (anciens découpages territoriaux)
df <- df[!is.na(df$dist),]
# Graphique vide
par(mar = c(4,4,1,1), xaxs = "i", yaxs = "i")
if(add != TRUE){
plot(1, type = "n",
xlab = xlab, ylab = "Effectif cumulé (% population)",
xlim = xlim, ylim = ylim)
abline (h = seq(0, 100, 10), col = "#00000060", lwd = 0.2, lty = 3)
abline (v = seq(0, 100, 10), col = "#00000060", lwd = 0.2, lty = 3)
}
for (i in 1:length(pop)){
# Aggréger les données de pop par pas de temps
t <- aggregate(df[,pop[i]], by = list(df$dist), sum)
# Fréquence cumulée
t$freq <- cumsum(t$x)
t$cumul <- t$freq / t[nrow(t),3] * 100
lines(t$Group.1, t$cumul, col = cols[i], lwd = lwd, lty = lty)
if(length(label.x > 0)){
for (j in 1:length(label.x)){
xy <- t[which.min(abs(label.x[j] - t$Group.1)),]
points(y = xy[,"cumul"], x = xy[,"Group.1"], pch = 21,cex = 1.5, bg = cols[i])
text(y = xy[,"cumul"], x = xy[,"Group.1"], pos = 2, cex = 0.6,
label = paste(round(xy[,"Group.1"],0), round(xy[,"cumul"],1),
sep = ", "))
}
}
if(length(label.y > 0)){
for (j in 1:length(label.y)){
xy <- t[which.min(abs(label.y[j] - t$cumul)),]
points(y = label.y[j], x = xy[,"Group.1"], pch = 21,cex = 1.5, bg = cols[i])
text(y = label.y[j], x = xy[,"Group.1"], pos = 2, cex = 0.6,
label = paste(label.y[j], round(xy[,"Group.1"],1),
sep = ", "))
}
}
}
}3.1.2 Légende du graphique
La fonction popLabel permet de générer des labels pour la légende du graphique qui rappellent les ordres de grandeur des catégories sélectionnées (restitution des sommes des catégories sélectionnées). La fonction retourne un vecteur qui sera utilisé dans la légende du graphique.
popLabel <- function(x, pop, pop.label, unit.label = "millions d'hab.", rnd = 1000000){
xx <- vector()
for (i in 1:length(pop)){
sumP <- sum(x[,pop[i]])
sumP <- round(sumP / rnd, 2)
xx[i] <- paste0(pop.label[i], " (", sumP, " ", unit.label, ")")
}
return(xx)
}3.2 Cadres, ouvriers et agriculteurs
3.2.1 En 2018
df <- st_set_geometry(com_dist, NULL)
freqCum(x = df, dist = "DIST1_ALL_2018",
pop = c("ACT_TOT_16", "ACT_CAD_16", "ACT_EMP_16", "ACT_OUV_16", "ACT_AGR_16"),
cols = c("black", "blue", "orange", "red", "green"), label.x = c(15, 30),
xlab = "Temp routier (minutes) à l'hôpital le plus proche, en 2018",
xlim = c(0,60), lwd = 2, lty = 3)
leg <- popLabel(x = df, pop = c("ACT_TOT_16", "ACT_CAD_16", "ACT_EMP_16", "ACT_OUV_16", "ACT_AGR_16"),
pop.label = c("Actifs, 2016", "Cadres, 2016", "Employés, 2016", "Ouvriers, 2016",
"Agriculteurs"))
legend("bottomright", legend = leg, col = c("black", "blue", "orange", "red", "green"),
cex = .7, inset = c(0,0), border = NA, bty = "n", lwd = 2, lty = 3)
Clé de lecture : 73.6 % des agriculteurs âgés de 25 à 54 ans résident dans une commune dont le chef lieu est situé à moins de 30 minutes d’un hôpital disposant de lits en chirurgie. L’effectif total de cette catégorie. Cette catégorie de CSP regroupe 0.28 millions d’habitants
3.2.2 Evolution 1999 - 2018 (cadres, ouvriers, agriculteurs)
# Graphique distances 2018
freqCum(x = df, dist = "DIST1_ALL_2018",
pop = c("ACT_CAD_16", "ACT_OUV_16", "ACT_AGR_16"),
cols = c("blue", "red", "green"),
xlab = "Temp routier (minutes) à l'hôpital le plus proche, en 1999 et 2018",
xlim = c(0,60), lwd = 2)
# Graphique distances 2000
freqCum(x = df, dist = "DIST1_ALL_2000",
pop = c("ACT_CAD_99", "ACT_OUV_99", "ACT_AGR_99"),
cols = c("blue", "red", "green"), lty = 3, lwd = 2, add = TRUE)
# Légende grapghique
leg1 <- popLabel(x = df, pop = c("ACT_CAD_16", "ACT_OUV_16", "ACT_AGR_16"),
pop.label = c("Cadres, 2016", "Employés, 2016", "Ouvriers, 2016",
"Agriculteurs, 2016"))
leg2 <- popLabel(x = df, pop = c("ACT_CAD_99", "ACT_OUV_99", "ACT_AGR_99"),
pop.label = c("Cadres, 1999", "Employés, 1999", "Ouvriers, 1999",
"Agriculteurs, 2000"))
leg <- c(leg1,leg2)
legend("bottomright", legend = leg, col = c("blue", "red", "green"),
cex = .8, inset = c(0,0), border = NA, bty = "n", lwd = 2, lty = c(rep(1,3), rep(3,3)))
3.3 Par type de territoire en 2018
# Filtre territorial
dfPU <- df[df$CATAEU2010 %in% c("111", "211"),]
dfPERI <- df[df$CATAEU2010 %in% c("112", "120", "212"),]
dfRUR <- df[df$CATAEU2010 %in% c("221", "222", "300", "400"),]
# Graphique Urbain
freqCum(x = dfPU, dist = "DIST1_ALL_2018", pop = "POP_TOT_16",
cols = "#bd0026", xlim = c(0,60), label.y = c(25, 50, 75),
xlab = "Temp routier (minutes) à l'hôpital le plus proche, en 2018")
# Graphique Périurbain
freqCum(x = dfPERI, dist = "DIST1_ALL_2018", pop = "POP_TOT_16",
cols = "#f03b20", label.y = c(25, 50, 75), add = TRUE)
# Graphique Périurbain
freqCum(x = dfRUR, dist = "DIST1_ALL_2018", pop = "POP_TOT_16",
cols = "#feb24c", label.y = c(25, 50, 75), add = TRUE)
# Légende grapghique
leg1 <- popLabel(x = dfPU, pop = "POP_TOT_16", pop.label = "Pôles urbains, 2016")
leg2 <- popLabel(x = dfPERI, pop = "POP_TOT_16", pop.label = "Périurbain, 2016")
leg3 <- popLabel(x = dfRUR, pop = "POP_TOT_16", pop.label = "Rural, 2016")
leg <- c(leg1,leg2, leg3)
legend("bottomright", legend = leg, col = c("#bd0026", "#f03b20", "#feb24c"),
cex = .8, inset = c(0,0), border = NA, bty = "n", lwd = 0.5, lty = c(rep(1,3), rep(3,3)))
3.4 Par taille d’aire urbaine en 2018
# Filtre territorial
dfGV <- df[df$TAU2015 %in% c("08", "09", "10"),]
dfVM <- df[df$TAU2015 %in% c("06", "07"),]
dfVP <- df[df$TAU2015 %in% c("03", "04", "05"),]
dfVTP <- df[df$TAU2015 %in% c("01", "02"),]
# Couleurs
cols <- c("#00441b", "#006d2c", "#238b45", "#41ab5d")
# Graphique Grandes villes
freqCum(x = dfGV, dist = "DIST1_ALL_2018", pop = "POP_TOT_16",
cols = cols[1], xlim = c(0,60), label.y = c(25, 50, 75),
xlab = "Temp routier (minutes) à l'hôpital le plus proche, en 2018")
# Villes moyennes
freqCum(x = dfVM, dist = "DIST1_ALL_2018", pop = "POP_TOT_16",
cols = cols[2], add = TRUE)
# Petites villes
freqCum(x = dfVP, dist = "DIST1_ALL_2018", pop = "POP_TOT_16",
cols = cols[3], add = TRUE)
# Très petites villes
freqCum(x = dfVTP, dist = "DIST1_ALL_2018", pop = "POP_TOT_16",
cols = cols[4], label.y = c(25, 50, 75), add = TRUE)
# Légende grapghique
leg1 <- popLabel(x = dfGV, pop = "POP_TOT_16", pop.label = "Très grandes villes, 2016")
leg2 <- popLabel(x = dfVM, pop = "POP_TOT_16", pop.label = "Villes moyennes, 2016")
leg3 <- popLabel(x = dfVP, pop = "POP_TOT_16", pop.label = "Petites villes, 2016")
leg4 <- popLabel(x = dfVTP, pop = "POP_TOT_16", pop.label = "Petites villes, 2016")
leg <- c(leg1,leg2, leg3, leg4)
legend("bottomright", legend = leg, col = cols,
cex = .8, inset = c(0,0), border = NA, bty = "n", lwd = 0.5, lty = 1)
4 Analyse des capacités
4.1 Fonction
On propose ici une fonction qui permet d’évaluer la quantité de lits disponibles à différents pas de distance.
Cette fonction prend en entrée les arguments suivants :
x: la couche géographique qui comprend les informations sur les lits disponibles à différents pas de distance (com_cap).pop: indicateur sur lequel ce graphique est calculé. Si pop = 1 pour toutes les communes, cela signifie que le graphique présente la part des communes, si pop = “POP_TOT_16”, il s’agira de la part de la population totale.var: un vecteur décrivant les variables de distance sur lesquelles on souhaite réaliser l’analyse.thr: discrétisation désirée (nombre de lits).cols: un vecteur décrivant les couleurs associées àvar.- `main.title`` : titre du graphique
y.title: titre de l’axe des ordonnées.
La fonction retourne un graphique en barre qui présente, selon les seuils de discrétisation choisis, la part de la population (ou un autre indicateur de référence) qui dispose entre x et y lits (discrétisation) à moins de z minutes (indicateurs de distance).
freqCap <- function(x, pop, var, thr, cols, main.title, y.title){
# Supprimer les géométries
x <- st_set_geometry(x, NULL)
# Discrétisation
x$disc <- cut(x[,var[1]],
breaks = thr,
dig.lab = 10,
include.lowest = TRUE)
# Nombre de lits à différents pas de distance selon la discrétisation désirée
tmp <-aggregate(x[,pop], by = list(x$disc), sum)
tmp$x <- tmp$x / sum(tmp$x) * 100
colnames(tmp)[2] <- var[1]
# Réordonner la discrétisation de façon cohérente
thrOrder <- as.vector(cut(thr, thr, include.lowest = TRUE, dig.lab = 10))
thrOrder <- thrOrder[2:length(thrOrder)]
# Le faire pour les autres variables
for (i in 2:length(var)){
x$disc <- cut(x[,var[i]],
breaks = thr,
dig.lab = 10,
include.lowest = TRUE)
tmp2 <- aggregate(x[,pop], by = list(x$disc), sum)
tmp2$x <- tmp2$x / sum(tmp2$x) * 100
colnames(tmp2)[2] <- var[i]
tmp <- merge(tmp, tmp2, by = "Group.1", all = TRUE)
}
# Mise en forme de la table
tmp[is.na(tmp)] <- 0 # Remplacer NA par 0
rownames(tmp) <- tmp[,1]
tmp <- tmp[match(thrOrder, tmp$Group.1),]
tmp <- tmp[,-1]
# Un chtio barplot pour la route
barplot(t(as.matrix(tmp)), main = main.title,
xlab = "Nombre de lits accessibles à différents pas de distance",
ylab = y.title, col = cols, cex.axis = .6, cex.lab = .8,
cex.names = .6, ylim = c(0,100), beside = TRUE)
abline (h = seq(0, 100, 10), col = "#00000060", lwd = 0.2, lty = 3)
legend("topright", legend = colnames(tmp), cex = .6, fill = cols)
}4.2 Accès aux lits d’hôpitaux en 2018
freqCap (x = com_cap, pop = "POP_TOT_16",
var = c("LIT_ALL_2018", "LIT_15MN_ALL_2018", "LIT_30MN_ALL_2018",
"LIT_45MN_ALL_2018", "LIT_60MN_ALL_2018"),
thr = c(0, 1, 500, 1000, 2000, max(com_cap$LIT_60MN_ALL_2018, na.rm = TRUE)),
cols = c("black", "#7f0000", "#d7301f", "#fc8d59", "#fdd49e"),
main.title = "Lits disponibles à différents pas de distance",
y.title = "Part de la population totale en 2016 (%)")
Clé de lecture : 66 % de la population française ne dispose pas de lit en chirurgie dans sa commune de résidence ; 35 % de la population française à accès à au moins 2000 lits en chirurgie à moins d’une heure en voiture en 2018.
4.3 Accès aux lits d’hôpitaux publics en 2018
freqCap (x = com_cap, pop = "POP_TOT_16",
var = c("LIT_PUB_2018", "LIT_15MN_PUB_2018", "LIT_30MN_PUB_2018",
"LIT_45MN_PUB_2018", "LIT_60MN_PUB_2018"),
thr = c(0, 1, 250, 500, 1000, max(com_cap$LIT_60MN_PUB_2018, na.rm = TRUE)),
cols = c("black", "#7f0000", "#d7301f", "#fc8d59", "#fdd49e"),
main.title = "Lits d'hôpitaux publics disponibles à différents pas de distance",
y.title = "Part de la population totale en 2016 (%)")
4.4 Par type d’espace géographique
4.4.1 Aires urbaines
On filtre par types d’espace.
aurb <- com_cap[com_cap$CATAEU2010 %in% c("111", "112", "120"),]
freqCap (x = aurb, pop = "POP_TOT_16",
var = c("LIT_ALL_2018", "LIT_15MN_ALL_2018", "LIT_30MN_ALL_2018",
"LIT_45MN_ALL_2018", "LIT_60MN_ALL_2018"),
thr = c(0, 1, 500, 1000, 2000, max(aurb$LIT_60MN_ALL_2018, na.rm = TRUE)),
cols = c("black", "#7f0000", "#d7301f", "#fc8d59", "#fdd49e"),
main.title = "Lits disponibles à différents pas de distance",
y.title = "Part de la population des aires urbaines en 2016 (%)")
4.4.2 Communes isolées
iz <- com_cap[com_cap$CATAEU2010 %in% c("400"),]
freqCap (x = iz, pop = "POP_TOT_16",
var = c("LIT_ALL_2018", "LIT_15MN_ALL_2018", "LIT_30MN_ALL_2018",
"LIT_45MN_ALL_2018", "LIT_60MN_ALL_2018"),
thr = c(0, 1, 50, 100, 200, max(iz$LIT_60MN_ALL_2018, na.rm = TRUE)),
cols = c("black", "#7f0000", "#d7301f", "#fc8d59", "#fdd49e"),
main.title = "Lits disponibles à différents pas de distance",
y.title = "Part de la population des communes isolées en 2016 (%)")
On constate sur ce graphique qu’aucune commune isolée ne dispose de lits en chirurgie (100 % de la population a moins d’un lit dans sa commune de résidence). Pour accéder à plus de 200 lits, 65 % de la population dit effectuer 1 heure de trajet par la route (au moins, hors congestion).
Accessibilité aux soins de chirurgie