Quand lubridate nous permet d’explorer des données

Pour le #Tidytuesday de cette semaine, nous avons l’occasion de regarder les compteurs de vélo à Seattle. Le Seattle Times a récemment couvert ce que nous pouvons apprendre de ces données. Ça vaut la pein d’aller jetter un petit coup d’oeil à cet article car, on y retrouve des visualisations très bien pensées!

CONTEXTE

Le ministère des Transports de Seattle possède 12 compteurs à vélos (dont quatre comptent également des piétons) situés sur des voies vertes de quartier, des sentiers polyvalents, sur le pont Fremont et sur la rue SW Spokane.

Les données issues de ces compteurs sont collectées depuis 2014 pour créer une base de données de fréquentation. L’objectif est de compiler l’utilisation des années antérieures et d’évaluer les années à venir afin de s’assurer que les investissements aident à atteindre leur objectif qui est de quadrupler le nombre de passagers d’ici 2030.

Dans son analyse, le Sealttle Time à mis en évidence que la collecte de données de la ville sur la fréquentation des pistes cyclables est dispersée et incomplète. Le nombre de passagers est mesuré à seulement 12 endroits où la ville a installé des comptoirs à vélos sur les voies vertes des quartiers, les sentiers polyvalents, les pistes cyclables protégées et sur le pont Fremont. De plus, les compteurs fonctionnent mal et n’enregistrent pas les données, parfois pendant des semaines ou des mois.

Ils en ont donc conclu qu’il n’est pas surprenant que les données montrent clairement que le nombre de passagers a considérablement diminué pendant les mois de pluies à Seattle. La période d’octobre 2016 à avril 2017 a été la plus humide depuis la tenue des registres dans la ville en 1895. Le trafic cycliste a considérablement diminué, avec une diminution mesurée de 6 à 58% sur les compteurs.

Dongho Chang, ingénieur en chef du trafic à Seattle, reconnaît les problèmes avec les données. Néanmoins, malgré tous leurs défauts, les guichets fournissent la seule information accessible au public sur l’utilisation des pistes cyclables à Seattle.

OBJECTIFS

1) Explolrer les données pour voir si je peux avoir une idée des données manquante dont il est question dans l’article et juger de leur importance vis-à-vis le travail que je veux faire.
2) Montrer l’évoluition dans le temps, selon différente perspective, de l’utilisation des vélos.
3) Essayer de me faire une idée à savoir si les données manquante sont vraiment la cause de la baisse du nombre de vélos sur les routes de Seatle.


IMPORTER

bike_traffic <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-04-02/bike_traffic.csv")
FALSE Parsed with column specification:  
FALSE cols(  
FALSE   date = col_character(),  
FALSE   crossing = col_character(),  
FALSE   direction = col_character(),  
FALSE   bike_count = col_double(),  
FALSE   ped_count = col_logical()  FALSE )



EXPLORER

glimpse(bike_traffic)
## Observations: 515,688  
## Variables: 5  
## $ date       <chr> "01/01/2014 12:00:00 AM", "01/01/2014 01:00:00 AM", "…  
## $ crossing   <chr> "Broadway Cycle Track North Of E Union St", "Broadway…  
## $ direction  <chr> "North", "North", "North", "North", "North", "North",…  
## $ bike_count <dbl> 0, 3, 0, 0, 0, 0, 0, 0, 2, 0, 5, 0, 7, 4, 6, 6, 1, 4,…  
## $ ped_count  <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N…
Hmisc::describe(bike_traffic$crossing)
## bike_traffic$crossing   
##        n  missing distinct   
##   515688        0        7  
##   
## 39th Ave NE Greenway at NE 62nd St (77328, 0.150), Broadway Cycle Track  
## North Of E Union St (89136, 0.173), Burke Gilman Trail (90480, 0.175),  
## Elliot Bay Trail (90480, 0.175), MTS Trail (45576, 0.088), NW 58th St  
## Greenway at 22nd Ave (89136, 0.173), Sealth Trail (33552, 0.065)
Hmisc::describe(bike_traffic$ped_count)
## bike_traffic$ped_count   
##        n  missing distinct   
##   103008   412680        2  
##                         
## Value      FALSE  TRUE  
## Frequency  77609 25399  
## Proportion 0.753 0.247
plt1 <-bike_traffic %>%
    ggplot(aes(x=" ", y = bike_count)) +
    geom_boxplot(fill = "#D8EADF", color = "black") +
     coord_flip() +
    theme_classic() +
    xlab("") +
    ylab("nombre de vélos")+
    theme(axis.text.y=element_blank(),
          axis.ticks.y=element_blank())

