owned this note
owned this note
Published
Linked with GitHub
# Manipulation et (géo)visualisations de données de billettique avec R
L'objectif de cette séance est de **manipuler un jeu de données de billétique** pour créer une **série d'indicateurs** (date, mode de transport, type de billets,...) et les représenter sour forme de **visualisations de données** et de **cartes**.
## Les données
Nous allons travailler avec les données de billétique du réseau de transport en commun d'Ile-De-France produite par [Ile-de-France Mobilités.](https://www.iledefrance-mobilites.fr/decouvrir/nos-missions).
> La **documentation de ce jeu de données** est disponible dans un [fichier PDF](https://docplayer.fr/31994588-Donnees-de-validation-telebillettiques-presentation-des-donnees-open-data.html)
Ces données originales sont disponibles en **opendata** sur la plateforme de données ouvertes data.iledefrance-mobilites.fr.
Il existe deux jeux de données intéressants à explorer pour s'aguérrir à la manipulation de données dans R.
* Un [jeu de données par tanche horaire](https://data.iledefrance-mobilites.fr/explore/dataset/validations-sur-le-reseau-ferre-profils-horaires-par-jour-type-2e-sem/table/)
* Un [jeu de données par journée](https://data.iledefrance-mobilites.fr/explore/dataset/validations-sur-le-reseau-ferre-nombre-de-validations-par-jour-2e-sem/table/)
---
**Nous allons travailler avec ce fichier .csv**
**Il faut prendre le temps de comprendre ce dataset !**
## Les packages de la séance
```
library(tidyverse)
library(lubridate)
library(sf)
```
## Créer des indicateurs de billétique à la volée
Avant même de faire cela il faut venir modifier la colonne NB_VALD qui :
* est formatée en chaine de charactères
* contient du texte
On va d'abord supprimer la modalité 'Moins de 5'
```
BilletiqueOK <- billetique %>% filter(! NB_VALD== 'Moins de 5')
```
Puis changer la formatage de la colonne
```
BilletiqueOK$NB_VALD <- as.integer(BilletiqueOK$NB_VALD)
```
### Sur les dates
---
#### Nombre de validation par jour (date)
---
On compte le nombre de validation totale par jour
```
AgregDate <- BilletiqueOK %>% group_by(JOUR) %>% summarise (nb= sum(NB_VALD))
```
On ajoute maintenant le jour de la semaine dans le jeu de données avec la fonction **`wday`**
```
BilletiqueOK$JOUR <- as.Date(BilletiqueOK$JOUR)
BilletiqueOK <- BilletiqueOK %>% mutate(journee= wday(JOUR,label= TRUE, abbr= FALSE))
```
Nombre total de validations par jour avec la journée
```
AgregDate <- BilletiqueOK %>% group_by(JOUR, journee) %>% summarise (nb= sum(NB_VALD))
```
Faire une **visualisation** en colonnes avec une couleur par journée de la semaine
```
ggplot(AgregDate, aes(x=JOUR, y=nb, fill=journee)) +
geom_bar(stat="identity") +
theme_minimal() +
scale_fill_brewer(palette="Set2") +
scale_y_continuous(labels = comma, breaks=c(1000000, 2000000, 3000000, 4000000, 5000000, 6000000)) +
labs(x = "Date", y = "Nb de validations") +
labs(caption="Source : IdF Mobilité")
```
---
#### Nombre total de validations par journée (de la semaine)
---
Créer un tableau récapitulatif
```
AgregJournee <- BilletiqueOK %>% group_by(journee) %>% summarise (nb= sum(NB_VALD))
```
Remettre les journées de la semaine dans l'ordre
```
AgregJournee$journee <- factor(AgregJournee$journee,levels = c("lundi", "mardi", "mercredi", "jeudi", "vendredi", "samedi", "dimanche"))
```
Faire une **visualisation**
```
ggplot(AgregJournee, aes(x=journee, y=nb, fill=journee)) +
geom_bar(stat="identity")+theme_minimal() +
scale_fill_brewer(palette="Paired") +
scale_y_continuous(breaks=c(50000000, 100000000, 120000000)) +
scale_y_continuous(labels = comma)
```
---
#### Nombre total de validations par mois
---
Il faut au préalable **ajouter dans la table le nom du mois** avec la fonction **`month`**
```
BilletiqueOK <- BilletiqueOK %>% mutate(Mois= month(JOUR,label= TRUE, abbr= FALSE))
```
Faire le tableau récapitulatif
```
AgregMois <- BilletiqueOK %>% group_by(Mois) %>% summarise (nb= sum(NB_VALD))
```
Faire une **visualisation**
```
ggplot(AgregMois, aes(x=Mois, y=nb, fill=Mois)) +
geom_bar(stat="identity")+theme_minimal() +
scale_fill_brewer(palette="Dark2") +
scale_y_continuous(breaks=c(50000000, 100000000, 140000000))
```
#### Faire un small multiple du nombre de validations par jour de la semaine et par mois
Faire le tableau récapitulatif
```
agregsemainemois <- BilletiqueOK %>% group_by(Mois, journee) %>% summarise(Nb=sum(NB_VALD))
```
Réorganiser les jours par ordre logique
```
agregsemainemois$journee <- factor(agregsemainemois$journee,levels = c("lundi", "mardi", "mercredi", "jeudi", "vendredi", "samedi", "dimanche"))
```
Faire la visualisation
```
ggplot(agregsemainemois) + geom_col(aes(x = journee, y = Nb, fill=Mois)) +
scale_fill_brewer(palette="Dark2") +
theme_bw() +
facet_wrap(~Mois)
```
#### Faire un small multiple du nombre de validations par jour de la semaine, par semaine et par mois
#### Faire une heatmap du nombre de validation par jour
Première étape venir enrichir le dataframe de deux nouvelles variables temporelles (le numéro du jour de la date et le numéro de la semaine)
```
BilletiqueOK <- BilletiqueOK %>%
mutate(jour = (day(BilletiqueOK$JOUR)),
wotm= ceiling(day(BilletiqueOK$JOUR) / 7))
```
Ensuite on crée le tableau récapitulatif
```
heatmap <- BilletiqueOK %>% group_by(journee, jour, Mois, wotm) %>% summarise(NB_Validations=sum(NB_VALD))
```
```
ggplot(heatmap, aes(journee,Mois, fill = NB_Validations)) + geom_tile(colour = "white") +
labs(fill = "Nombre de signalement") +
scale_fill_gradientn(colours = pal) +
xlab("Semaine du mois") +
ylab("Journée") +
ggtitle("Nombre de validations par jour") +
labs(caption="Source : IdF Mobilité") +
theme_bw()
```
### Sur les catégorie de titre
Nous cherchons ici à travailler sur les types de titres transport utilisés.
Faire un premier tableau récapitulatif par ordre décroissant
```
TypeTitre <- BilletiqueOK %>% group_by(CATEGORIE_TITRE) %>% summarise(nb = sum(NB_VALD)) %>% arrange(desc(nb))
```
On peux supprimer les deux modalités '?' et 'NON DEFINI'
```
TypeTitre <- TypeTitre %>% filter(! (CATEGORIE_TITRE=="?" | CATEGORIE_TITRE=="NON DEFINI"))
```
Ou alors remplacer ces deux modalités par une autre 'NON DEFINI' dans le dataframe de départ
```
billetique$CATEGORIE_TITRE[billetique$CATEGORIE_TITRE %in% c("?","NON DEFINI")]<-"AUTRE TITRE"
```
Faire une **visualisation**
Sous forme de barres horizontales
```
ggplot(TypeTitre, aes(reorder(CATEGORIE_TITRE, nb), nb, width = .9, fill = CATEGORIE_TITRE)) +
geom_bar(stat="identity") +
coord_flip() +
scale_fill_brewer(palette="Dark2") +
ggtitle("Nombre de validations par type de titre de transport") +
xlab("Type de titre de transport") +
ylab("Nb de validations") +
labs(caption="Source : IDF Mobilité") +
theme_bw() +
theme(legend.position = "none")
```
Sous forme de **TreeMap**
On va d'abord ajouter une nouvelle colonne qui concatene les deux colonnes pour faire une étiquette plus riche
```
TypeTitre <- TypeTitre %>% mutate(label = paste(CATEGORIE_TITRE, nb,sep=' - '))
```
```
library(treemap)
```
```
treemap(TypeTitre, index=c("label"),vSize="nb", type="index",
fontsize.labels=c(15,12),
fontcolor.labels=c("white","orange"),
fontface.labels=c(2,1),
bg.labels=c("transparent"),
align.labels=list(
c("center", "center"),
c("right", "bottom")),
overlap.labels=0.5,
inflate.labels=F,)
```
#### **Reclassifier les titres de transport en 2 catégories**
* Les titres "tarifs normal" (NAVIGO, NAVIGO JOUR, AUTRE TITRE et AMETHYSTE)
* Les titre à "tarifs réduits" (IMAGINE R, TST, FGT)
On va ici mobilier la fonction `case when`
```
BilletiqueOK <-BilletiqueOK %>% mutate(Typetarif = case_when(CATEGORIE_TITRE == "NAVIGO" ~ "Tarif normal",
CATEGORIE_TITRE == "NAVIGO JOUR" ~ "Tarif normal",
CATEGORIE_TITRE == "AMETHYSTE" ~ "Tarif normal",
CATEGORIE_TITRE == "AUTRE TITRE" ~ "Tarif normal",
CATEGORIE_TITRE == "IMAGINE R" ~ "Tarif réduit",
CATEGORIE_TITRE == "TST" ~ "Tarif réduit",
CATEGORIE_TITRE == "FGT" ~ "Tarif réduit"))
```
Faire un **tableau récapitularif**
```
Typetitretarif <- BilletiqueOK %>% group_by(Typetarif) %>% summarise(Nb = n())
```
Faire une **visualisation**
### Sur les stations
---
Dans le jeu de données nous disposons d'un identifiants de station ***CODE_STIF_ARRET***
Faire un premier tableau récapitulatif où on compte le nombre total de validations par station.
```
NbValidationsStation <-BilletiqueOK %>% group_by(Arret = LIBELLE_ARRET, Code = CODE_STIF_ARRET) %>% summarise(Nb= sum(NB_VALD))
```
Compter le nombre de stations différentes > 685
```
length(unique(NbStation$Arret))
```
Il y a trop de modalités pour proposer des analyses ou des représentations graphiques pertinentes
On va devoir venir **enrichir** ce jeu de données d'information supplémentaires issues d'autres jeu de données.
On va utiliser le jeu de données (géographique) des stations du réseau de TC.
https://data.iledefrance-mobilites.fr/explore/dataset/emplacement-des-gares-idf/table/
Importer ce jeu de données (en CSV) et exploré le
La première action a effecué est une **jointure attributaire** pour ajouter aux données de billétique :
* Le mode de la station (métro, RER, tramway,...) > *mode_*
* la ligne concernée (1,2,3, RER A, RER B,...) > *ligne*
* L'exloitant de la stations (RATP, SNCF,...) > *exploitant*
```
BilletiqueOK <- merge(BilletiqueOK, Stations[, c("gares_id", "mode_", "ligne", "exploitant")],
by.x="CODE_STIF_ARRET", by.y="gares_id")
```
Faire ces **visualisations de données**
```
AgregLigne <-BilletiqueOK %>% group_by(Ligne = ligne, Mode = mode_) %>%
summarise(Nb=sum(NB_VALD))
```
```
ggplot(AgregLigne, aes(reorder(Ligne, Nb), Nb, width = .9, fill = Mode)) +
geom_bar(stat="identity") +
coord_flip() +
scale_fill_brewer(palette="Set1") +
ggtitle("Nombre de validations par ligne de TC") +
xlab("Ligne de transport") +
ylab("Nb de validations") +
labs(caption="Source : IDF Mobilité") +
theme_bw()
```
```
AgregLigneTemps <-BilletiqueOK %>% group_by(Ligne = ligne, Mode = mode_, Journee= journee, Mois) %>%
filter(! Mode == "Tramway") %>%
summarise(Nb=sum(NB_VALD))
AgregLigneTemps$Journee <- factor(AgregLigneTemps$Journee,levels = c("lundi", "mardi", "mercredi", "jeudi", "vendredi", "samedi", "dimanche"))
ggplot(AgregLigneTemps) + geom_col(aes(x = Journee, y = Nb, fill=Mode)) +
scale_fill_brewer(palette="Dark2") +
theme_bw() +
facet_grid(Mode~Mois) +
theme(legend.position = "none") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
```
```
AgregLigneTemps <-BilletiqueOK %>% group_by(Date= JOUR, Mode = mode_, Mois) %>%
filter(! Mode == "Tramway") %>%
summarise(Nb=sum(NB_VALD))
ggplot(AgregLigneTemps) + geom_col(aes(x = Date, y = Nb, fill=Mode)) +
scale_fill_brewer(palette="Dark2") +
theme_bw() +
facet_grid(Mode~Mois) +
theme(legend.position = "none") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
```
https://www.r-graph-gallery.com/279-plotting-time-series-with-ggplot2.html
https://www.datanovia.com/en/fr/blog/ggplot-graduations-des-axes-definir-et-pivoter-les-textes/
https://www.datanovia.com/en/fr/blog/ggplot-titre-des-axes/
```
ggplot(agrelignetemps) + geom_col(aes(x = Date, y = Nb, fill=Mode)) +
scale_fill_brewer(palette="Dark2") +
facet_grid(~Mode) +
theme_bw() +
theme(legend.position = "none") +
scale_x_date(date_breaks = "1 month", date_labels = "%B") +
theme(axis.text.x=element_text(angle=40, hjust=1, size = 10, face = "bold")) + theme(axis.text.y=element_text(size = 8)) +
scale_y_continuous(labels = comma) +
labs(x = "Mois", y = "Nb de validations") +
labs(caption="Source : IdF Mobilité") +
ggtitle("Nombre de validations par jour et par mode")
```
---
## Travailler avec le spatial
Il faut lancer les packages `SF` et `cartography`
```
library(sf)
library(cartography)
```
---
### Cartographier le nombre de validation total par station
---
Récupérer le shapefile des stations
https://data.iledefrance-mobilites.fr/explore/dataset/emplacement-des-gares-idf/export/
Intégrer ce shapefile dans R
`StationsGEO <- st_read(dsn = "C:/Users/mericskay_b/Documents/Downloads/emplacement-des-gares-idf/emplacement-des-gares-idf.shp", stringsAsFactors = FALSE) `
Visualiser les données
```
plot(StationsGEO["mode"])
```
Créer le tableau récapitulatif
```
Nbvalidstation <- BilletiqueOK %>% group_by(Stations = CODE_STIF_ARRET) %>% summarise(Nb=sum(NB_VALD))
```
Faire la jointure
```
StationGEOData <- merge(StationsGEO,Nbvalidstation, by.x= "gares_id", by.y="Stations")
```
Faire une "carte"
```
plot(st_geometry(StationGEOData),
col = "lightblue4",
border = "lightblue3",
bg = "lightblue1")
propSymbolsLayer(
x = StationGEOData,
var = "Nb", inches = 0.5,
fixmax = 16552766,
legend.title.txt = "Nb de validation")
```
Ecrire le shape pour la cartographier...ailleurs...
```
st_write(StationGEOData, "stationsok.shp")
```
---
## Cartographier le nombre de validation du réseau RER
---
Créer un jeu de données RER
```
RER <-BilletiqueOK %>% filter(mode_ == 'RER')
RER <- RER %>% group_by(CODE_STIF_ARRET) %>% summarise(Nb= sum(NB_VALD))
```
Faire la jointure attributaire
```
StationGEOData <- merge(StationsGEO,RER, by.x= "gares_id", by.y="CODE_STIF_ARRET")
```
Ecrire le shape pour la cartographier...ailleurs...
```
st_write(StationGEOData, "stationsok.shp")
```
---
## Cartographier le nombre de validation du réseau métro
---
Créer un jeu de données métro
```
Metro <-BilletiqueOK %>% filter(mode_ == 'Metro')
Metro <- Metro %>% group_by(CODE_STIF_ARRET) %>% summarise(Nb= sum(NB_VALD))
```
Faire la jointure attributaire
```
StationGEOData <- merge(StationsGEO,Metro, by.x= "gares_id", by.y="CODE_STIF_ARRET")
```
Ecrire le shape pour la cartographier...ailleurs...
```
st_write(StationGEOData, "metro.shp")
```
## Travail en autonomie
Faire des graphiques et des cartes pour donner à voir les usages des TC pendant la grève de 2019.
> La grève a débuté le 5 décembre 2019 ;)
Google Drive
Gist
Clipboard
Sign in with Wallet
