Chapitre 4 Exploration de données

Une étape souvent sous-estimée par les scientifiques de données amateurs est l’exploration initiale des données disponibles. Bien qu’il soit tout à fait possible de créer un modèle et de compléter le cycle complet de modélisation en négligeant cette étape, la garantie de qualité des résultats en serait alors fortement compromise.

L’expression populaire Garbage-in, garbage-out est généralement interprétée comme quoi un modèle prédicitif, même s’il utilise un algorithme à la fine pointe de la technologie, produira des mauvais résultats s’il est entraîné sur des données de mauvaise qualité. L’analyse préliminaire permet d’acquérir des connaissances indispensables pour la suite du processus de modélisation.

En effet, tel qu’on le verra dans le prochain chapitre, un élément clé pour obtenir un bon modèle prédictif est la création de nouvelles variables explicatives. Comme celle-ci seront basées sur des transformations des variables du jeu de données brut, il est impératif de bien en connaître les moindres détails.

Le but de ce chapitre est donc simple, on veut remplir les deux objectifs expliqués ci-haut :

1. S’approprier le jeu de données sur lequel on travaille;
2. Suggérer des transformations de variables pertinentes pour le prétraitement des données.

Structure du chapitre :

• Distribution de chaque variable d’entrée;
• Corrélation entre les variables d’entrée;
• Effet one-way des variables d’entrée sur la variable réponse;
• Effet multi-ways des variables d’entrée sur la variable réponse (interactions);
• Propositions de transformations.

Prendre note que le but de ce livre n’est pas de présenter une panoplie de solutions pour manipuler des données en R, mais bien d’avoir une vue d’ensemble sur le processus complet de modélisation. Pour des préférences personnelles, la minuplation des données sera effectuée en utilisant une combinaison des packages de base et du package data.table dans ce chapitre. Le lecteur est invité à consulter la documentation de base des packages pour mieux comprendre leur utilisation. Une autre solution populaire est l’utilisation de dplyr qui fait partie de la collection de packages du tidyverse.

• Avant de commencer, on observe le jeu de données;
• Échantillon aléatoire pour éviter les biais

Premières observations de data :

data[sample(.N, 5L)]

##    start_date start_station_code         end_date end_station_code
## 1: 2017-10-25               6072 2017-10-25 16:09             6748
## 2: 2017-07-01               7017 2017-07-01 16:10             7019
## 3: 2017-06-24               6730 2017-06-24 14:14             6358
## 4: 2017-07-10               6904 2017-07-10 08:49             6190
## 5: 2017-06-07               7012 2017-06-07 12:27             6928
##    duration_sec is_member     start_date_time
## 1:          464         1 2017-10-25 16:01:00
## 2:          554         0 2017-07-01 16:00:00
## 3:         1683         0 2017-06-24 13:45:00
## 4:          938         1 2017-07-10 08:33:00
## 5:          184         1 2017-06-07 12:24:00
##                         start_quartier
## 1:                         Ville-Marie
## 2:       Mercier-Hochelaga-Maisonneuve
## 3:           Rosemont-La Petite-Patrie
## 4:           Rosemont-La Petite-Patrie
## 5: Côte-des-Neiges-Notre-Dame-de-Grâce

Les variables présentes dans le jeu de données sont :

• start_date : jour du trajet; (ne devrait pas se retrouver ici, transformation de start_date_time)
• start_station_code : code de la station de départ;
• end_date : jour et heure de l’arrivée (post-fact, à enlever);
• end_station_code : dode de la station d’arrivée (post-fact, à enlever);
• duration_sec : durée du trajet en secondes (variable réponse);
• is_member : indicateur de membre;
• start_date_time : jour et heure du départ;
• start_quartier : quartier dans lequel se trouve la station de départ.

(Normalement, la collecte de données devrait devrait ramener l’ensemble des variables (sauf les post-fact), on aurait alors toute l’information qu’on a de besoin pour comprendre nos données. Comme certaines variables ont été enlevées, on explore les jeux de données bruts.)

On affiche les premières observations de data_bixi :

data_bixi[sample(.N, 5L)]

##          start_date start_station_code         end_date end_station_code
## 1: 2017-09-24 11:25               6216 2017-09-24 11:36             6094
## 2: 2017-10-28 08:44               6196 2017-10-28 09:01             6361
## 3: 2017-05-18 12:22               6043 2017-05-18 12:49             6041
## 4: 2017-09-28 08:03               6132 2017-09-28 08:04             6132
## 5: 2017-08-15 12:49               6737 2017-08-15 13:19             6158
##    duration_sec is_member
## 1:          628         0
## 2:         1070         1
## 3:         1626         1
## 4:           86         1
## 5:         1802         1