Nous disposons de plusieurs variables. Toutefois, pour pouvoir pousser plus l’exploration de ces données, il va falloir travailler un peu les dates, nottament avec lubridate pour pouvoir aller chercher les jours de la semaine et les heures.

bike_count représente le nombre de vélos comptés pour chaque fenêtre horaire.

Ped_count est inutile pour mon objetctif puisqu’il y a près de 413 000 données manquante sur un jeu de données de 516 000. Ça représente 80% de données manquante. Ce qui fait du sens puisque ce n’est pas tous les compteurs qui possèdent cette fonction, seulement 4.

On constate qu’il y a des observations (heures) ou il y a eu plus de 2000 vélos. Probablement des erreurs dans les données.


PRÉPARER: Explorer la distribution des données pour chaque intersection

var_width = 10  
data<-bike_traffic%>%
    filter(bike_count<2000)%>% # retirer les données abérhantes    
    mutate(date = mdy_hms(date))%>% #changer le format de la date pour pouvoir travailler    
    mutate(date_simple = as.Date(date, format="%Y-%M-%d"))%>% #changer le format de la date pour le graphique
    mutate(crossing_1 = str_wrap(crossing, width = var_width)) # ajuster la largeur du texte pour l'affichage



VISUALISER

gg<-ggplot(data=data, aes(x=date_simple, y=bike_count))
  gg<-gg + geom_point(colour ="#247BA0",pch=21, size = 0.2, alpha = 0.1)  
gg<-gg + facet_grid(rows = vars(crossing_1), scale="free")  
#modifier la légende  
gg<-gg + theme(legend.position="none")  
#ajuster les étiquettes des axes  
gg<-gg + scale_x_date(date_breaks = "1 year", date_labels = "%Y")  
#modifier l'aparence des boites de titres  
gg<-gg +   theme(strip.background = element_rect(fill="#FFFBF4", colour = "#000000", size = 0.3, linetype = "solid"),
                 strip.text=element_text(size=7))  
#modifier le thème  
gg<-gg +theme(panel.border = element_blank(),
                panel.background = element_rect(fill = "#FFFBF4", colour = "#FFFBF4"),
                plot.background = element_rect(fill = "#FFFBF4", colour = "#FFFBF4"),
                panel.grid.major.y= element_blank(),
                panel.grid.major.x= element_blank(),                panel.grid.minor = element_blank(),
                axis.line = element_line(linetype="solid", size=.3, color="#000000"),
                axis.ticks.y = element_line(linetype="solid", size=.3, color="#000000"),
                axis.ticks.x = element_line(linetype="solid", size=.3, color="#000000"))  
#ajouter les titres  
gg<-gg + labs(  title= "Nombre de vélo pour chacune des intersections selon la date",
                subtitle=NULL,
                y="Nombre de vélos",
                 x=NULL)  
gg<-gg + theme(plot.title    = element_text(hjust=0,size=18, color="#000000"),
                 plot.subtitle = element_text(hjust=0,size=18, color="#000000"),
                 axis.title.y  = element_text(hjust=1, size=12, color="#000000"),
                 axis.title.x  = element_blank(),
                 axis.text.x   = element_text(hjust=0.5, size=8, color="#000000"),
                  axis.text.y   = element_text(hjust=0.5, size=8, color="#000000"))

Ce qu’on peut observer:

  • Certaines stations sont beaucoup plus fréquentées que d’autres
  • Il y a effectivement des données manquantes à quelques endroit
  • Cycle selon les saisons: les bicyclettes c’est fait pour être utilisé l’été…
  • Est-ce qu’on devrait constater la baisse dû à la saison humide de octobre 2016 à avril 2017?


PRÉPARER: Explorer la distribution des données en fonction des jours de la semaine

data<-bike_traffic%>%
    filter(bike_count<2000)%>% # retirer les données abérhantes    
    mutate(date = mdy_hms(date))%>% #changer le format de la date pour pouvoir travailler
    mutate(jour=weekdays(date))%>% #extraire le jour de la semaine    
    mutate(annee=year(date))%>% #extraire l'année
    filter(!annee %in% c(2013,2019), crossing != 'Sealth Trail') %>% # retirer les données abérhantes    
group_by(jour, annee)%>%    
summarise(somme = sum(bike_count, na.rm = T))



VISUALISER

