knitr::opts_chunk$set( fig.dpi = 96, fig.height = 3.5, fig.width = 7, collapse = TRUE, comment = "#>" )
library(tidyverse) library(dplyr) library(reshape2) library(ggmap) # Pour la cartographie library(raster) library(cartography) library(leaflet) library(lubridate) library(ACC)
summary(accidents[,c(12,13)])
2622 lignes n'ont pas de coordonnées gps renseignées.
class(accidents$lat) class(accidents$long)
Nous observons que les variables lat et long sont au format caractères. Nous commençons par les recoder afin qu'elles soient au format de degrés décimaux (format classique coordonnées gps).
accidents$lat <- type.convert(accidents$lat, dec=".") class(accidents$lat) accidents$long <- type.convert(accidents$long, dec=".") class(accidents$long) accidents$lat <- as.numeric(accidents$lat) accidents$long <- as.numeric(accidents$long)
accidents_gps <- accidents %>% mutate(lat = case_when( abs(lat) > 100 ~ lat/100000, TRUE ~ lat), long = case_when( abs(long) > 100 ~ long/100000, TRUE ~ long) )
summary(accidents_gps[,c(12,13)])
On crée un dataframe contenant le nombre d'accidents par coordonnées gps
accidents_gps_group <- accidents_gps %>% dplyr::select(Num_Acc, dep, date_acc, lat, long) %>% dplyr::group_by(Num_Acc, lat, long, date_acc) %>% summarise(n = n()) %>% dplyr::select(Num_Acc, lat, long, date_acc)
Combien d'accidents avec des coordonnées gps renseignées nulles ?
accidents_gps_group %>% filter(lat==0, long==0)
On obtient 13 043 accidents sans coordonnées gps renseignées sur 236 570 soit 5,5 %. On les retire de la base accidents_gps_group.
accidents_gps_group <- accidents_gps_group %>% filter(lat != 0, long != 0)
summary(accidents_gps_group[,c(2,3)])
On cherche les coins de la carte avec la fonction make_bbox du package ggmap
bbox <- make_bbox(long, lat, data=accidents_gps_group) bbox
Carte <- get_map(bbox) ggmap(Carte)
La carte n'est pas centrée sur la France comme nous le souhaiterions.
la <- 48.293024 lo <- 4.079306 zoom <- 4 #Carte <- get_map(bbox) #ggmap(Carte) Carte2 <- get_map(location=c(lon = 1.7, lat = 47), zoom = 6, source="google", maptype="terrain", crop=TRUE, language= "fr-FR") ggmap(Carte2)
L'accès à l'API de Google nécessite un enregistrement avec communication d'une CB. J'abandonne cette piste.
Création de la carte de France puis conversion au format sf pour utilisation avec le package cartography
# Import d'une table de correspondance Département/Région # regions <- read.csv("departements-region.csv",header=T, sep=",") data("regions", package="ACC") head(regions)
Jointure entre accidents et regions pour ajout de la région de l'accident
class(accidents$dep) accidents$dep <- as.numeric(accidents$dep) class(regions$num_dep) regions$num_dep <- as.numeric(regions$num_dep) accidents_region <- accidents %>% dplyr::left_join(regions, by = c("dep"="num_dep"))
Regroupement des accidents par région
accidents_par_region <- accidents_region %>% dplyr::select(Num_Acc,region_name) %>% group_by(region_name) %>% summarise(n=n())
Regroupement des accidents par département
accidents_par_dept <- accidents_region %>% dplyr::select(Num_Acc,dep,dep_name) %>% group_by(dep, dep_name) %>% summarise(nbre_acc=n())
On colore les régions les plus accidentogènes.
library(GADMTools) library(classInt) Fr<-gadm_sf_loadCountries("FRA",level=2) listNames(Fr,level=2) plotmap(Fr) accidents_par_dept <- data.frame(accidents_par_dept) choropleth(Fr, data = accidents_par_dept, step=4, value = "nbre_acc", adm.join = "dep_name", breaks = "quantile", palette = "Reds", legend="Nombre d'accidents", title="Nombre d'accidents par département en 2018")
accidents_2018 <- accidents_gps_group %>% filter(year(date_acc) == 2018) france <- leaflet(data=accidents_2018) %>% setView(lng=1.7, lat=47, zoom=5) %>% addTiles() #print(france) france %>% addCircles(~long, ~lat, weight = 0.25)
Les modalités de la variable grav dans la table accidents :
accidents %>% dplyr::select(grav) %>% group_by(grav) %>% summarise(n=n())
On compte 4 modalités, on va colorer les points du jaune au rouge, du niveau de gravité le plus faible (Indemne) au niveau le plus grave (Tué).
accidents_2018_bis <- accidents_gps %>% dplyr::filter(year(date_acc)==2018) %>% dplyr::select(Num_Acc, grav, lat, long, date_acc) %>% mutate(ye = year(date_acc)) accidents_2018_bis <- accidents_2018_bis[1:10000,]
#accidents_2018_bis$grav <- factor(sample.int(4L, nrow(accidents_2018_bis), TRUE)) #factpal <- colorFactor(topo.colors(4), accidents_2018_bis$grav) factpal <- colorFactor(c("firebrick","orange","gold","forestgreen"), accidents_2018_bis$grav) factpal(accidents_2018_bis$grav[1:10]) france_test <- leaflet(data=accidents_2018_bis) %>% setView(lng=1.7, lat=47, zoom=5) %>% addTiles() %>% addCircleMarkers(~long, ~lat, radius = 0.1, color = ~factpal(grav), stroke = FALSE, fillOpacity = 0.5) print(france_test)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.