Les variables présentes dans le jeu de données sont :

• start_date : jour et heure du départ;
• start_station_code : code de la station de départ;
• end_date : jour et heure de l’arrivée;
• end_station_code : dode de la station d’arrivée;
• duration_sec : durée du trajet (en secondes);
• is_member : indicateur de membre.

On affiche ensuite les premières observations de data_stations :

data_stations[sample(.N, 5L)]

##    code                                     name latitude longitude
## 1: 6912              de Chateaubriand / Beaubien 45.53551 -73.60388
## 2: 6418             de Vendôme / de Maisonneuve 45.47442 -73.60406
## 3: 6386 Métro Préfontaine (Moreau / Hochelaga) 45.54144 -73.55431
## 4: 6139                  des Érables / Gauthier 45.53241 -73.56478
## 5: 6072                Metcalfe / de Maisonneuve 45.50171 -73.57413

Les variables présentes dans le jeu de données sont :

• code : code de la station;
• name : nom de la station;
• latitude : latitude de la station
• longitude: longitude de la station

4.1 Distribution des variables d’entrée

Dans la précédente section, on s’est familiarisé avec le format de nos données en regardant un échantillon aléatoire de nos observations. Bien que ce soit le point de départ, on est loin d’avoir suffisament apprivoisé notre jeu de données pour passer à la prochaine phase du cycle, le prétraitement des données. On pourrait toujours augmenter le nombre d’observations aléatoires jusqu’à ce qu’on regarde tout le jeu de données, mais on conviendra que ce n’est pas la solution idéale pour connaître toutes les valeurs que peuvent prendre chacune des variables.

La première étape pour agréger des données est de se familiariser avec les distributions marginales de chacun des champs. On doit évidemment traîter différemment les variables selon leur type. Les variables peuvent être de type :

• Numérique;
• Catégorique;
• Temporelle (donc fort probablement cyclique);
• Spatiale.

Il y a différentes manières de procéder, on propose une solution parmi tant d’autres dans le livre.

• Préférence : plotly (puisque le livre est en HTML)
• Alternatives : base, ggplot2, lattice

4.1.1 Status membre/non-membre (booléen/catégorique)

library(plotly)

## 
## Attaching package: 'plotly'

## The following object is masked from 'package:ggplot2':
## 
##     last_plot

## The following object is masked from 'package:stats':
## 
##     filter

## The following object is masked from 'package:graphics':
## 
##     layout

data_member <- data[, .(
  nb = .N,
  mean = mean(duration_sec)
), is_member][
  , status:=as.factor(ifelse(is_member, "Membre", "Non-Membre"))
]

plot_ly(
  data = data_member
) %>%
  add_bars(
    name = "Nombre de trajets",
    hoverinfo = "y",
    showlegend = FALSE,
    x = ~status,
    y = ~nb,
    xaxis = "x",
    yaxis = "y"
  ) %>%
  layout(
    xaxis = list(
      title = list(
        text = "Status"
      ),
      fixedrange = TRUE
    ),
    yaxis = list(
      title = list(
        text = "Nombre de trajets"
      ),
      fixedrange = TRUE,
      exponentformat = "none"
    )
  )

4.1.2 Quartier de la station de départ (catégorique)

data_quartiers <- data[, .(
  nb = .N,
  mean = mean(duration_sec)
), start_quartier]

data_quartiers[is.na(start_quartier), start_quartier:="Hors MTL"]

plot_ly(
  data = data_quartiers
) %>%
  add_bars(
    name = "Nombre de trajets",
    hoverinfo = "y",
    showlegend = FALSE,
    x = ~start_quartier,
    y = ~nb,
    xaxis = "x",
    yaxis = "y"
  ) %>%
  layout(
    xaxis = list(
      title = list(
        text = "Status"
      ),
      fixedrange = TRUE
    ),
    yaxis = list(
      title = list(
        text = "Nombre de trajets"
      ),
      fixedrange = TRUE,
      exponentformat = "none"
    )
  )

4.1.3 Date du trajet (temporelle)

• Observer l’effet de la tampérature sur la distribution en comparant avec une source externe;
• Suggère d’ajouter des données externes sur la température;
• On doit être prudent lors de la modélisation puisque le poids des données est distortionné par la température…