#Graphique  
gg<-ggplot(data=data, aes(x=jour, y=somme, group=annee, color=factor(annee)))  
gg<-gg + geom_line(size = 2)  
gg<-gg + geom_point(shape = 21, fill = "#FFFBF4", size = 4, show.legend = F)   
gg<-gg + scale_color_manual(values = c("#247BA0", "#D62828", "#FF9000", "#610F7F", "#57886C"))   
#m odifier la légende  
gg<-gg + theme(legend.title = element_blank(),
                   legend.background = element_blank(),
                   legend.key=element_blank())  
#ajuster les étiquettes des axes  
gg<-gg +   scale_y_continuous(labels = function(x) x/1000)  
#modifier le thème  
gg<-gg +theme(panel.border = element_blank(),
                panel.background = element_rect(fill = "#FFFBF4", colour = "#FFFBF4"),
                plot.background = element_rect(fill = "#FFFBF4", colour = "#FFFBF4"), 
                panel.grid.major.y= element_blank(),
                panel.grid.major.x= element_blank(),                panel.grid.minor = element_blank(),
                axis.line = element_line(linetype="solid", size=.3, color="#000000"),
                axis.ticks.y = element_line(linetype="solid", size=.3, color="#000000"),
                axis.ticks.x = element_line(linetype="solid", size=.3, color="#000000"))  
#ajouter les titres  
gg<-gg + labs(  title= "Nombre de vélo pour chaque année en fonction des jours de la semaine",
                subtitle=NULL,
                y="Nombre de vélos (X1000)", 
                x=NULL)  
gg<-gg + theme(plot.title    = element_text(hjust=0,size=18, color="#000000"),
                 plot.subtitle = element_text(hjust=0,size=18, color="#000000"),
                 axis.title.y  = element_text(hjust=1, size=12, color="#000000"),
                 axis.title.x  = element_blank(),
                 axis.text.x   = element_text(hjust=0.5, size=8, color="#000000"),
                 axis.text.y   = element_text(hjust=0.5, size=8, color="#000000"))

On peut observer que:

  • l’utilisation des vélos à Seatle diminue entre 2014 et 2018 si on regarde l’utilisation en fonction des jours de la semaine
  • Je me serait attendu à voir la saison 2018 reprendre après la saison humide mais ce n’est pas le cas. C’est difficile de se prononcer par contre par ce que effectivement, le compteur de Ghilman trail a cessé de fonctionner pendant quelques mois et celui sur la 39e avenue a cessé de fonctionner après le premier tier de l’année 2018 environ.


PRÉPARER: Explorer la distribution des données en fonction des heures de la journée

data<-bike_traffic%>%
    filter(bike_count<2000)%>% # retirer les données abérhante    
    mutate(date = mdy_hms(date))%>% #changer le format de la date pour pouvoir travailler
    mutate(heure=hour(date)) %>% #extraire les heures    
    mutate(annee=year(date))%>% #extraire l'année 
    filter(!annee %in% c(2013,2019), crossing != 'Sealth Trail') %>% # retirer les données abérhante
    group_by(heure, annee)%>%
    summarise(somme = sum(bike_count, na.rm = T))



VISUALISER

#Graphique  
gg<-ggplot(data=data, aes(x=heure, y=somme, group=annee, color=factor(annee)))  
gg<-gg + geom_line(size = 2)  
gg<-gg + scale_color_manual(values = c("#247BA0", "#D62828", "#FF9000", "#610F7F", "#57886C"))   
#modifier la légende  
gg<-gg + theme(legend.title = element_blank(),
                   legend.background = element_blank(),
                   legend.key=element_blank())  
#ajuster les étiquettes des axes  
gg<-gg +   scale_y_continuous(labels = function(x) x/1000)  
gg<-gg +   scale_x_continuous(breaks = seq(0,23))  
#modifier le thème  
gg<-gg +theme(  panel.border = element_blank(),
                panel.background = element_rect(fill = "#FFFBF4", colour = "#FFFBF4"),
                plot.background = element_rect(fill = "#FFFBF4", colour = "#FFFBF4"), 
                panel.grid.major.y= element_blank(),
                panel.grid.major.x= element_blank(),
                panel.grid.minor = element_blank(),
                axis.line = element_line(linetype="solid", size=.3, color="#000000"), 
                axis.ticks.y = element_line(linetype="solid", size=.3, color="#000000"),
                axis.ticks.x = element_line(linetype="solid", size=.3, color="#000000"))  
