library(tidyverse) # data mainpulation
library(sf) # spatial object manipulation
library(leaflet) # mapping
library(leaflet.extras) # mapping
library(htmltools) # visualisation
library(mapview) # visualisation
library(rvest) # scrape web
library(plotly) # interactive graph
library(viridis) # color formatting
library(lubridate) # date formatting
library(knitr) # table formatting
Données issues de data.gouv.fr :
france_dep <- st_read(dsn = "departements-20180101-shp", layer = "departements-20180101", quiet = TRUE)
france_reg <- st_read(dsn = "regions-20180101-shp", layer = "regions-20180101", quiet = TRUE)
Les données sont retournées sous la forme de “dataframe” incluant une colonne geometry, très facile à manipuler en utilisant dplyr.
head(france_reg)
## Simple feature collection with 6 features and 5 fields
## geometry type: MULTIPOLYGON
## dimension: XY
## bbox: xmin: -61.22908 ymin: -21.38973 xmax: 55.83669 ymax: 51.08899
## epsg (SRID): 4326
## proj4string: +proj=longlat +datum=WGS84 +no_defs
## code_insee nom nuts2 wikipedia
## 1 04 La Réunion FR94 fr:La Réunion
## 2 94 Corse FR83 fr:Corse
## 3 02 Martinique FR92 fr:Martinique
## 4 11 Île-de-France FR10 fr:Île-de-France
## 5 32 Hauts-de-France FR22 fr:Nord-Pas-de-Calais-Picardie
## 6 75 Nouvelle-Aquitaine FR61 fr:Nouvelle-Aquitaine
## surf_km2 geometry
## 1 2505 MULTIPOLYGON (((55.21643 -2...
## 2 8722 MULTIPOLYGON (((8.539958 42...
## 3 1089 MULTIPOLYGON (((-61.22908 1...
## 4 12069 MULTIPOLYGON (((1.446244 49...
## 5 31935 MULTIPOLYGON (((1.379828 50...
## 6 84747 MULTIPOLYGON (((-1.791023 4...
cat("\n\n")
head(france_dep)
## Simple feature collection with 6 features and 5 fields
## geometry type: MULTIPOLYGON
## dimension: XY
## bbox: xmin: -0.1405839 ymin: -21.38973 xmax: 55.83669 ymax: 46.45534
## epsg (SRID): 4326
## proj4string: +proj=longlat +datum=WGS84 +no_defs
## code_insee nom nuts3 wikipedia surf_km2
## 1 974 La Réunion FR940 fr:La Réunion 2505
## 2 11 Aude FR811 fr:Aude (département) 6343
## 3 43 Haute-Loire FR723 fr:Haute-Loire 5003
## 4 13 Bouches-du-Rhône FR823 fr:Bouches-du-Rhône 5247
## 5 47 Lot-et-Garonne FR614 fr:Lot-et-Garonne 5385
## 6 23 Creuse FR632 fr:Creuse (département) 5599
## geometry
## 1 MULTIPOLYGON (((55.21643 -2...
## 2 MULTIPOLYGON (((1.688715 43...
## 3 MULTIPOLYGON (((3.08206 45....
## 4 MULTIPOLYGON (((4.230136 43...
## 5 MULTIPOLYGON (((-0.1405839 ...
## 6 MULTIPOLYGON (((1.372542 46...
Carte de la France métropole, délimitée par région.
france_reg %>%
# simplifier les frontières de chaque polygone (accélère l'affichage de la carte)
st_simplify(preserveTopology = TRUE, dTolerance = 0.01) %>%
leaflet() %>%
addTiles() %>%
# centrer sur la métropole
setView(lng = 2.866, lat = 46.56, zoom = 6) %>%
addPolygons(weight = 1,
fillColor = topo.colors(17, alpha = NULL),
color = "grey",
highlightOptions = highlightOptions(color = "royalblue3", weight = 2,
bringToFront = TRUE),
label = ~ nom)
Ajouter les centres de chaque région.
france_reg <- france_reg %>%
mutate(centroid_lng = st_coordinates(st_centroid(geometry))[,1],
centroid_lat = st_coordinates(st_centroid(geometry))[,2])
Ajouter des marqueurs pour identifier chaque région.
# création marqueur
radar_icon <- makeIcon(
iconUrl = "http://www.securite-routiere.gouv.fr/var/rout/storage/images/media/images/radar-fixe2/361491-1-fre-FR/radar-fixe.png",
iconWidth = 25, iconHeight = 25
)
# dans 'addMarkers', 'label' ne prend de balise HTML => créer une fonction pour reproduire le comportement HTML lorsqu'on survole les icones
custom_labels <- sprintf("<strong>%s</strong><br/>Long : %g ; Lat : %g",
france_reg$nom, france_reg$centroid_lng, france_reg$centroid_lat) %>%
lapply(htmltools::HTML)
# carte avec marqueurs
france_reg %>%
st_simplify(preserveTopology = TRUE, dTolerance = 0.01) %>%
leaflet() %>%
addTiles() %>%
setView(lng = 2.866, lat = 46.56, zoom = 6) %>%
addPolygons(weight = 1,
fillColor = topo.colors(13, alpha = NULL),
color = "grey",
highlightOptions = highlightOptions(color = "royalblue3", weight = 2,
bringToFront = TRUE),
label = ~ nom
) %>%
addMarkers(lng = ~ centroid_lng,
lat = ~ centroid_lat,
label = custom_labels,
labelOptions = labelOptions(textsize = "12px"),
icon = radar_icon)
Si on veut afficher la métropole + les DOM, la carte est trop grande (enlever la ligne de code setView(lng = 2.866, lat = 46.56, zoom = 5) pour visualiser le résultat). Une solution est d’utiliser une grille en intégrant chaque “morceau” dans un espace de la grille, en utilisant mapview::latticeview()
# carte principale
# préciser le paramètre 'height' (doit être un multiple du nombre de cartes annexes : 1000px = 5 * 200px)
metro_map <- france_reg %>%
st_simplify(preserveTopology = TRUE, dTolerance = 0.01) %>%
leaflet(height = "1000px") %>%
addTiles() %>%
setView(lng = 2.866, lat = 46.56, zoom = 6) %>%
addPolygons(weight = 1,
fillColor = topo.colors(13, alpha = NULL),
color = "grey",
highlightOptions = highlightOptions(color = "royalblue3", weight = 2,
bringToFront = TRUE),
label = ~ nom
) %>%
addMarkers(lng = ~ centroid_lng,
lat = ~ centroid_lat,
label = custom_labels,
labelOptions = labelOptions(textsize = "12px"),
icon = radar_icon)
# cartes annexes : changer le centre géographique de chaque carte
# 'height' est identique (200px)
reunion_map <- france_reg %>%
st_simplify(preserveTopology = TRUE, dTolerance = 0.01) %>%
leaflet(height = "200px") %>%
addTiles() %>%
setView(lng = as.numeric(france_reg$centroid_lng[france_reg$nom == "La Réunion"]),
lat = as.numeric(france_reg$centroid_lat[france_reg$nom == "La Réunion"]),
zoom = 8) %>%
addPolygons(weight = 1,
fillColor = topo.colors(13, alpha = NULL),
color = "grey",
highlightOptions = highlightOptions(color = "royalblue3", weight = 2,
bringToFront = TRUE),
label = ~ nom
) %>%
addMarkers(lng = ~ centroid_lng,
lat = ~ centroid_lat,
label = custom_labels,
labelOptions = labelOptions(textsize = "12px"),
icon = radar_icon)
martinique_map <- france_reg %>%
st_simplify(preserveTopology = TRUE, dTolerance = 0.01) %>%
leaflet(height = "200px") %>%
addTiles() %>%
setView(lng = as.numeric(france_reg$centroid_lng[france_reg$nom == "Martinique"]),
lat = as.numeric(france_reg$centroid_lat[france_reg$nom == "Martinique"]),
zoom = 8) %>%
addPolygons(weight = 1,
fillColor = topo.colors(13, alpha = NULL),
color = "grey",
highlightOptions = highlightOptions(color = "royalblue3", weight = 2,
bringToFront = TRUE),
label = ~ nom
) %>%
addMarkers(lng = ~ centroid_lng,
lat = ~ centroid_lat,
label = custom_labels,
labelOptions = labelOptions(textsize = "12px"),
icon = radar_icon)
guadeloupe_map <- france_reg %>%
st_simplify(preserveTopology = TRUE, dTolerance = 0.01) %>%
leaflet(height = "200px") %>%
addTiles() %>%
setView(lng = as.numeric(france_reg$centroid_lng[france_reg$nom == "Guadeloupe"]),
lat = as.numeric(france_reg$centroid_lat[france_reg$nom == "Guadeloupe"]),
zoom = 8) %>%
addPolygons(weight = 1,
fillColor = topo.colors(13, alpha = NULL),
color = "grey",
highlightOptions = highlightOptions(color = "royalblue3", weight = 2,
bringToFront = TRUE),
label = ~ nom
) %>%
addMarkers(lng = ~ centroid_lng,
lat = ~ centroid_lat,
label = custom_labels,
labelOptions = labelOptions(textsize = "12px"),
icon = radar_icon)
guyane_map <- france_reg %>%
st_simplify(preserveTopology = TRUE, dTolerance = 0.01) %>%
leaflet(height = "200px") %>%
addTiles() %>%
setView(lng = as.numeric(france_reg$centroid_lng[france_reg$nom == "Guyane"]),
lat = as.numeric(france_reg$centroid_lat[france_reg$nom == "Guyane"]),
zoom = 6) %>%
addPolygons(weight = 1,
fillColor = topo.colors(13, alpha = NULL),
color = "grey",
highlightOptions = highlightOptions(color = "royalblue3", weight = 2,
bringToFront = TRUE),
label = ~ nom
) %>%
addMarkers(lng = ~ centroid_lng,
lat = ~ centroid_lat,
label = custom_labels,
labelOptions = labelOptions(textsize = "12px"),
icon = radar_icon)
mayotte_map <- france_reg %>%
st_simplify(preserveTopology = TRUE, dTolerance = 0.01) %>%
leaflet(height = "200px") %>%
addTiles() %>%
setView(lng = as.numeric(france_reg$centroid_lng[france_reg$nom == "Mayotte"]),
lat = as.numeric(france_reg$centroid_lat[france_reg$nom == "Mayotte"]),
zoom = 8) %>%
addPolygons(weight = 1,
fillColor = topo.colors(13, alpha = NULL),
color = "grey",
highlightOptions = highlightOptions(color = "royalblue3", weight = 2,
bringToFront = TRUE),
label = ~ nom
) %>%
addMarkers(lng = ~ centroid_lng,
lat = ~ centroid_lat,
label = custom_labels,
labelOptions = labelOptions(textsize = "12px"),
icon = radar_icon)
Afficher toutes les cartes.
latticeview(metro_map, reunion_map, martinique_map, guadeloupe_map, mayotte_map, guyane_map)
Autre possibilité, en utilisant htmltools lien stackoverflow
leaflet_grid <-
tagList(tags$table(width = "100%", border = "1px",
tags$tr(
tags$td(reunion_map, width = "30%"), # reduce first column width
tags$td(metro_map, rowspan = 5) # span across the four other maps
),
tags$tr(
tags$td(mayotte_map)
),
tags$tr(
tags$td(martinique_map)
),
tags$tr(
tags$td(guadeloupe_map)
),
tags$tr(
tags$td(guyane_map)
)
)
)
browsable(leaflet_grid)
# clean up
rm(list = ls(pattern = "_map"), leaflet_grid, custom_labels)
Ajouter les centres de chaque département.
france_dep <- france_dep %>%
mutate(centroid_lng = st_coordinates(st_centroid(geometry))[,1],
centroid_lat = st_coordinates(st_centroid(geometry))[,2])
Les données de département comportent une spécificité concernant le département du Rhône : 2 observations sont présentes, “Rhône” et “Métropole de Lyon”.
france_dep %>%
filter(str_detect(string = code_insee, pattern = "69")) %>%
st_set_geometry(NULL) %>%
kable() %>%
kableExtra::kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
| code_insee | nom | nuts3 | wikipedia | surf_km2 | centroid_lng | centroid_lat |
|---|---|---|---|---|---|---|
| 69D | Rhône | NA | fr:Rhône (département) | 2720 | 4.598769 | 45.89231 |
| 69M | Métropole de Lyon | FR716 | fr:Métropole de Lyon | 538 | 4.853864 | 45.76325 |
Ajuster les données.
# extraire la géométrie du département "Rhône"
rhone_geom <- france_dep %>%
filter(str_detect(string = code_insee, pattern = "69")) %>%
st_union() %>%
st_geometry()
# ré-affecer cette géométrie à la ligne du département, et supprimer la ligne de la métropole de Lyon
france_dep$geometry[france_dep$code_insee == "69D"] <- rhone_geom
france_dep <- france_dep %>%
filter(code_insee != "69M") %>%
mutate(code_insee = fct_recode(code_insee, "69" = "69D")) %>%
mutate_if(is.factor, .funs = function(x) fct_drop(x))
france_dep %>%
filter(str_detect(string = code_insee, pattern = "69")) %>%
st_set_geometry(NULL) %>%
kable() %>%
kableExtra::kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
| code_insee | nom | nuts3 | wikipedia | surf_km2 | centroid_lng | centroid_lat |
|---|---|---|---|---|---|---|
| 69 | Rhône | NA | fr:Rhône (département) | 2720 | 4.598769 | 45.89231 |
Carte des départements (sans les DOM) ; le département du Rhône est d’un seul bloc.
custom_labels <- sprintf("<strong>%s</strong><br/>Long : %g ; Lat : %g",
france_dep$nom, france_dep$centroid_lng, france_dep$centroid_lat) %>%
lapply(htmltools::HTML)
# carte avec marqueurs
france_dep %>%
st_simplify(preserveTopology = TRUE, dTolerance = 0.01) %>%
leaflet() %>%
addTiles() %>%
setView(lng = 2.866, lat = 46.56, zoom = 6) %>%
addPolygons(weight = 1,
fillColor = "lightgreen",
color = "grey",
highlightOptions = highlightOptions(color = "royalblue3", weight = 2,
bringToFront = TRUE),
label = ~ nom
) %>%
addMarkers(lng = ~ centroid_lng,
lat = ~ centroid_lat,
label = custom_labels,
labelOptions = labelOptions(textsize = "12px"),
icon = radar_icon)
# clean up
rm(rhone_geom, custom_labels)
Données issues du site data.gouv.fr.
dep <- read_csv(file = "departments.csv")
reg <- read_csv(file = "regions.csv")
dep_reg <- left_join(dep, reg, by = c("region_code" = "code")) %>%
select(code, name.x, name.y) %>%
rename(dept = code,
nom = name.x,
reg = name.y)
rm(dep,reg) # clean up
kable(head(dep_reg, 10)) %>%
kableExtra::kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
| dept | nom | reg |
|---|---|---|
| 01 | Ain | Auvergne-Rhône-Alpes |
| 02 | Aisne | Hauts-de-France |
| 03 | Allier | Auvergne-Rhône-Alpes |
| 04 | Alpes-de-Haute-Provence | Provence-Alpes-Côte d’Azur |
| 05 | Hautes-Alpes | Provence-Alpes-Côte d’Azur |
| 06 | Alpes-Maritimes | Provence-Alpes-Côte d’Azur |
| 07 | Ardèche | Auvergne-Rhône-Alpes |
| 08 | Ardennes | Grand Est |
| 09 | Ariège | Occitanie |
| 10 | Aube | Grand Est |
Données issues du site data.gouv.fr.
# récuparer les URLS des datasets
data_gouv <- "https://www.data.gouv.fr/fr/datasets/radars-automatiques-bilans-annuels-du-nombre-de-flashs/#_"
# extraire les liens des ficheirs csv
urls <- data_gouv %>%
read_html() %>%
html_nodes(css = ".btn-sm") %>%
html_attr(name = "href") %>%
str_subset(pattern = "datasets")
# extraire les n,oms des fichiers csv
data_names <- data_gouv %>%
read_html() %>%
html_nodes(css = ".ellipsis") %>%
html_text()
urls
## [1] "https://www.data.gouv.fr/fr/datasets/r/1beaa1a9-1356-4884-afd9-aee8c4338a35"
## [2] "https://www.data.gouv.fr/fr/datasets/r/406a229e-78df-4a82-90dc-43a02a903c8a"
## [3] "https://www.data.gouv.fr/fr/datasets/r/0328c344-33ef-4b2c-8cab-fd522db6ec86"
## [4] "https://www.data.gouv.fr/fr/datasets/r/e5e1186f-c7b5-420e-b8f3-b7717ac89181"
## [5] "https://www.data.gouv.fr/fr/datasets/r/936217ac-6c22-4712-b94b-ff383682f0bf"
## [6] "https://www.data.gouv.fr/fr/datasets/r/bd226a31-ec21-499f-838a-f59b161a0dd8"
## [7] "https://www.data.gouv.fr/fr/datasets/r/a07699fa-27ab-4acd-99b2-4c4011fa90f4"
## [8] "https://www.data.gouv.fr/fr/datasets/r/3f69dbb9-5e8d-44ed-8c63-c708f5d1eb82"
## [9] "https://www.data.gouv.fr/fr/datasets/r/f809d255-9a68-4491-a18b-f5a1083c5549"
data_names
## [1] "bilan-2017-radars-troncons.csv"
## [2] "bilan-2017-radars-fixes.csv"
## [3] "bilan-2017-radars-discriminants.csv"
## [4] "bilan-2016-radars-troncons.csv"
## [5] "bilan-2016-radars-fixes.csv"
## [6] "bilan-2016-radars-discriminants.csv"
## [7] "bilan-2015-radars-troncons.csv"
## [8] "bilan-2015-radars-fixes.csv"
## [9] "bilan-2015-radars-discriminants.csv"
# télécharger tous les fichiers csv
# 'map' retourne une liste d'objets => renommer chaque objet de la liste avec le nom de fichier associé dans 'data_names'
radars_csv <- map(.x = urls, .f = read_csv) %>%
set_names(nm = data_names)
rm(data_gouv, data_names, urls) # clean up
radars_csv
## $`bilan-2017-radars-troncons.csv`
## # A tibble: 99 x 5
## Département `Date de mise e… `Nom de la voie` `Sens de circul…
## <chr> <chr> <chr> <chr>
## 1 03 24/04/2015 RN79 MONTBEUGNY vers…
## 2 05 25/03/2013 RD 1075 Grenoble vers S…
## 3 05 07/11/2014 RN94 BRIANCON vers G…
## 4 06 24/02/2014 RM6007 EZE vers CAP D …
## 5 07 28/02/2014 RD111 RUOMS vers ALES
## 6 07 01/04/2014 RD534 LAMASTRE vers T…
## 7 07 16/06/2014 RN102 LE TEIL vers AU…
## 8 09 23/05/2014 RN20 TARASCON SUR AR…
## 9 09 07/07/2014 RN20 PAMIERS vers TA…
## 10 13 18/08/2014 RD570 SAINTES MARIES …
## # … with 89 more rows, and 1 more variable: `Nombre de dossiers
## # d'infractions` <int>
##
## $`bilan-2017-radars-fixes.csv`
## # A tibble: 2,036 x 5
## Département `Date de mise e… `Nom de la voie` `Sens de circul…
## <chr> <chr> <chr> <chr>
## 1 01 09/12/2004 RD936 JASSERON VERS B…
## 2 01 20/12/2004 RD1084 MEXIMIEUX VERS …
## 3 01 25/07/2005 RD1083 lyon VERS BOURG…
## 4 01 25/07/2005 RD1075 BOURG EN BRESSE…
## 5 01 13/09/2005 RD936 BOURG EN BRESSE…
## 6 01 27/01/2006 RD1083 BOURG EN BRESSE…
## 7 01 20/03/2006 RD1083 BOURG EN BRESSE…
## 8 01 26/06/2006 A40 LE FAYET VERS M…
## 9 01 10/10/2007 RD936 Trevoux vers Bo…
## 10 01 07/11/2007 RD992 CULOZ VERS BELL…
## # … with 2,026 more rows, and 1 more variable: `Nombre de dossiers
## # d'infractions` <int>
##
## $`bilan-2017-radars-discriminants.csv`
## # A tibble: 407 x 5
## Département `Date de mise e… `Nom de la voie` `Sens de circul…
## <chr> <chr> <chr> <chr>
## 1 01 06/05/2013 RD20 LAGNIEU vers ST…
## 2 01 12/01/2015 RD1075 AMBERIEU EN BUG…
## 3 02 13/03/2014 RN2 LAON vers PARIS
## 4 02 13/03/2014 RN2 PARIS vers LAON
## 5 02 02/06/2016 RN31 SOISSONS vers R…
## 6 03 05/07/2011 RN79 MOULINS vers DO…
## 7 03 05/07/2011 RN79 DOMPIERRE SUR B…
## 8 03 31/10/2011 RN79 MONTMARAULT ver…
## 9 03 29/05/2012 RN79 MOLINET vers DO…
## 10 03 23/09/2016 A71 MONTLUCON vers …
## # … with 397 more rows, and 1 more variable: `Nombre de dossiers
## # d'infractions` <int>
##
## $`bilan-2016-radars-troncons.csv`
## # A tibble: 97 x 5
## Département `Date de mise en se… `Nom voie` `Sens de circulation` Total
## <chr> <chr> <chr> <chr> <int>
## 1 03 24/04/2015 RN79 MONTBEUGNY vers THIEL… 4511
## 2 05 25/03/2013 RD 1075 Grenoble vers Sisteron 1896
## 3 05 07/11/2014 RN94 BRIANCON vers GAP 5714
## 4 06 24/02/2014 RM6007 EZE vers CAP D AIL 16
## 5 07 28/02/2014 RD111 RUOMS vesr ALES 69
## 6 07 01/04/2014 RD534 LAMASTRE vers TOURNON… 4
## 7 07 16/06/2014 RN102 LE TEIL vers AUBENAS 3688
## 8 09 23/05/2014 RN20 TARASCON SUR ARIEGE v… 6711
## 9 09 07/07/2014 RN20 PAMIERS vers TARASCON… 6419
## 10 13 18/08/2014 RD570 SAINTES MARIES DE LA … 4350
## # … with 87 more rows
##
## $`bilan-2016-radars-fixes.csv`
## # A tibble: 2,175 x 5
## Département `Date de mise en se… `Nom voie` `Sens de circulation` Total
## <chr> <chr> <chr> <chr> <dbl>
## 1 01 09/12/2004 RD936 JASSERON VERS BOURG E… 2749
## 2 01 20/12/2004 RD1084 MEXIMIEUX VERS BELIGN… 1805
## 3 01 25/07/2005 RD1083 lyon VERS BOURG EN BR… 9253
## 4 01 20/03/2006 RD1083 BOURG EN BRESSE VERS … 718
## 5 01 27/01/2006 RD1083 BOURG EN BRESSE vers … 3137
## 6 01 13/09/2005 RD936 BOURG EN BRESSE vers … 1919
## 7 01 25/07/2005 RD1075 PONT D AIN VERS BOURG… 465
## 8 01 28/08/2008 RD22 BOURG EN BRESSE vers … 143
## 9 01 28/08/2008 RD884 Bellegarde vers Gex 2030
## 10 01 26/09/2008 RD4 Meximieux vers St And… 257
## # … with 2,165 more rows
##
## $`bilan-2016-radars-discriminants.csv`
## # A tibble: 361 x 5
## Département `Date de mise en se… `Nom voie` `Sens de circulation` Total
## <chr> <chr> <chr> <chr> <dbl>
## 1 01 06/05/2013 RD20 LAGNIEU vers ST VULBAS 1081
## 2 01 12/01/2015 RD1075 AMBERIEU EN BUGEY ver… 2343
## 3 02 13/03/2014 RN2 LAON vers PARIS 4069
## 4 02 13/03/2014 RN2 PARIS vers LAON 3131
## 5 02 02/06/2016 RN31 SOISSONS vers REIMS 782
## 6 03 31/10/2011 RN79 MONTMARAULT vers MOUL… 4106
## 7 03 05/07/2011 RN79 MOULINS vers DOMPIERRE 20152
## 8 03 05/07/2011 RN79 DOMPIERRE SUR BESBRE … 7342
## 9 03 29/05/2012 RN79 MOLINET vers DOMPIERR… 21833
## 10 03 23/09/2016 A71 MONTLUCON vers MONTMA… 1119
## # … with 351 more rows
##
## $`bilan-2015-radars-troncons.csv`
## # A tibble: 96 x 5
## dept `date mise en se… `nom VOIE (*)` `sens circultaio… `Total général`
## <chr> <chr> <chr> <chr> <int>
## 1 03 24/04/2015 RN79 MONTBEUGNY vers … 5631
## 2 05 25/03/2013 RD 1075 Grenoble vers Si… 2967
## 3 05 07/11/2014 RN94 BRIANCON vers GAP 6403
## 4 06 24/02/2014 RM6007 EZE vers CAP D A… 10
## 5 07 28/02/2014 RD111 RUOMS vesr ALES 38
## 6 07 01/04/2014 RD534 LAMASTRE vers TO… 8
## 7 07 16/06/2014 RN102 LE TEIL vers AUB… 8343
## 8 09 23/05/2014 RN20 TARASCON SUR ARI… 3258
## 9 09 07/07/2014 RN20 PAMIERS vers TAR… 6304
## 10 13 18/08/2014 RD570 SAINTES MARIES D… 5336
## # … with 86 more rows
##
## $`bilan-2015-radars-fixes.csv`
## # A tibble: 2,191 x 5
## dept `date mise en se… `nom VOIE (*)` `sens circultaio… `Total général`
## <chr> <chr> <chr> <chr> <dbl>
## 1 01 09/12/2004 RD936 JASSERON VERS BO… 2955
## 2 01 20/12/2004 RD1084 MEXIMIEUX VERS B… 1035
## 3 01 25/07/2005 RD1083 lyon VERS BOURG … 3428
## 4 01 25/07/2005 RD1075 PONT D AIN VERS … 567
## 5 01 13/09/2005 RD936 BOURG EN BRESSE … 336
## 6 01 27/01/2006 RD1083 BOURG EN BRESSE … 390
## 7 01 20/03/2006 RD1083 BOURG EN BRESSE … 895
## 8 01 26/06/2006 A40 LE FAYET VERS MA… 16896
## 9 01 10/10/2007 RD936 Trevoux vers Bou… 151
## 10 01 07/11/2007 RD992 CULOZ VERS BELLEY 2079
## # … with 2,181 more rows
##
## $`bilan-2015-radars-discriminants.csv`
## # A tibble: 238 x 5
## dept `date mise en se… `nom VOIE (*)` `sens circultaio… `Total général`
## <chr> <chr> <chr> <chr> <dbl>
## 1 01 06/05/2013 RD20 LAGNIEU vers ST … 1339
## 2 01 12/01/2015 RD1075 AMBERIEU EN BUGE… 1909
## 3 02 13/03/2014 RN2 LAON vers PARIS 4963
## 4 02 13/03/2014 RN2 PARIS vers LAON 5251
## 5 03 31/10/2011 RN79 MONTMARAULT vers… 17945
## 6 03 05/07/2011 RN79 MOULINS vers DOM… 19198
## 7 03 05/07/2011 RN79 DOMPIERRE SUR BE… 6737
## 8 03 29/05/2012 RN79 MOLINET vers DOM… 26298
## 9 06 25/10/2013 A8 ITALIE vers NICE 101655
## 10 06 16/12/2013 A8 ITALIE vers AIX … 107234
## # … with 228 more rows
Ajouter des colonnes pour identifier les datasets.
# garder uniquement les colonnes intéressantes et renommer
radars_ok <- radars_csv %>%
map(.f = ~ select(.x, c(1, 5))) %>%
map(.f = ~ set_names(x = .x, nm = c("dept", "total"))) %>%
# unifier tous les dataframes, en utilisant un "id" pour les identifier (les noms de liste sont utilisés comme idenfitiant)
bind_rows(., .id = "file") %>%
# extraire le type de radars et l'annee de la colonne "file"
mutate(annee = -parse_number(file),
type = str_extract(string = file, pattern = "\\w+(?=\\.)")) %>%
select(-file)
kable(head(radars_ok, 10)) %>%
kableExtra::kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
| dept | total | annee | type |
|---|---|---|---|
| 03 | 2936 | 2017 | troncons |
| 05 | 1904 | 2017 | troncons |
| 05 | 3279 | 2017 | troncons |
| 06 | 26 | 2017 | troncons |
| 07 | 115 | 2017 | troncons |
| 07 | 1 | 2017 | troncons |
| 07 | 3515 | 2017 | troncons |
| 09 | 6817 | 2017 | troncons |
| 09 | 8750 | 2017 | troncons |
| 13 | 1334 | 2017 | troncons |
# Préparation données
radars_annee <- radars_ok %>%
group_by(annee, type) %>%
summarise(n_radars = n(),
n_infractions = sum(total)) %>%
mutate(perc_radars = n_radars / sum(n_radars),
perc_infracs = n_infractions / sum(n_infractions)) %>%
ungroup()
# données complémentaires pour graphique
graph_annot_1 <- radars_annee %>% count(annee, wt = n_radars)
graph_annot_2 <- radars_annee %>% count(annee, wt = n_infractions)
# theme commun
common_theme <- theme(legend.title = element_text(face = "bold")
, panel.grid = element_blank()
, axis.line.y = element_blank()
, axis.text.y = element_blank()
, axis.ticks.y = element_blank()
, plot.title = element_text(size = 12, face = "bold", hjust = 0.5)
, axis.text.x = element_text(size = 12, margin = margin(t = 4))
, axis.ticks.x = element_blank())
# graphe des radars
p1 <- radars_annee %>%
ggplot(aes(x = as.factor(annee), y = n_radars)) +
# bar chart
geom_col(aes(fill = type)) +
# ajouter les pourcentages de chaque type de radar
geom_label(aes(fill = type, label = scales::percent(perc_radars)),
position = position_stack(vjust = 0.5),
show.legend = FALSE) +
# réduire l'étendue de l'axe 'y'
scale_y_continuous(expand = expand_scale(mult = c(0.02, 0.05))) +
# modifier les couleurs de remplissage
scale_fill_manual(name = "Type de radar", values = c("dodgerblue2", "indianred3", "darkgoldenrod2"),
labels = c("discriminant", "fixe", "tronçon")) +
# ajouter le nombre total de radars (utiliser les données créées précédemment)
geom_text(data = graph_annot_1,
aes(y = n, label = paste(n, "radars")),
size = 4.5, color = "purple", fontface = "bold.italic", nudge_y = 120) +
labs(title = "Nombre de radars automatiques ayant\nrecensé au moins une infraction",
x = "", y = "") +
common_theme +
theme(legend.position = "bottom")
# graphe des infractions : même principe que graphe précédent
p2 <- radars_annee %>%
ggplot(aes(x = as.factor(annee), y = n_infractions)) +
geom_col(aes(fill = type)) +
geom_label(aes(fill = type, label = scales::percent(perc_infracs)),
position = position_stack(vjust = 0.5)) +
scale_y_continuous(expand = expand_scale(mult = c(0.02, 0.05))) +
scale_fill_manual(name = "Type de radar", values = c("dodgerblue2", "indianred3", "darkgoldenrod2"),
labels = c("discriminant", "fixe", "tronçon")) +
geom_text(data = graph_annot_2,
aes(y = n, label = format(n, big.mark = " ")),
size = 4.5, color = "purple", fontface = "bold.italic", nudge_y = 11e+05) +
geom_text(data = graph_annot_2,
aes(y = n, label = "infractions"),
size = 4.5, color = "purple", fontface = "bold.italic", nudge_y = 4.8e+05) +
labs(title = "Nombre d'infractions totales recencées\npar les radars automatiques",
x = "", y = "") +
common_theme +
theme(legend.position = "none")
# extraire la légende du 1er graphe
my_legend <- ggplotGrob(p1)$grobs[[15]]
# combiner tous les graphes :
# modifier le comportement de 'grid.arrange' pour faire apparaître une légende commune aux 2 graphes
gridExtra::grid.arrange(p1 + theme(legend.position = "none"),
p2,
my_legend,
# define layout_matrix; this is a matrix with values representing the plot number and the space in the layout that the plot will occupy
layout_matrix = matrix(c(1, 3, 2, 3), ncol = 2),
# Adjust the height of each segment :
heights = grid::unit.c(unit(1, "npc") - sum(my_legend$heights), sum(my_legend$heights))
)
# clean up
rm(graph_annot_1, graph_annot_2, common_theme, p1, p2, my_legend, radars_annee)
# Nombre de radars par département, année et type
radars_ok %>%
count(dept, annee, type) %>%
head(10) %>%
kable() %>%
kableExtra::kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
| dept | annee | type | n |
|---|---|---|---|
| 01 | 2015 | discriminants | 2 |
| 01 | 2015 | fixes | 26 |
| 01 | 2016 | discriminants | 2 |
| 01 | 2016 | fixes | 26 |
| 01 | 2017 | discriminants | 2 |
| 01 | 2017 | fixes | 26 |
| 02 | 2015 | discriminants | 2 |
| 02 | 2015 | fixes | 27 |
| 02 | 2016 | discriminants | 3 |
| 02 | 2016 | fixes | 27 |
On peut voir que certains départements n’ont pas tous les types de radar (le département “01” n’a pas de radar tronçon par exemple pour les années 2015, 2016 et 2017).
Pour une meilleure visualisation, on peut ajouter ces radars “manquants”, en y attribuant la valeur “0”.
Astuce : créer un dataframe avec toutes les valeurs possibles département/année/type de radar ; puis effectuer une jointure avec la dataframe des radars (et remplacer les valeurs manquantes créées par la valeur 0).
# toutes les valeurs croisées possibles entre départements, années, types de radar
cross_values <- expand.grid(dept = unique(radars_ok$dept),
annee = 2015:2017,
type = c("fixes", "discriminants", "troncons"))
radars_all <- radars_ok %>%
# ajouter des colonnes : nombre de radars par département, anneée et type / nombre d'infractions par département, anneée et type
group_by(dept, annee, type) %>%
summarise(n_radars = n(),
n_infractions = sum(total)) %>%
ungroup() %>%
full_join(cross_values, by = c("dept", "type", "annee")) %>%
# remplacer les NA par 0
mutate(n_radars = replace_na(n_radars, replace = 0),
n_infractions = replace_na(n_infractions, replace = 0))
arrange(radars_all, dept, annee, type) %>%
head(12) %>%
kable() %>%
kableExtra::kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
| dept | annee | type | n_radars | n_infractions |
|---|---|---|---|---|
| 01 | 2015 | discriminants | 2 | 3248 |
| 01 | 2015 | fixes | 26 | 59225 |
| 01 | 2015 | troncons | 0 | 0 |
| 01 | 2016 | discriminants | 2 | 3424 |
| 01 | 2016 | fixes | 26 | 90685 |
| 01 | 2016 | troncons | 0 | 0 |
| 01 | 2017 | discriminants | 2 | 2295 |
| 01 | 2017 | fixes | 26 | 109128 |
| 01 | 2017 | troncons | 0 | 0 |
| 02 | 2015 | discriminants | 2 | 10214 |
| 02 | 2015 | fixes | 27 | 41639 |
| 02 | 2015 | troncons | 0 | 0 |
Ajouter la somme totale de radars et d’infractions par département.
# Ajouter le total du nombre de radars et d'infractions, par département et par année
radars_all <- radars_all %>%
add_count(dept, annee, wt = n_radars, name = "total_radars") %>%
add_count(dept, annee, wt = n_infractions, name = "total_infractions") %>%
arrange(dept, type, annee)
kable(head(radars_all, 10)) %>%
kableExtra::kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
| dept | annee | type | n_radars | n_infractions | total_radars | total_infractions |
|---|---|---|---|---|---|---|
| 01 | 2015 | discriminants | 2 | 3248 | 28 | 62473 |
| 01 | 2016 | discriminants | 2 | 3424 | 28 | 94109 |
| 01 | 2017 | discriminants | 2 | 2295 | 28 | 111423 |
| 01 | 2015 | fixes | 26 | 59225 | 28 | 62473 |
| 01 | 2016 | fixes | 26 | 90685 | 28 | 94109 |
| 01 | 2017 | fixes | 26 | 109128 | 28 | 111423 |
| 01 | 2015 | troncons | 0 | 0 | 28 | 62473 |
| 01 | 2016 | troncons | 0 | 0 | 28 | 94109 |
| 01 | 2017 | troncons | 0 | 0 | 28 | 111423 |
| 02 | 2015 | discriminants | 2 | 10214 | 29 | 51853 |
Graphe interactif du nombre de radars par département (uniquement 2017 pour simplifier le process).
radars_all %>%
filter(annee == 2017) %>%
group_by(dept) %>%
# créer des groupes de nombre de radars, pour visualisation
mutate(groupe_radars = case_when(total_radars <= 20 ~ "< 20",
total_radars > 40 ~ "> 40",
TRUE ~ "< 40"),
# ajouter une colonne texte pour affichage sur le graphe)
text = paste("- ", n_radars[2], "fixes", "<br>",
"- ", n_radars[1], "discriminants", "<br>",
"- ", n_radars[3], "tronçons")) %>%
ungroup() %>%
# récupérer le nom des départements
left_join(dep_reg, by = "dept") %>%
plot_ly(x = ~ dept, y = ~ total_radars) %>%
add_markers(color = ~ groupe_radars,
colors = c("chartreuse3", "orange", "firebrick3"),
marker = list(size = 10,
line = list(color = "darkred", width = 2)),
hoverinfo = "text",
text = ~ paste("<b>", nom, "</b>", "<br>",
total_radars, " radars au total :", "<br>",
text)) %>%
layout(xaxis = list(title = "", showgrid = FALSE, showticklabels = FALSE),
yaxis = list(title = "Nombre de radars", zeroline = TRUE, range = c(0, 65)),
title = paste("<b>", "Nombre de radars par département (2017)", "</b>"),
showlegend = FALSE,
# ajouter 2 lignes de séparation
shapes = list(
list(type = 'line', x0 = -5, x1 = 110, y0 = 20, y1 = 20,
line = list(dash = 'dot', width = 1, color = "green")),
list(type = 'line', x0 = -5, x1 = 110, y0 = 40, y1 = 40,
line = list(dash = 'dot', width = 1, color = "orange")))
)
Graphe interactif du nombre d’infractions par département (2017)
radars_all %>%
filter(annee == 2017) %>%
group_by(dept) %>%
# créer des groupes de nombre de radars, pour visualisation
mutate(groupe_infrac = case_when(total_infractions <= 200000 ~ "< 200000",
total_infractions > 400000 ~ "> 400000",
TRUE ~ "< 400000"),
# ajouter une colonne texte pour affichage sur le graphe)
text = paste("- ", format(n_infractions[2], big.mark = " "), "par radars fixes", "<br>",
"- ", format(n_infractions[1], big.mark = " "), "par radars discriminants", "<br>",
"- ", format(n_infractions[3], big.mark = " "), "par radars tronçons")) %>%
ungroup() %>%
# récupérer le nom des départements
left_join(dep_reg, by = "dept") %>%
plot_ly(x = ~ dept, y = ~ total_infractions) %>%
add_markers(color = ~ groupe_infrac,
colors = c("chartreuse3", "orange", "firebrick3"),
marker = list(size = 10,
line = list(color = "darkred", width = 2)),
hoverinfo = "text",
text = ~ paste("<b>", nom, "</b>", "<br>",
format(total_infractions, big.mark = " "), " infractions au total :", "<br>",
text)
) %>%
layout(xaxis = list(title = "", showgrid = FALSE, showticklabels = FALSE),
yaxis = list(title = "Nombre d'infractions", zeroline = TRUE, range = c(0, 750000)),
title = paste("<b>", "Nombre d'infractions par département (2017)", "</b>"),
showlegend = FALSE,
# ajouter 2 lignes de séparation
shapes = list(
list(type = 'line', x0 = -5, x1 = 110, y0 = 200000, y1 = 200000,
line = list(dash = 'dot', width = 1, color = "green")),
list(type = 'line', x0 = -5, x1 = 110, y0 = 400000, y1 = 400000,
line = list(dash = 'dot', width = 1, color = "orange")))
)
Les département où il y a le plus de radars ne sont pas forcément ceux où il y a le plus d’infractions.
radars_all %>%
filter(annee == 2017) %>%
# group_by(dept)%>%
# mutate(ratio = sum(n_infractions) / sum(n_radars)) %>%
# ungroup() %>%
left_join(dep_reg, by = "dept") %>%
group_by(type) %>%
do(plot = plot_ly(data = ., x = ~ jitter(n_radars), y = ~ n_infractions,
transforms = list(
list(type = 'filter',
target = ~ n_radars,
operation = '!=',
value = 0)),
hoverinfo = "text",
text = ~ paste("<b>", nom, "</b>", "<br>",
format(n_infractions, big.mark = " "), "infractions", "<br>",
n_radars, "radars")
) %>%
add_markers(marker = list(size = 15, opacity = 0.5)) %>%
layout(yaxis = list(range = c(0, ~ max(n_infractions) * 1.05)),
xaxis = list(title = "trevfdop",
range = c(0, ~ max(n_radars) * 1.1)),
showlegend = FALSE)) %>%
subplot(shareX = FALSE) %>%
layout(annotations = list(list(text = "<b>Radars discriminants</b>",
font = list(size = 13),
xref = "paper",
yref = "paper",
xanchor = "center",
yanchor = "bottom",
x = 0.18,
y = -0.05,
showarrow = FALSE),
list(text = "<b>Radars fixes</b>",
font = list(size = 13),
xref = "paper",
yref = "paper",
xanchor = "center",
yanchor = "bottom",
x = 0.5,
y = -0.05,
showarrow = FALSE),
list(text = "<b>Radars tronçons</b>",
font = list(size = 13),
xref = "paper",
yref = "paper",
xanchor = "center",
yanchor = "bottom",
x = 0.82,
y = -0.05,
showarrow = FALSE)),
# xaxis = list(title = "Nombre de radars"),
yaxis = list(title = "<b>Nombre d'infractions</b>"),
title = "<b>Nombre d'infractions / Nombre de radars par département (2017)</b>"
)
Carte interactive du ratio entre le nombre d’infractions et le nombre de radars dans chaque département (pour l’année 2017)
# grouper les départements par nombre total de radars
radars_all_2017 <- radars_all %>%
filter(annee == 2017) %>%
mutate(ratio = total_infractions / total_radars,
ratio_grp = case_when(ratio < 2000 ~ "< 2 000",
between(ratio, 2000, 4000) ~ "< 4 000",
between(ratio, 4000, 6000) ~ "< 6 000",
between(ratio, 6000, 8000) ~ "< 8 000",
between(ratio, 6000, 10000) ~ "< 10 000",
TRUE ~ "> 10 000"),
ratio_grp = fct_relevel(ratio_grp, "< 2 000", "< 4 000", "< 6 000", "< 8 000", "< 10 000", "> 10 000"))
# créer une palette de couleur correspondant aux groupes de radars créés précedemment
radars_group_col <- colorFactor(palette = viridis_pal(option = "C")(6), domain = unique(radars_all_2017$ratio_grp), reverse = TRUE)
# carte interactive nombre de radars
france_dep %>%
filter(nom != "Mayotte") %>% # pas de données pour Mayotte
st_simplify(preserveTopology = TRUE, dTolerance = 0.01) %>%
left_join(radars_all_2017, by = c("code_insee" = "dept"))%>%
leaflet() %>%
addTiles() %>%
setView(lng = 2.866, lat = 46.56, zoom = 6) %>%
addPolygons(weight = 0.1,
fillColor = ~ radars_group_col(ratio_grp),
col = "grey80",
opacity = 0.7,
highlightOptions = highlightOptions(weight = 2, bringToFront = TRUE),
label = ~ nom
) %>%
addMarkers(lng = ~ centroid_lng,
lat = ~ centroid_lat,
popup = ~ paste("<b>", nom, "</b>", "<br>",
total_radars, " radars au total", "<br>",
format(total_infractions, big.mark = " "), " infractions au total", "<br>"),
icon = radar_icon) %>%
addLegend(position = "topright",
pal = radars_group_col,
values = ~ ratio_grp,
title = "Ratio Nombre d'infractions / <br> Nombre total de radars <br> par département (2017)",
opacity = 0.7
)
Fonction permettant de créer une carte des départements (applicable à la métropole et aux DOM).
create_dep_map <- function(height, longitude, latitude, zoom) {
return(france_dep %>%
filter(nom != "Mayotte") %>% # pas de données pour Mayotte
st_simplify(preserveTopology = TRUE, dTolerance = 0.01) %>%
left_join(radars_all_2017, by = c("code_insee" = "dept"))%>%
leaflet(height = height) %>%
addTiles() %>%
setView(lng = longitude, lat = latitude, zoom = zoom) %>%
addPolygons(weight = 0.1,
fillColor = ~ radars_group_col(ratio_grp),
color = "grey80",
opacity = 0.7,
highlightOptions = highlightOptions(weight = 2, bringToFront = TRUE),
label = ~ nom
) %>%
addMarkers(lng = ~ centroid_lng,
lat = ~ centroid_lat,
popup = ~ paste("<b>", nom, "</b>", "<br>",
total_radars, " radars au total", "<br>",
format(total_infractions, big.mark = " "), " infractions au total", "<br>"),
icon = radar_icon)
)
}
Créer les différentes cartes (métropole et DOM) et les afficher.
metro_map <- create_dep_map(height = "800px",
longitude = 2.966,
latitude = 46.86,
zoom = 6) %>%
addLegend(position = "topright",
pal = radars_group_col,
values = ~ ratio_grp,
title = "Ratio Nombre d'infractions / <br> Nombre total de radars <br> par département (2017)",
opacity = 0.7
)
reunion_map <- create_dep_map(height = "200px",
longitude = france_dep$centroid_lng[france_dep$nom == "La Réunion"],
latitude = france_dep$centroid_lat[france_dep$nom == "La Réunion"],
zoom = 8)
martinique_map <- create_dep_map(height = "200px",
longitude = france_dep$centroid_lng[france_dep$nom == "Martinique"],
latitude = france_dep$centroid_lat[france_dep$nom == "Martinique"],
zoom = 8)
guadeloupe_map <- create_dep_map(height = "200px",
longitude = france_dep$centroid_lng[france_dep$nom == "Guadeloupe"],
latitude = france_dep$centroid_lat[france_dep$nom == "Guadeloupe"],
zoom = 8)
guyane_map <- create_dep_map(height = "200px",
longitude = france_dep$centroid_lng[france_dep$nom == "Guyane"],
latitude = france_dep$centroid_lat[france_dep$nom == "Guyane"],
zoom = 6)
leaflet_grid <-
tagList(tags$table(width = "100%", border = "1px",
tags$tr(
tags$td(reunion_map, width = "30%"), # reduce first column width
tags$td(metro_map, rowspan = 4) # span across the four other maps
),
tags$tr(
tags$td(martinique_map)
),
tags$tr(
tags$td(guadeloupe_map)
),
tags$tr(
tags$td(guyane_map)
)
)
)
browsable(leaflet_grid)
radars_regions <- radars_all %>%
left_join(dep_reg, by = "dept") %>%
select(-total_infractions, -total_radars, -dept, -nom) %>%
add_count(reg, annee, type, wt = n_radars, name = "n_radars") %>%
add_count(reg, annee, type, wt = n_infractions, name = "n_infractions") %>%
distinct() %>%
mutate(annee = as.factor(annee),
type = as.factor(type),
reg = as.factor(reg))
kable(head(radars_regions, 10)) %>%
kableExtra::kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
| annee | type | n_radars | n_infractions | reg |
|---|---|---|---|---|
| 2015 | discriminants | 26 | 525966 | Auvergne-Rhône-Alpes |
| 2016 | discriminants | 43 | 434462 | Auvergne-Rhône-Alpes |
| 2017 | discriminants | 45 | 516670 | Auvergne-Rhône-Alpes |
| 2015 | fixes | 272 | 1235147 | Auvergne-Rhône-Alpes |
| 2016 | fixes | 273 | 1904326 | Auvergne-Rhône-Alpes |
| 2017 | fixes | 253 | 1812064 | Auvergne-Rhône-Alpes |
| 2015 | troncons | 11 | 78171 | Auvergne-Rhône-Alpes |
| 2016 | troncons | 13 | 52796 | Auvergne-Rhône-Alpes |
| 2017 | troncons | 13 | 46880 | Auvergne-Rhône-Alpes |
| 2015 | discriminants | 22 | 247044 | Hauts-de-France |
Nombre d’infractions par nombre de radars par région
# calculer la moyenne du ratio (total infractions / total radars) par année
radars_regions_moyenne <- radars_regions %>%
group_by(annee) %>%
summarise(moy = sum(n_infractions) / sum(n_radars))
# graphique
radars_regions %>%
group_by(reg, annee) %>%
summarise(total_radars = sum(n_radars),
total_infractions = sum(n_infractions)) %>%
mutate(ratio = total_infractions / total_radars) %>%
ungroup() %>%
group_by(annee) %>%
ggplot(aes(x = fct_reorder(reg, ratio), y = ratio, fill = annee)) +
geom_col(width = 0.6, position = position_dodge(width = 0.6), alpha = 0.8) +
scale_fill_brewer(palette = "Dark2", name = "Année") +
scale_y_continuous(labels = scales::number(x = seq(0, 15000, 5000), big.mark = " "),
expand = expand_scale(mult = c(0, 0.05))) +
geom_hline(data = radars_regions_moyenne, aes(yintercept = moy, col = annee),
linetype = c("dashed", "solid", "dashed"), size = 0.8, alpha = 0.8,
show.legend = FALSE) +
geom_text(data = radars_regions_moyenne,
aes(x = c(1.5, 2.5, 3.5), y = c(5000, 7000, 7000), label = round(moy), col = annee),
show.legend = FALSE) +
scale_color_brewer(palette = "Dark2") +
coord_flip() +
annotate(geom = "text", x = 1.2, y = 6500, label = "En pointillé : Moyenne Nationale ", fontface = "italic", hjust = 0) +
labs(title = "PACA et Ile-de-France, régions sur-flashées ",
x = "", y = "Ratio : Nombre total d'infractions / Nombre de radars") +
theme(legend.position = c(0.95, 0.1),
legend.justification = c("right", "bottom"),
axis.ticks.y = element_blank(),
axis.text.y = element_text(face = "italic", size = 12),
axis.title.x = element_text(face = "bold", size = 12, margin = margin(t = 5, b = 5)),
plot.title = element_text(face = "bold", size = 16, hjust = 0.4, margin = margin(t = 5, b = 15)),
panel.grid.major.y = element_blank())
Transformer les données en format “wide” : il est préférable (à mon avis) de transformer les données de radars_all en “wide dataframe”, afin de pouvoir joindre plus facilement ces données aux données géographiques.
(les données géographiques ont une seule ligne par département ; les données sur les radars ont 9 lignes par département => en transformant en “wide dataframe”, les données radars n’auront plus qu’une seule ligne par département => plus facile )
# préparattion données : uniquement pour l'année 2017 pour simplifier le process
radars_regions_wide <- radars_regions %>%
filter(annee == 2017) %>%
gather(variable, value, -c(annee, type, reg)) %>%
unite(col = type, type, variable) %>%
spread(key = type, value = value) %>%
mutate(ratio = (discriminants_n_infractions + fixes_n_infractions + troncons_n_infractions) /
(discriminants_n_radars + fixes_n_radars + troncons_n_radars),
ratio_grp = case_when(
ratio < 4600 ~ "< 4 600",
between(ratio, 4600, 5700) ~ "4600 - 5700",
between(ratio, 5700, 9100) ~ "5700 - 9100",
TRUE ~ "> 9100"),
ratio_grp = fct_relevel(ratio_grp, "< 4 600", "4600 - 5700", "5700 - 9100", "> 9100"))
kable(head(radars_regions_wide, 10)) %>%
kableExtra::kable_styling(bootstrap_options = "striped", full_width = F, position = "left") %>%
kableExtra::scroll_box(width = "800px")
| annee | reg | discriminants_n_infractions | discriminants_n_radars | fixes_n_infractions | fixes_n_radars | troncons_n_infractions | troncons_n_radars | ratio | ratio_grp |
|---|---|---|---|---|---|---|---|---|---|
| 2017 | Auvergne-Rhône-Alpes | 516670 | 45 | 1812064 | 253 | 46880 | 13 | 7638.630 | 5700 - 9100 |
| 2017 | Bourgogne-Franche-Comté | 143172 | 27 | 584916 | 138 | 49346 | 12 | 4392.282 | < 4 600 |
| 2017 | Bretagne | 105590 | 19 | 428139 | 94 | 18421 | 3 | 4759.914 | 4600 - 5700 |
| 2017 | Centre-Val de Loire | 231911 | 35 | 424429 | 128 | 12087 | 5 | 3978.732 | < 4 600 |
| 2017 | Corse | 0 | 0 | 162719 | 27 | 0 | 0 | 6026.630 | 5700 - 9100 |
| 2017 | Grand Est | 318299 | 47 | 1068207 | 189 | 16250 | 3 | 5869.272 | 5700 - 9100 |
| 2017 | Guadeloupe | 0 | 0 | 79331 | 20 | 0 | 0 | 3966.550 | < 4 600 |
| 2017 | Guyane | 0 | 0 | 28104 | 8 | 0 | 0 | 3513.000 | < 4 600 |
| 2017 | Hauts-de-France | 381936 | 39 | 692343 | 119 | 14844 | 7 | 6600.745 | 5700 - 9100 |
| 2017 | Île-de-France | 177950 | 27 | 2869571 | 218 | 85068 | 7 | 12430.909 | > 9100 |
Cartographie de ces données par région.
# palette de couleurs
pal <- colorFactor(palette = viridis_pal(option = "C")(4), domain = radars_regions_wide$ratio_grp, reverse = TRUE)
#previewColors(pal, radars_regions_wide$ratio_grp)
# carte
france_reg %>%
filter(nom != "Mayotte") %>%
st_simplify(preserveTopology = TRUE, dTolerance = 0.01) %>%
left_join(radars_regions_wide, by = c("nom" = "reg")) %>%
leaflet() %>%
addTiles() %>%
setView(lng = 2.866, lat = 46.56, zoom = 6) %>%
addPolygons(weight = 1,
fillColor = ~ pal(ratio_grp),
fillOpacity = 0.7,
color = "grey",
highlightOptions = highlightOptions(color = "royalblue3", weight = 2,
bringToFront = TRUE)
) %>%
addMarkers(lng = ~ centroid_lng,
lat = ~ centroid_lat,
popup = ~ paste0("<b>", nom, "</b>", "<br>",
"Infractions par Radars fixes : ", format(fixes_n_infractions, big.mark = " "), "<br>",
"Infractions par Radars discriminants : ", format(discriminants_n_infractions, big.mark = " "), "<br>",
"Infractions par Radars tronçons : ", format(troncons_n_infractions, big.mark = " "), "<br>",
"<br>",
"Nombre de Radars fixes : ", format(fixes_n_radars, big.mark = " "), "<br>",
"Nombre de Radars discriminants : ", format(discriminants_n_radars, big.mark = " "), "<br>",
"Nombre de Radars tronçons : ", format(troncons_n_radars, big.mark = " "), "<br>",
"<br>",
"Nombre d'infractions <br> par nombre de radars : ", "<b>", round(ratio, 0), "</b>"),
icon = radar_icon) %>%
addLegend(position = "topright",
pal = pal,
values = ~ ratio_grp,
title = "Nombre d'infractions <br> par nombre de radars <br> par région (2017) : ",
opacity = 0.7)
# clean up
rm(radars_regions, radars_regions_moyenne, radars_regions_wide, pal, cross_values)
# Top 10 radars
radars_top10 <- radars_ok %>%
group_by(annee) %>%
top_n(n = 10, wt = total) %>%
ungroup() %>%
mutate_at(.vars = c("dept", "annee", "type"), .funs = as.factor)
kable(head(radars_top10, 10)) %>%
kableExtra::kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
| dept | total | annee | type |
|---|---|---|---|
| 21 | 93477 | 2017 | fixes |
| 54 | 120991 | 2017 | fixes |
| 62 | 102302 | 2017 | fixes |
| 69 | 76220 | 2017 | fixes |
| 74 | 125074 | 2017 | fixes |
| 75 | 87457 | 2017 | fixes |
| 83 | 94013 | 2017 | fixes |
| 91 | 105134 | 2017 | fixes |
| 91 | 98006 | 2017 | fixes |
| 74 | 81699 | 2017 | discriminants |
Par défaut, ggplot groupe les variables catégorielles et additionne les totaux, ce qui n’est pas le but du graphe ici.
radars_top10 %>%
ggplot(aes(x = dept, y = total, col = type)) +
geom_col() +
facet_wrap(~ annee)
# amélioration (?) en utilisant "dodge" position
radars_top10 %>%
ggplot(aes(x = fct_reorder(dept, total, .desc = TRUE, .fun = max), y = total, fill = type, group = annee)) +
geom_col(position = position_dodge2(preserve = "single"), width = 0.9) +
facet_wrap(~ annee, scales = "free_x")
Retravailler les données : ajouter un idenfiant unique pour chaque ligne, qui sera considéré comme une variable catégorielle.
Celle-ci servira ensuite d’axe X, permettant ainsi de dessiner toutes les observations.
radars_top10 <- radars_top10 %>%
arrange(annee, -total) %>%
# nombre de fois qu'apparaît un département, par année
add_count(annee, dept, name = "uniq") %>%
# ajouter un identifiant
mutate(id = 1:n(),
uniq = as.factor(uniq))
# graphe
radars_top10 %>%
# utiliser l'identifient unique pour l'axe X
ggplot(aes(x = id, y = total)) +
geom_col(aes(fill = type)) +
# changer les couleurs de remplissage
scale_fill_manual(name = "Type de radar", values = c("dodgerblue2", "indianred3"),
labels = str_sub(string = levels(radars_top10$type), start = 1, end = -2)) +
# ajouter les départements associés à chaque barre + les départements identiques auront la même couleur
geom_label(aes(y = 0, label = dept, col = uniq),
nudge_y = -6000, show.legend = FALSE) +
# changer l'étendue de l'axe Y pour intégrer les 'labels' en bas de chqaue barre
scale_y_continuous(expand = expand_scale(add = c(8000, 5000))) +
# modifier les couleurs d'affichage des département
scale_color_manual(values = c("purple", "darkolivegreen4")) +
scale_x_discrete(expand = expand_scale(mult = c(0.02, 0.02))) +
labs(title = "Top 10 des radars ayant recensés le plus d'infractions, \n et les départements associés",
x = "Département", y = "Nombre d'infractions") +
facet_wrap(~ annee, scales = "free_x") +
theme(axis.text.x = element_blank()
, axis.ticks.x = element_blank()
, legend.position = "bottom"
, legend.title = element_text(face = "bold")
, plot.title = element_text(face = "bold", hjust = 0.5, size= 18)
)
Même chose, avec les radars ayant le moins flashé.
# préparation données
radars_bottom10 <- radars_ok %>%
group_by(annee) %>%
top_n(n = 10, wt = -total) %>%
ungroup() %>%
mutate_at(.vars = c("dept", "annee", "type"), .funs = as.factor)
radars_bottom10 <- radars_bottom10 %>%
arrange(annee, total) %>%
# nombre de fois qu'apparaît un département, par année
add_count(annee, dept, name = "uniq") %>%
# ajouter un identifiant
mutate(id = 1:n(),
uniq = as.factor(uniq))
# graphe
radars_bottom10 %>%
# utiliser l'identifient unique pour l'axe X
ggplot(aes(x = id, y = total)) +
geom_col(aes(fill = type)) +
# changer les couleurs de remplissage
scale_fill_manual(name = "Type de radar", values = c("dodgerblue2", "indianred3", "darkgoldenrod2"),
labels = str_sub(string = levels(radars_bottom10$type), start = 1, end = -2)) +
# ajouter les départements associés à chaque barre + les départements identiques auront la même couleur
geom_label(aes(y = 0, label = dept, col = uniq),
nudge_y = -0.5, show.legend = FALSE) +
# modifier les couleurs d'affichage des département
scale_color_manual(values = c("purple", "darkolivegreen4", "darkorange3")) +
scale_x_discrete(expand = expand_scale(mult = c(0.02, 0.02))) +
labs(title = "Top 10 des radars ayant recensés le moins d'infractions, \n et les départements associés",
x = "Département", y = "Nombre d'infractions") +
facet_wrap(~ annee, scales = "free_x") +
theme(axis.text.x = element_blank()
, axis.ticks.x = element_blank()
, legend.position = "bottom"
, legend.title = element_text(face = "bold")
, plot.title = element_text(face = "bold", hjust = 0.5, size= 18)
)
# clean up
rm(radars_bottom10, radars_top10)
radars_install <- radars_csv %>%
map(.f = ~ select(.x, c(2, 5))) %>%
map(.f = ~ set_names(x = .x, nm = c("date_install", "total"))) %>%
# unifier tous les dataframes, en utilisant un "id" pour les identifier (les noms de liste sont utilisés comme idenfitiant)
bind_rows(., .id = "file") %>%
# extraire le type de radars et l'annee de la colonne "file"
mutate(annee = -parse_number(file),
type = str_extract(string = file, pattern = "\\w+(?=\\.)")) %>%
select(-file)
kable(head(radars_install, 10)) %>%
kableExtra::kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
| date_install | total | annee | type |
|---|---|---|---|
| 24/04/2015 | 2936 | 2017 | troncons |
| 25/03/2013 | 1904 | 2017 | troncons |
| 07/11/2014 | 3279 | 2017 | troncons |
| 24/02/2014 | 26 | 2017 | troncons |
| 28/02/2014 | 115 | 2017 | troncons |
| 01/04/2014 | 1 | 2017 | troncons |
| 16/06/2014 | 3515 | 2017 | troncons |
| 23/05/2014 | 6817 | 2017 | troncons |
| 07/07/2014 | 8750 | 2017 | troncons |
| 18/08/2014 | 1334 | 2017 | troncons |
Garder uniquement les données de 2017 (pour avoir les radars les plus récents) et transformer la colonne date_install en format Date.
radars_install <- radars_install %>%
filter(annee == 2017) %>%
mutate(date_install = dmy(date_install),
annee_install = year(date_install)) %>%
group_by(annee_install) %>%
summarise(n_radars = n(), n_infractions = sum(total),
ratio = n_infractions / n_radars) %>%
ungroup()
kable(head(radars_install, 10)) %>%
kableExtra::kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
| annee_install | n_radars | n_infractions | ratio |
|---|---|---|---|
| 2003 | 35 | 413579 | 11816.543 |
| 2004 | 70 | 647100 | 9244.286 |
| 2005 | 377 | 1923927 | 5103.255 |
| 2006 | 159 | 1186277 | 7460.862 |
| 2007 | 241 | 1602353 | 6648.768 |
| 2008 | 312 | 1633712 | 5236.256 |
| 2009 | 247 | 1194356 | 4835.449 |
| 2010 | 95 | 570229 | 6002.411 |
| 2011 | 245 | 1322833 | 5399.318 |
| 2012 | 240 | 1413941 | 5891.421 |
radars_install %>%
plot_ly(x = ~ annee_install, y = ~ n_radars) %>%
add_markers(size = ~ ratio,
color = ~ ratio,
colors = c("green2", "darkred"),
hoverinfo = "text",
text = ~ paste0("Nombre d'infractions<br>relevées en 2017 :<br>",
"<b>", format(n_infractions, big.mark = " "), "</b>"),
marker = list(sizemode = "diameter", opacity = 0.8)
) %>%
layout(xaxis = list(title = "Année d'installation"),
yaxis = list(title = "Nombre de radars installés"),
title = "<b>Les anciens radars ont toujours un haut ratio d'infractions</b>",
titlefont = list(size = 20),
margin = list(t = 80),
annotations = list(xref = "paper",
yref = "paper",
x= 1,
y= 0.95,
xanchor = "right",
text = "<i>ratio = rapport entre le nombre<br>d'infractions et le nombre<br>de radars</i>",
font= list(size = 14),
showarrow = FALSE)
)