# Sommaire par date
data_date <- data[, .(
  nb = .N,
  mean = mean(duration_sec)
), start_date][order(start_date)]


plot_ly(
  data = data_date
) %>%
  add_bars(
    name = "Nombre de trajets",
    hoverinfo = "x+y",
    showlegend = FALSE,
    x = ~start_date,
    y = ~nb,
    xaxis = "x",
    yaxis = "y"
  ) %>%
  layout(
    xaxis = list(
      title = list(
        text = "Date du trajet"
      ),
      rangeslider = TRUE,
      fixedrange = TRUE
    ),
    yaxis = list(
      title = list(
        text = "Nombre de trajets"
      ),
      fixedrange = TRUE,
      exponentformat = "none"
    ),
    hovermode = "x"
  )

4.1.4 Heure du trajet (temporelle)

data_time <- copy(data)
data_time[, start_hour:=hour(start_date_time)]
data_time <- data_time[, time_min:=strftime(start_date_time, format="%H:%M", tz="UTC")][, .(
  nb = .N,
  mean = mean(duration_sec)
), .(time_min, start_hour)][order(time_min)]

plot_ly(
  data = data_time
) %>%
  add_bars(
    name = "Nombre de trajets",
    hoverinfo = "x+y",
    showlegend = FALSE,
    x = ~time_min,
    y = ~nb,
    xaxis = "x",
    yaxis = "y"
  ) %>%
  layout(
    xaxis = list(
      title = list(
        text = "Heure du trajet"
      ),
      rangeslider = TRUE,
      fixedrange = TRUE
    ),
    yaxis = list(
      title = list(
        text = "Nombre de trajets"
      ),
      fixedrange = TRUE,
      exponentformat = "none"
    ),
    hovermode = "x"
  )

4.1.5 Variables spatiales (stations + quartiers)

library(leaflet)
library(magrittr)

data_quartiers_geo <- readOGR("data/LIMADMIN.shp", verbose=FALSE)

# Sommaire par station
data_stations_rides <- data[, .(
  code = start_station_code,
  quartier = start_quartier,
  nb = .N,
  mean = mean(duration_sec)
), .(start_station_code, start_quartier)][, `:=`(
  start_station_code = NULL,
  start_quartier = NULL
)]

# Limiter moyenne des temps de trajet
limits <- c(650, 1150)
data_stations_rides[, capped_mean:=mean]
data_stations_rides[mean<limits[1], capped_mean:=limits[1]]
data_stations_rides[mean>limits[2], capped_mean:=limits[2]]

# Agréger sommaire par station
setkey(data_stations_rides, code)
setkey(data_stations, code)
data_stations[data_stations_rides, `:=`(
  quartier = quartier,
  rides_nb = nb,
  rides_mean = mean,
  rides_capped_mean = capped_mean
)]

# Sommaire par quartier
data_quartiers_rides <- data_stations[!is.na(quartier), .(
  nom = quartier,
  stations_nb = .N,
  rides_nb = sum(rides_nb),
  rides_mean = weighted.mean(rides_mean, rides_nb)
), quartier][, quartier:=NULL]

# Limiter moyenne des temps de trajet
data_quartiers_rides[, rides_capped_mean:=rides_mean]
data_quartiers_rides[rides_mean<limits[1], rides_capped_mean:=limits[1]]
data_quartiers_rides[rides_mean>limits[2], rides_capped_mean:=limits[2]]

# Agréger sommaire par quartier
setkey(data_quartiers_rides, nom)
#data_quartiers <- readOGR("data/LIMADMIN.shp")
data_quartiers_geo@data <- as.data.table(data_quartiers_geo@data, keep.rownames="ID")
data_quartiers_geo@data[, ID:=as.integer(ID)]
setkey(data_quartiers_geo@data, NOM)
data_quartiers_geo@data[data_quartiers_rides, `:=`(
  stations_nb = stations_nb,
  rides_nb = rides_nb,
  rides_mean = rides_mean,
  rides_capped_mean = rides_capped_mean
)]
setorder(data_quartiers_geo@data, ID)[, ID:=NULL]

# Création de la palette de couleur des quartiers
categorical_pal <- colorFactor(
  palette = rainbow(data_quartiers_geo@data[!is.na(stations_nb), .N]),
  domain = data_quartiers_geo@data[!is.na(stations_nb), as.character(NOM)]
)