#ajouter les titres  
gg<-gg + lab(   title= "Nombre de vélo pour chaque année en fonction des heures de la journée",
                subtitle=NULL,
                y="Nombre de vélos (X1000)",
                 x=NULL)  
gg<-gg + theme(plot.title    = element_text(hjust=0,size=18, color="#000000"),
                 plot.subtitle = element_text(hjust=0,size=18, color="#000000"),
                 axis.title.y  = element_text(hjust=1, size=12, color="#000000"),
                 axis.title.x  = element_blank(),
                 axis.text.x   = element_text(hjust=0.5, size=8, color="#000000"),
                  axis.text.y   = element_text(hjust=0.5, size=8, color="#000000"))  
#Annotation  gg<-gg + geom_vline(xintercept = c(8,17), linetype = 2)  gg<-gg + annotate("text", label = "temps de\ntrajet", x = 12.5, y = 25000)   gg<-gg +  geom_segment(xend = 8.5, x = 11, y = 20000, yend = 20000, col = "000000",
                          arrow = arrow(angle = 30, length = unit(2, "mm")))   
gg<-gg +   geom_segment(xend = 16.5, x = 14, y = 20000, yend = 20000, col = "000000",
                           arrow = arrow(angle = 30, length = unit(2, "mm"))) 

On peut constater que:

  • Les pic d’utilisation des vélos se situent aux heures de début et de fin des heures de travail régulière. Donc, beaucoup de gens à Seatle utilisent les vélos pour aller travailler

PRÉPARER: Explorer la distribution des données en fonction des heures de la journée par intersection

data<-bike_traffic%>%
    filter(bike_count<2000)%>% # retirer les données abérhantes    
    mutate(date = mdy_hms(date))%>% #changer le format de la date pour pouvoir travailler
    mutate(heure=hour(date)) %>% #extraire les heures      
    mutate(jour=weekdays(date))%>% #extraire le jour de la semaine    
    mutate(annee=year(date))%>% #extraire l'année    
    filter(!annee %in% c(2013,2019), crossing != 'Sealth Trail') %>% # retirer les données abérhantes
    group_by(heure,jour, crossing)%>%
    summarise(somme = sum(bike_count, na.rm = T))

    data$jour <- factor(data$jour,levels = c("Dimanche","Lundi", "Mardi", "Mercredi", "Jeudi","Vendredi", "Samedi"))



VISUALISER

#Graphique    
gg<- ggplot(data=data,aes(heure, fct_rev(jour)))  
gg<- gg + geom_tile(aes(fill = somme))   
gg<- gg +  facet_wrap(~crossing)   
gg<- gg + scale_fill_viridis_c(guide = guide_legend(title.position = 'top',
                                               label.position = 'bottom',
                                               direction = 'horizontal',
                                              reverse = T, title = "Nombres de vélos",
                                               keywidth = unit(20,"mm"),
                                              keyheight = unit(2,"mm"),                                               label.hjust = 0,
                                              label.theme = element_text(size = 8),
                                              title.theme = element_text(size = 9)))   
#modifier la légende  
gg<- gg +    theme(legend.position = 'top',
                    strip.text = element_text(size = 8),
                     legend.background = element_blank(),
                      legend.key=element_blank())  
#ajuster les étiquettes des axes  
gg<- gg +  scale_x_continuous(breaks = seq(0,23,2))   
#modifier le thème  
gg<-gg +theme(panel.border = element_blank(),
                panel.background = element_rect(fill = "#FFFBF4", colour = "#FFFBF4"),
                plot.background = element_rect(fill = "#FFFBF4", colour = "#FFFBF4"),
                panel.grid.major.y= element_blank(),
                panel.grid.major.x= element_blank(),
                panel.grid.minor = element_blank(),
                axis.line = element_line(linetype="solid", size=.3, color="#000000"),
                axis.ticks.y = element_line(linetype="solid", size=.3, color="#000000"),
                axis.ticks.x = element_line(linetype="solid", size=.3, color="#000000"))  
#ajouter les titres  
gg<-gg + labs(title= "Heures de pointe pour les cyclistes de Seattle par intersection",
                subtitle=NULL,
                y="Jour de la semaine",
                 x="Heures du jour")  
gg<-gg + theme(plot.title    = element_text(hjust=0,size=18, color="#000000"),
                 plot.subtitle = element_text(hjust=0,size=18, color="#000000"),
                 axis.title.y  = element_text(hjust=1, size=12, color="#000000"),  
                 axis.title.x  = element_text(hjust=0, size=12, color="#000000"),
                 axis.text.x   = element_text(hjust=0.5, size=8, color="#000000"),
                 axis.text.y   = element_text(hjust=0.5, size=8, color="#000000"))

