Correction TD3
Pierre-O Goffard
17 janvier 2019
TD 3
Exercice 1
1)
On va utiliser le jeu de données nycflights13
library(nycflights13)
library(tidyverse)## -- Attaching packages --------------------------------------- tidyverse 1.3.0 --## v ggplot2 3.3.3 v purrr 0.3.4
## v tibble 3.0.5 v dplyr 1.0.3
## v tidyr 1.1.2 v stringr 1.4.0
## v readr 1.4.0 v forcats 0.5.0## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()data(flights)Trouver tout les vols - ayant eu plus de deux heures de retard - vers Houston (IAH ou HOU), on utilisera l’opérateur %in% - opérés durant l’été (Juillet, Aout, Septembre) - ayant eu plus de deux heures de retards mais sans retard au départ - Ont décollé entre minuit et 6 heure du matin
# Vols avec plus de deux heures de retard
flights %>% filter(arr_delay /60 > 2) %>% select(arr_delay)## # A tibble: 10,034 x 1
## arr_delay
## <dbl>
## 1 137
## 2 851
## 3 123
## 4 145
## 5 127
## 6 125
## 7 136
## 8 123
## 9 123
## 10 138
## # ... with 10,024 more rows# Vols vers Houston
flights %>% filter(dest %in% c('IAH', 'HOU')) %>% select(dest)## # A tibble: 9,313 x 1
## dest
## <chr>
## 1 IAH
## 2 IAH
## 3 IAH
## 4 IAH
## 5 IAH
## 6 IAH
## 7 IAH
## 8 IAH
## 9 IAH
## 10 IAH
## # ... with 9,303 more rows#Vols d'été
flights %>% filter(month >= 7 & month <= 9) %>% select(month)## # A tibble: 86,326 x 1
## month
## <int>
## 1 7
## 2 7
## 3 7
## 4 7
## 5 7
## 6 7
## 7 7
## 8 7
## 9 7
## 10 7
## # ... with 86,316 more rows#Vols ayant eu plus de deux heures de retards mais sans retard au départ
flights %>% filter(dep_delay == 0 & arr_delay /60 > 2) %>% select(dep_delay, arr_delay)## # A tibble: 3 x 2
## dep_delay arr_delay
## <dbl> <dbl>
## 1 0 130
## 2 0 128
## 3 0 140# Vols ayant décollé entre minuit et 6 heures du matin inclus
flights %>% filter(floor(dep_time / 100) < 6 | dep_time == 600) %>% select(dep_time)## # A tibble: 9,344 x 1
## dep_time
## <int>
## 1 517
## 2 533
## 3 542
## 4 544
## 5 554
## 6 554
## 7 555
## 8 557
## 9 557
## 10 558
## # ... with 9,334 more rows2)
Fusionner les tables flights et airlines, ne conserver que les variables òrigin, dest, name, et carrier et les vols par United, American ou Delta airline. Utiliser un pipe pour accomplir ces actions, et l’opérateur like pour la sélection des observations.
library(DescTools)
left_join(flights, airlines, by = 'carrier') %>% select(origin, dest, carrier, name) %>% filter(name %like% "United%" | name %like% "American%" | name %like% "Delta%")## # A tibble: 139,504 x 4
## origin dest carrier name
## <chr> <chr> <chr> <chr>
## 1 EWR IAH UA United Air Lines Inc.
## 2 LGA IAH UA United Air Lines Inc.
## 3 JFK MIA AA American Airlines Inc.
## 4 LGA ATL DL Delta Air Lines Inc.
## 5 EWR ORD UA United Air Lines Inc.
## 6 LGA ORD AA American Airlines Inc.
## 7 JFK LAX UA United Air Lines Inc.
## 8 EWR SFO UA United Air Lines Inc.
## 9 LGA DFW AA American Airlines Inc.
## 10 EWR LAS UA United Air Lines Inc.
## # ... with 139,494 more rows3)
Créer une table flights_V1 à partir de la table flights en ajoutant une variable permettant le calcul du temps rattrapé en vol, puis sélectionner les vols qui sont partis avec au moins une heure de retard mais sont parvenu à récupéré plus de 30 minutes durant le vol. N’inclure que les variables origin, dest, carrier, dep_delay, distance ainsi que la nouvelle variable. Afficher les cinq premières observations de flights_V1, copier et coller le tableau.
library(knitr)
flights_V1 <- flights %>% mutate(
in_flight = dep_delay - arr_delay
) %>% filter(dep_delay / 60 > 1 & in_flight > 30) %>% select(origin, dest, carrier, dep_delay, in_flight, distance)
kable(flights_V1[1:5, ])| origin | dest | carrier | dep_delay | in_flight | distance |
|---|---|---|---|---|---|
| EWR | MIA | AA | 285 | 39 | 1085 |
| JFK | LAS | B6 | 116 | 43 | 2248 |
| EWR | SFO | UA | 162 | 34 | 2565 |
| JFK | EGE | AA | 99 | 33 | 1747 |
| JFK | SFO | AA | 65 | 37 | 2586 |
flights_V1[1:5, ]## # A tibble: 5 x 6
## origin dest carrier dep_delay in_flight distance
## <chr> <chr> <chr> <dbl> <dbl> <dbl>
## 1 EWR MIA AA 285 39 1085
## 2 JFK LAS B6 116 43 2248
## 3 EWR SFO UA 162 34 2565
## 4 JFK EGE AA 99 33 1747
## 5 JFK SFO AA 65 37 25864)
Trier flights du vol avec le plus de retard au départ au vols ayant le moins de retard (voire de l’avance), n’inclure que les variables carrier, origin, dest et dep_delay.
flights %>% arrange(desc(dep_delay)) %>% select(carrier, origin, dest, dep_delay)## # A tibble: 336,776 x 4
## carrier origin dest dep_delay
## <chr> <chr> <chr> <dbl>
## 1 HA JFK HNL 1301
## 2 MQ JFK CMH 1137
## 3 MQ EWR ORD 1126
## 4 AA JFK SFO 1014
## 5 MQ JFK CVG 1005
## 6 DL JFK TPA 960
## 7 DL LGA MSP 911
## 8 DL JFK PDX 899
## 9 DL LGA ATL 898
## 10 AA EWR MIA 896
## # ... with 336,766 more rows5)
Créer la table flights_V2 à partir de flights dans laquelle les variables dep_time et sched_dep_time en nombre de minutes depuis minuit. N’inclure que les variables dep_time, sched_dep_time et les deux nouvelles variables qu’on appellera dep_time_V1et sched_dep_time_V1. Afficher les 5 première observations en utilisant
kable() pour copier et coller votre tableau, pas de code R.
flights_V2 <- flights %>% mutate(
dep_time_V1 = floor(dep_time / 100) * 60 + (dep_time - floor(dep_time / 100) * 100),
sched_dep_time_V1 = floor(sched_dep_time / 100) * 60 + (sched_dep_time - floor(sched_dep_time / 100) * 100)
) %>% select(dep_time, dep_time_V1, sched_dep_time, sched_dep_time_V1)
flights_V2[1:5, ]## # A tibble: 5 x 4
## dep_time dep_time_V1 sched_dep_time sched_dep_time_V1
## <int> <dbl> <int> <dbl>
## 1 517 317 515 315
## 2 533 333 529 329
## 3 542 342 540 340
## 4 544 344 545 345
## 5 554 354 600 3606)
Créer une table average_delay donnant le retard moyen à l’arrivées des vols et le nombre de vols pour chaque mois. Tracer le retard moyen en fonction du mois de l’année.
- Le graphique doit être un nuage de point pondéré par le nombre de vol.
- Donner un nom à l’axe des abscisses et des ordonnées.
- Faites en sorte que la graduation de l’axe des x fasse bien apparaître chaque mois.
- Ajouter la droite x = 0 comme ligne horizontale de référence
average_delay <- group_by(flights, month) %>%
summarise(n_flight = n(), av_delay = mean(arr_delay, na.rm = T))
ggplot(data = average_delay) + geom_point(mapping = aes(x = month, y = av_delay, size = n_flight)) + xlab("Mois de l'année") + ylab("Retard moyen enregistré") + geom_hline(yintercept = 0) + scale_x_continuous(breaks = 1:12)
### 7) Créer une table average_daily_America_United qui donne le retard moyen à l’arrivée des vols et le nombre de vols pour chaque jour des compagnies American et United airline. Tracer le retard moyen en fonction du jour de l’année pour les deux compagnies, le jour de l’année doit être donné par une variable date_dep sous le format Date. Le graphique doit contenir la courbe associée à chacune des compagnies, utiliser la fonction geom_smooth afin de lisser les courbes. Coller simplement l’image, pas de code R.
library(DescTools)
average_daily_America_United <- left_join(flights, airlines, by = 'carrier') %>%
filter(name %like% 'American%' | name %like% 'United%') %>%
mutate(date_dep = as.Date(paste0(day, '/', month, '/', year), format = '%d/%m/%Y')) %>%
group_by(date_dep, name) %>%
summarise(average_daily_delay = mean(arr_delay, na.rm = T))## `summarise()` has grouped output by 'date_dep'. You can override using the `.groups` argument.ggplot(data = average_daily_America_United, mapping = aes(x = date_dep, y = average_daily_delay, colour = name)) + geom_smooth()## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
### 8) On souhaite créer un tableau contenant le pourcentage de vol en retard par combinaison compagnie aérienne / aéroport de départ. Créer la table worst_delay contenant les variables carrier, origin, number_delay, number_flight et prop_delay. La table donne pour chaque combinaison de modalité sur les variables carrier et origin:
- le nombre de vol en retard
number_delay - le nombre de vol total `number_flight
- la proportion de vol en retard
prop_delay
Trier la table suivant la variable prop_delay de façon à afficher d’abord les combinaisons compagnie aérienne / aéroport de départ ayant la plus grande proportion de vol en retard. Afficher les cinq premières observations de worst_delay.
worst_delay <- left_join(
flights %>% mutate(delaid = arr_delay > 0) %>% group_by(carrier, origin, delaid) %>% summarize(number_delay = n()) %>% filter(!is.na(delaid)),
flights %>% group_by(carrier, origin) %>% summarize(number_flight = n()), by = c('carrier', 'origin')) %>% mutate(prop_delay = number_delay / number_flight) %>% arrange(desc(prop_delay)) %>% select(-delaid)## `summarise()` has grouped output by 'carrier', 'origin'. You can override using the `.groups` argument.## `summarise()` has grouped output by 'carrier'. You can override using the `.groups` argument.worst_delay[1:5, ]## # A tibble: 5 x 5
## # Groups: carrier, origin [5]
## carrier origin number_delay number_flight prop_delay
## <chr> <chr> <int> <int> <dbl>
## 1 AS EWR 520 714 0.728
## 2 HA JFK 245 342 0.716
## 3 DL JFK 14206 20701 0.686
## 4 VX EWR 1070 1566 0.683
## 5 OO EWR 4 6 0.667