# Création de la carte
exposure_map <- leaflet() %>%
  addTiles() %>%
  addMarkers(
    data = data_stations,
    group = "Stations",
    lng = ~longitude,
    lat = ~latitude,
    icon = makeIcon(
      iconUrl = "static-files/bixi-logo.png",
      iconWidth = ~8+rides_nb/1500,
      iconHeight = ~8+rides_nb/1500
    ),
    popup = ~paste(
      paste0("<b>", name, "</b>"),
      paste0("Nombre de trajets : ", format(rides_nb, big.mark=" ")),
      sep = "<br/>"
    ),
    label = ~name
  ) %>%
  addPolygons(
    data = data_quartiers_geo,
    group = "Quartiers",
    color = "black",
    weight = 2,
    fillColor = ~categorical_pal(NOM),
    fillOpacity = 0.35,
    dashArray = "2 4",
    popup = ~paste(
      paste0("<b>", NOM, "</b>"),
      paste0("Nombre de stations : ", format(stations_nb, big.mark=" ")),
      paste0("Nombre de trajets : ", format(rides_nb, big.mark=" ")),
      sep = "<br/>"
    ),
    highlightOptions = highlightOptions(
      weight = 3,
      opacity = 1,
      dashArray = FALSE
    )
  ) %>%
  addLegend(
    data = data_quartiers_geo@data[!is.na(stations_nb)],
    position = "bottomright",
    pal = categorical_pal,
    values = ~NOM,
    opacity = 1,
    labFormat = labelFormat(
      transform = function(values){lapply(values, function(value){
        data_quartiers_geo@data[NOM==value, as.character(ABREV)]
      })}
    ),
    title = "Quartiers",
    group = "Quartiers"
  ) %>%
  addLayersControl(
    overlayGroups = c("Stations", "Quartiers"),
    options = layersControlOptions(
      collapsed = FALSE
    )
  ) %>%
  hideGroup("Quartiers")

# Affichage de la carte
exposure_map

4.2 Corrélation entre les variables d’entrée

4.2.1 Status (catégorique) vs Quartier de la station de départ (catégorique)

data_quartiers_member <- data[, .(
  nb = .N,
  mean = mean(duration_sec)
), .(is_member, start_quartier)]

data_quartiers_member[is.na(start_quartier), start_quartier:="Hors MTL"]
data_quartiers_member[, status:=as.factor(ifelse(is_member, "Membre", "Non-Membre"))]

plot_ly(
  data = data_quartiers_member
) %>%
  add_bars(
    name = "Membres",
    hoverinfo = "y",
    showlegend = TRUE,
    x = ~start_quartier[status=="Membre"],
    y = ~nb[status=="Membre"],
    colors = "#1f77b4",
    xaxis = "x",
    yaxis = "y"
  ) %>%
  add_bars(
    name = "Non-membres",
    hoverinfo = "y",
    showlegend = TRUE,
    x = ~start_quartier[status=="Non-Membre"],
    y = ~nb[status=="Non-Membre"],
    colors = "#ff7f0e"
  ) %>%
  layout(
    xaxis = list(
      title = list(
        text = "Quartier"
      ),
      fixedrange = TRUE
    ),
    yaxis = list(
      title = list(
        text = "Nombre de trajets"
      ),
      fixedrange = TRUE,
      exponentformat = "none"
    ),
    legend = list(
      y = 0
    )
  )

4.3 Effets one-way

4.3.1 Status membre/non-membre (booléen/catégoriqe)

data_member_quantiles <- data[, .(quantiles=quantile(duration_sec, seq(0, 1, 0.25))), is_member]
data_member_quantiles[, status:=as.factor(ifelse(is_member, "Membre", "Non-Membre"))]

plot_ly(
  data = data_member
) %>%
  add_bars(
    name = "Nombre de trajets",
    hoverinfo = "y",
    showlegend = FALSE,
    x = ~status,
    y = ~nb,
    xaxis = "x",
    yaxis = "y2"
  ) %>%
  add_trace(
    data = data_member_quantiles,
    type = "box",
    name = "Quantiles",
    hoverinfo = "y",
    boxpoints = FALSE,
    x = ~status,
    y = ~quantiles,
    xaxis = "x",
    yaxis = "y"
  ) %>%
  add_trace(
    data = data_member,
    type = "scatter",
    mode = "markers",
    name = "Moyenne",
    hoverinfo = "y",
    x = ~status,
    y = ~mean,
    xaxis = "x",
    yaxis = "y"
  ) %>%
  layout(
    xaxis = list(
      title = list(
        text = "Status"
      ),
      fixedrange = TRUE
    ),
    yaxis = list(
      title = list(
        text = "Durée moyenne (sec)"
      ),
      side = "left",
      fixedrange = TRUE,
      exponentformat = "none",
      range = list(-1000, 3000)
    ),
    yaxis2 = list(
      title = list(
        text = "Nombre de trajets"
      ),
      overlaying = "y",
      side = "right",
      showgrid = FALSE,
      fixedrange = TRUE,
      exponentformat = "none",
      range = ~list(0, 4*max(nb))
    )
  )

