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

Préparation

Récupérer les données géographiques de la France (départements et régions)

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)

Tableau correspondance département-région

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 radars

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

Visualisation

Proportion radars et infractions par année

# 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 et infractions par département

# 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)

Nombre de radars et d’infractions par région

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)

Dans quels départements se trouvent les radars qui flashent le plus ?

# 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)

Nombre d’infractions par ancienneté d’installation

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)
         )