On peut constater que:

  • Ce type de graphique met bien en évidence quelles stations sont les plus utilisées.

PRÉPARER: Évolution de l’utilisation des vélos dans le temps

data<-bike_traffic%>%
    filter(bike_count<2000)%>% # retirer les données abérhante    
    mutate(date = mdy_hms(date))%>% #changer le format de la date pour pouvoir travailler    
    mutate(date_simple = as.Date(date, format="%Y-%M-%d"))%>% #changer le format de la date
    mutate(annee=year(date))%>% #extraire l'année
    filter(!annee %in% c(2013,2019), crossing != 'Sealth Trail') %>% # retirer les données abérhante
    group_by(date_simple)%>% 
    summarise(somme=sum(bike_count))



VISUALISER

#Graphique  
gg<-ggplot(data=data, aes(x=date_simple, y=somme))  
gg<-gg + geom_point(shape = 21, fill = "#A9A9A9", size = 2, show.legend = F)   
gg<-gg + geom_smooth()  
#ajuster les étiquettes des axes  
gg<-gg +   scale_y_continuous(labels = function(x) x/1000)  
gg<-gg + scale_x_date(date_breaks = "1 year", date_labels = "%Y")  
#modifier le thème  
gg<-gg +theme(panel.border = element_blank(),
                panel.background = element_rect(fill = "#FFFBF4", colour = "#FFFBF4"),
                plot.background = element_rect(fill = "#FFFBF4", colour = "#FFFBF4"),
                panel.grid.major.y= element_blank(),                panel.grid.major.x= element_blank(),
                panel.grid.minor = element_blank(),
                axis.line = element_line(linetype="solid", size=.3, color="#000000"),
                axis.ticks.y = element_line(linetype="solid", size=.3, color="#000000"),
                axis.ticks.x = element_line(linetype="solid", size=.3, color="#000000"))  
#ajouter les titres  
gg<-gg + labs(   title= "Évolution du nombre de vélos présent sur les routes de Seatle", 
                 subtitle=NULL,
                 y="Nombre de vélos (X1000)",
                 x=NULL)  
gg<-gg + theme(plot.title    = element_text(hjust=0,size=18, color="#000000"),
                 plot.subtitle = element_text(hjust=0,size=18, color="#000000"),
                 axis.title.y  = element_text(hjust=1, size=12, color="#000000"),
                 axis.title.x  = element_blank(),
                 axis.text.x   = element_text(hjust=0.5, size=8, color="#000000"),
                  axis.text.y   = element_text(hjust=0.5, size=8, color="#000000"))  
#Annotation  
gg<-gg + geom_vline(xintercept = as.numeric(as.Date(c("2016-10-01","2017-04-30","2018-05-01", "2019-01-01"))), linetype = 2)  gg<-gg + annotate("text", label = "Saison\nhumide", x =as.Date("2017-01-15"), y = 8000, size=4)   gg<-gg + annotate("text", label = "Données\nmanquantes", x =as.Date("2018-09-01"), y = 8000, size=4) 

On cosntate que le nombre de vélos présents sur les routes de Seatle diminue dans le temps si on compare les données de 2014 à 2018. Par contre, j’ai l’impression qu’il y a plus que ce qui est expliqué dans l’article, la diminution commence bien avant la saison humide de octobre de 2016. Le pic d’utilisation de l’été 2015 était déjà mois prononcé que celui de l’été 2014.

En conclusion, si l’objectif du département des transports de Seattle est des quadruplé l’utilisation des vélos d’ici 2030, ils sont sur la mauvaise voie…. Il devrait pousser plus loin leur questionnement pour chercher à comprendre pourquoi l’utilisation des vélos diminue dans le temps et apporter les correctifs nécessaire.

Tu veux en apprendre plus sur ma démarche? Va écouter l’épisode de podcast dans lequel j’explique mes réflexions pour arriver à ce résultat.

Publicités

2 réflexions sur “Quand lubridate nous permet d’explorer des données

  1. Pingback: Podcast ADV#3: Quand la date nous permet d’explorer les données | Johanie Fournier, agr.

  2. Pingback: ADV3 - Quand la date nous permet d'explorer les données | Johanie Fournier, agr.

Laisser un commentaire

Ce site utilise Akismet pour réduire les indésirables. En savoir plus sur comment les données de vos commentaires sont utilisées.