4.3.2 Quartier de la station de départ (catégorique)

data_quartiers_quantiles <- data[, .(quantiles=quantile(duration_sec, seq(0, 1, 0.25))), start_quartier]
data_quartiers_quantiles[is.na(start_quartier), start_quartier:="Hors MTL"]

plot_ly(
  data = data_quartiers
) %>%
  add_bars(
    name = "Nombre de trajets",
    hoverinfo = "y",
    showlegend = FALSE,
    x = ~start_quartier,
    y = ~nb,
    xaxis = "x",
    yaxis = "y2"
  ) %>%
  add_trace(
    data = data_quartiers_quantiles,
    type = "box",
    name = "Quantiles",
    hoverinfo = "y",
    boxpoints = FALSE,
    x = ~start_quartier,
    y = ~quantiles,
    xaxis = "x",
    yaxis = "y"
  ) %>%
  add_trace(
    data = data_quartiers,
    type = "scatter",
    mode = "markers",
    name = "Moyenne",
    hoverinfo = "y",
    x = ~start_quartier,
    y = ~mean,
    xaxis = "x",
    yaxis = "y"
  ) %>%
  layout(
    xaxis = list(
      title = list(
        text = "Status"
      ),
      fixedrange = TRUE
    ),
    yaxis = list(
      title = list(
        text = "Durée moyenne (sec)"
      ),
      side = "left",
      fixedrange = TRUE,
      exponentformat = "none",
      range = list(-1000, 3000)
    ),
    yaxis2 = list(
      title = list(
        text = "Nombre de trajets"
      ),
      overlaying = "y",
      side = "right",
      showgrid = FALSE,
      fixedrange = TRUE,
      exponentformat = "none",
      range = ~list(0, 4*max(nb))
    )
  )

4.3.3 Date du trajet (temporelle)

• Observer l’effet de la tampérature sur la variable réponse en comparant avec une source externe;
• Suggère d’ajouter des transformations basées sur la température;

TO DO : Déplacer la transformation semaine/fds dans la section Transformations.

data_date[, weekend:=lubridate::wday(start_date, week_start = 7)%in%c(1, 7)]

plot_ly(
  data = data_date
) %>%
  add_bars(
    name = "Nombre de trajets",
    hoverinfo = "x+y",
    showlegend = FALSE,
    x = ~start_date,
    y = ~nb,
    xaxis = "x",
    yaxis = "y2"
  ) %>%
  add_trace(
    type = "scatter",
    mode = "lines",
    name = "Durée moyenne",
    hoverinfo = "y",
    x = ~start_date,
    y = ~mean,
    xaxis = "x",
    yaxis = "y"
  ) %>%
  add_trace(
    type = "scatter",
    mode = "lines",
    visible = "legendonly",
    name = "Fin de semaine",
    hoverinfo = "y",
    legendgroup = "weekend",
    x = ~start_date[weekend==TRUE],
    y = ~mean[weekend==TRUE],
    xaxis = "x",
    yaxis = "y"
  ) %>%
  add_trace(
    type = "scatter",
    mode = "lines",
    visible = "legendonly",
    name = "Semaine",
    hoverinfo = "y",
    legendgroup = "weekend",
    x = ~start_date[weekend==FALSE],
    y = ~mean[weekend==FALSE],
    xaxis = "x",
    yaxis = "y"
  ) %>%
  layout(
    xaxis = list(
      title = list(
        text = "Date du trajet"
      ),
      rangeslider = TRUE,
      fixedrange = TRUE
    ),
    yaxis = list(
      title = list(
        text = "Durée moyenne (sec)"
      ),
      side = "left",
      fixedrange = TRUE,
      exponentformat = "none"
    ),
    yaxis2 = list(
      title = list(
        text = "Nombre de trajets"
      ),
      overlaying = "y",
      side = "right",
      showgrid = FALSE,
      fixedrange = TRUE,
      exponentformat = "none",
      range = ~list(0, 4*max(nb))
    ),
    hovermode = "x",
    legend = list(
      y = -0.3
    )
  )

4.3.4 Heure du trajet (temporelle)

TO DO : Bouger la partie sur les moments de la journée dans la section Transformations.

data_time[, moment_journee := "nuit"]
data_time[start_hour >= 6 & start_hour < 11, moment_journee := "matin"]
data_time[start_hour >= 11 & start_hour < 16, moment_journee := "journee"]
data_time[start_hour >= 16 & start_hour < 23, moment_journee := "soir"]
data_time[, moment_journee:=as.factor(moment_journee)]

plot_ly(
  data = data_time
) %>%
  add_bars(
    name = "Nombre de trajets",
    hoverinfo = "x+y",
    showlegend = FALSE,
    x = ~time_min,
    y = ~nb,
    xaxis = "x",
    yaxis = "y2"
  ) %>%
  add_trace(
    type = "scatter",
    mode = "lines",
    name = "Durée moyenne",
    hoverinfo = "y",
    showlegend = FALSE,
    x = ~time_min,
    y = ~mean,
    xaxis = "x",
    yaxis = "y"
  ) %>%
  add_trace(
    type = "scatter",
    mode = "lines",
    visible = "legendonly",
    name = "Matin",
    hoverinfo = "none",
    legendgroup = "moment",
    x = ~time_min,
    y = ~ifelse(moment_journee=="matin", mean, NA),
    xaxis = "x",
    yaxis = "y"
  ) %>%
  add_trace(
    type = "scatter",
    mode = "lines",
    visible = "legendonly",
    name = "Journée",
    hoverinfo = "none",
    legendgroup = "moment",
    x = ~time_min,
    y = ~ifelse(moment_journee=="journee", mean, NA),
    xaxis = "x",
    yaxis = "y"
  ) %>%
  add_trace(
    type = "scatter",
    mode = "lines",
    visible = "legendonly",
    name = "Soir",
    hoverinfo = "none",
    legendgroup = "moment",
    x = ~time_min,
    y = ~ifelse(moment_journee=="soir", mean, NA),
    xaxis = "x",
    yaxis = "y"
  ) %>%
  add_trace(
    type = "scatter",
    mode = "lines",
    visible = "legendonly",
    name = "Nuit",
    hoverinfo = "none",
    legendgroup = "moment",
    x = ~time_min,
    y = ~ifelse(moment_journee=="nuit", mean, NA),
    xaxis = "x",
    yaxis = "y"
  ) %>%
  layout(
    xaxis = list(
      title = list(
        text = "Heure du trajet"
      ),
      rangeslider = TRUE,
      fixedrange = TRUE
    ),
    yaxis = list(
      title = list(
        text = "Durée moyenne (sec)"
      ),
      side = "left",
      fixedrange = TRUE,
      exponentformat = "none"
    ),
    yaxis2 = list(
      title = list(
        text = "Nombre de trajets"
      ),
      overlaying = "y",
      side = "right",
      showgrid = FALSE,
      fixedrange = TRUE,
      exponentformat = "none",
      range = ~list(0, 4*max(nb))
    ),
    hovermode = "x",
    legend = list(
      y = -0.4
    )
  )

4.3.5 Variables spatiales (stations + quartiers)

# Création de la palette de couleur pour les one way
oneway_pal <- colorNumeric(
  palette = "YlGnBu",
  domain = limits
)

# Création de la carte
oneway_map <- leaflet() %>%
  addTiles() %>%
  addCircleMarkers(
    data = data_stations,
    group = "Stations",
    lng = ~longitude,
    lat = ~latitude,
    radius = ~4+rides_nb/3000,
    color = "black",
    weight = 1,
    fillColor = ~oneway_pal(rides_capped_mean),
    fillOpacity = 0.5,
    popup = ~paste(
      paste0("<b>", name, "</b>"),
      paste0("Nombre de trajets : ", format(rides_nb, big.mark=" ")),
      paste0("Durée moyenne : ", format(rides_mean, digits=0, big.mark=" "), " sec"),
      sep = "<br/>"
    ),
    label = ~name
  ) %>%
  addPolygons(
    data = data_quartiers_geo,
    group = "Quartiers",
    color = "black",
    weight = 2,
    fillColor = ~oneway_pal(rides_capped_mean),
    fillOpacity = 0.5,
    dashArray = "2 4",
    popup = ~paste(
      paste0("<b>", NOM, "</b>"),
      paste0("Nombre de stations : ", format(stations_nb, big.mark=" ")),
      paste0("Nombre de trajets : ", format(rides_nb, big.mark=" ")),
      paste0("Durée moyenne : ", format(rides_mean, digits=0, big.mark=" "), " sec"),
      sep = "<br/>"
    ),
    highlightOptions = highlightOptions(
      weight = 3,
      opacity = 1,
      dashArray = FALSE
    )
  ) %>%
  addLegend(
    data = data_stations,
    position = "bottomright",
    pal = oneway_pal,
    values = ~rides_capped_mean,
    opacity = 1,
    labFormat = labelFormat(
      suffix = " sec",
      big.mark = " "
    ),
    title = "Durée moyenne"
  ) %>%
  addLayersControl(
    overlayGroups = c("Stations", "Quartiers"),
    options = layersControlOptions(
      collapsed = FALSE
    )
  ) %>%
  hideGroup("Quartiers")

# Affichage de la carte
oneway_map

4.4 Effet multi-ways

4.4.1 Status (catégorique) vs Quartier de la station de départ (catégorique)

data_quartiers_member_quantiles <- data[, .(quantiles=quantile(duration_sec, seq(0, 1, 0.25))), .(is_member, start_quartier)]
data_quartiers_member_quantiles[is.na(start_quartier), start_quartier:="Hors MTL"]
data_quartiers_member_quantiles[, status:=as.factor(ifelse(is_member, "Membre", "Non-Membre"))]

plot_ly(
  data = data_quartiers_member
) %>%
  add_bars(
    name = "Membres",
    hoverinfo = "y",
    showlegend = TRUE,
    legendgroup = "Membre",
    x = ~start_quartier[status=="Membre"],
    y = ~nb[status=="Membre"],
    colors = "#1f77b4",
    xaxis = "x",
    yaxis = "y2"
  ) %>%
  add_bars(
    name = "Non-membres",
    hoverinfo = "y",
    showlegend = TRUE,
    legendgroup = "Non-Membre",
    x = ~start_quartier[status=="Non-Membre"],
    y = ~nb[status=="Non-Membre"],
    colors = "#ff7f0e",
    xaxis = "x",
    yaxis = "y2"
  ) %>%
  add_trace(
    data = data_quartiers_member_quantiles,
    type = "box",
    name = "Quantiles",
    hoverinfo = "y",
    showlegend = FALSE,
    legendgroup = "Membre",
    boxpoints = FALSE,
    x = ~start_quartier[status=="Membre"],
    y = ~quantiles[status=="Membre"],
    line = list(
      color = "#1f77b4"
    ),
    fillcolor = "#7cbce9",
    xaxis = "x",
    yaxis = "y"
  ) %>%
  add_trace(
    data = data_quartiers_member_quantiles,
    type = "box",
    name = "Quantiles",
    hoverinfo = "y",
    showlegend = FALSE,
    legendgroup = "Non-Membre",
    boxpoints = FALSE,
    x = ~start_quartier[status=="Non-Membre"],
    y = ~quantiles[status=="Non-Membre"],
    line = list(
      color = "#ff7f0e"
    ),
    fillcolor = "#ffbb80",
    xaxis = "x",
    yaxis = "y"
  ) %>%
  add_trace(
    data = data_quartiers_member,
    type = "scatter",
    mode = "markers",
    name = "Moyenne",
    hoverinfo = "y",
    showlegend = FALSE,
    legendgroup = "Membre",
    x = ~start_quartier[status=="Membre"],
    y = ~mean[status=="Membre"],
    marker = list(
      color = "#1f77b4"
    ),
    xaxis = "x",
    yaxis = "y"
  ) %>%
  add_trace(
    data = data_quartiers_member,
    type = "scatter",
    mode = "markers",
    name = "Moyenne",
    hoverinfo = "y",
    showlegend = FALSE,
    legendgroup = "Non-Membre",
    x = ~start_quartier[status=="Non-Membre"],
    y = ~mean[status=="Non-Membre"],
    marker = list(
      color = "#ff7f0e"
    ),
    xaxis = "x",
    yaxis = "y"
  ) %>%
  layout(
    xaxis = list(
      title = list(
        text = "Quartier"
      ),
      fixedrange = TRUE
    ),
    yaxis = list(
      title = list(
        text = "Durée moyenne (sec)"
      ),
      side = "left",
      fixedrange = TRUE,
      exponentformat = "none",
      range = list(-1000, 3500)
    ),
    yaxis2 = list(
      title = list(
        text = "Nombre de trajets"
      ),
      overlaying = "y",
      side = "right",
      showgrid = FALSE,
      fixedrange = TRUE,
      exponentformat = "none",
      range = ~list(0, 5*max(nb))
    ),
    boxmode = "group",
    legend = list(
      y = 0
    )
  )

4.5 Proposition de transformations

4.5.1 Moment de la journée

4.5.1.1 Distribution

data_moment <- copy(data)
data_moment[, start_hour:=hour(start_date_time)]
data_moment[, moment_journee := "Nuit"]
data_moment[start_hour >= 6 & start_hour < 11, moment_journee := "Matin"]
data_moment[start_hour >= 11 & start_hour < 16, moment_journee := "Journée"]
data_moment[start_hour >= 16 & start_hour < 23, moment_journee := "Soir"]
data_moment[, moment_journee:=factor(moment_journee, c("Matin", "Journée", "Soir", "Nuit"))]

data_moment_quantiles <- data_moment[, .(quantiles=quantile(duration_sec, seq(0, 1, 0.25))), moment_journee]

data_moment <- data_moment[, .(
  nb = .N,
  mean = mean(duration_sec)
), moment_journee]

plot_ly(
  data = data_moment
) %>%
  add_bars(
    name = "Nombre de trajets",
    hoverinfo = "y",
    showlegend = FALSE,
    x = ~moment_journee,
    y = ~nb
  ) %>%
  layout(
    xaxis = list(
      title = list(
        text = "Status"
      ),
      fixedrange = TRUE
    ),
    yaxis = list(
      title = list(
        text = "Nombre de trajets"
      ),
      fixedrange = TRUE,
      exponentformat = "none"
    )
  )

4.5.1.2 Corrélation avec les autres variables

TO DO

4.5.1.3 Effet one-way

plot_ly(
  data = data_moment
) %>%
  add_bars(
    name = "Nombre de trajets",
    hoverinfo = "y",
    showlegend = FALSE,
    x = ~moment_journee,
    y = ~nb,
    xaxis = "x",
    yaxis = "y2"
  ) %>%
  add_trace(
    data = data_moment_quantiles,
    type = "box",
    name = "Quantiles",
    hoverinfo = "y",
    boxpoints = FALSE,
    x = ~moment_journee,
    y = ~quantiles,
    xaxis = "x",
    yaxis = "y"
  ) %>%
  add_trace(
    data = data_moment,
    type = "scatter",
    mode = "markers",
    name = "Moyenne",
    hoverinfo = "y",
    x = ~moment_journee,
    y = ~mean,
    xaxis = "x",
    yaxis = "y"
  ) %>%
  layout(
    xaxis = list(
      title = list(
        text = "Status"
      ),
      fixedrange = TRUE
    ),
    yaxis = list(
      title = list(
        text = "Durée moyenne (sec)"
      ),
      side = "left",
      fixedrange = TRUE,
      exponentformat = "none",
      range = list(-1000, 3000)
    ),
    yaxis2 = list(
      title = list(
        text = "Nombre de trajets"
      ),
      overlaying = "y",
      side = "right",
      showgrid = FALSE,
      fixedrange = TRUE,
      exponentformat = "none",
      range = ~list(0, 4*max(nb))
    )
  )

4.5.1.4 Effets multi-ways

TO DO

4.6 Sommaire des transformations retenues

• Moment de la journée
• Matin : 6h à 11h
• Journée : 11h à 16h
• Soir : 16h à 23h

• Nuit : 23h à 6h

• Semaine/Fin de semaine
• Semaine : Lundi, Mardi, Mercredi, Jeudi, Vendredi

• Fin de semaine : Samedi, Dimanche

• Regroupement des quartiers
• Groupe 1 : Plateau-Mont-Royal;
• Groupe 2 : Ville-Marie;
• Groupe 3 : Ahuntsic-Cartierville, Villeray-Saint-Michel-Parc-Extension, Rosemont-La Petite-Patrie, Mercier-Hochelaga-Maisonneuve;
• Groupe 4 : Outremont, Côte-des-Neiges-Notre-Dame-de-Grâce, Westmount, Le Sud-Ouest, Verdun, LaSalle;

• Groupe 5 : Autre.

4.6.1 Données externes à explorer

• Météo
• FSAs au lieu de quartiers
• Réseau de métro
• Jours fériés
• Dates de festivals

4.6.2 Transformations à explorer (sur données déjà disponibles)

• Meilleur regroupement des moments de la journée
• Distance avec les autres quartiers
• Distance avec le fleuve (~bordures de la carte des quartiers)