Laden der Libraries

library(tidyverse)

## Registered S3 methods overwritten by 'ggplot2':
##   method         from 
##   [.quosures     rlang
##   c.quosures     rlang
##   print.quosures rlang

## Registered S3 method overwritten by 'rvest':
##   method            from
##   read_xml.response xml2

## ── Attaching packages ──────────────────────────────────────────────────────────────────────────────── tidyverse 1.2.1 ──

## ✔ ggplot2 3.1.1       ✔ purrr   0.3.2  
## ✔ tibble  2.1.1       ✔ dplyr   0.8.0.1
## ✔ tidyr   0.8.3       ✔ stringr 1.4.0  
## ✔ readr   1.3.1       ✔ forcats 0.4.0

## ── Conflicts ─────────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()

library(nycflights13)

Zusammenfügen der einzelnen Dataframes, hier Flights & Carrier

Anstatt das Ergebnis direkt anzuzeigen (also den Ausdruck in Klammern zu setzen), wird das Ergebnis erst einmal in einem Objekt gespeichert und dann die ersten 5 Zeilen ausgegeben (Befehl “head”). Hintergrund ist, dass ein nach HTML oder PDF exportiertes Notebook bei der Größe des Datensatzes einfach zu groß werden würde.

my_flights <- flights %>%
  left_join(airlines, by ="carrier") %>%
  rename(airline = name)
head(my_flights)

Flights & Airports

my_flights <- my_flights %>%
  left_join(airports, c("dest" = "faa")) %>%
  rename(airport = name)
head(my_flights)

Flights & Weather

my_flights <- my_flights %>%
  left_join(weather)

## Joining, by = c("year", "month", "day", "origin", "hour", "time_hour")

head(my_flights)

Flights & Planes

my_flights <- my_flights %>%
  left_join(planes, by = "tailnum")
head(my_flights)

Hier ist zu beachten, dass beide Datensätze die Variable “year” beinhalten. Beim Datensatz “flights” sagt uns “year” in welchem Jahr der Flug stattfindet, im Datensatz “planes” wann das Flugzeug gebaut wurde. R disambiguiert die beiden Variablen, indem sie einen Suffix erhalten (x und y)

Änderung der Temperatur von Fahrenheit auf Celsius

my_flights <- my_flights %>%
  mutate(temp_c = (temp-32)/1.8)
head(my_flights)

Departure Delay vs Arrival Delay

my_flights %>%
  select(dep_delay,arr_delay) %>%
  filter(dep_delay > 10) %>%
  plot()

Offensichtlich schaffen es einige Flüge trotz geringem Departure Delay trotzdem ein viel höheres Arrival Delay aufzubauen. Die Korrelation ist hier klar erkennbar, sie wird aber dennoch noch einmal geprüft:

my_flights %>%
  select(dep_delay,arr_delay) %>%
  filter(dep_delay > 10) %>%
  filter(!is.na(dep_delay)) %>%
  filter(!is.na(arr_delay)) %>%
  cor()

##           dep_delay arr_delay
## dep_delay 1.0000000 0.9420843
## arr_delay 0.9420843 1.0000000

Abflugszeit

my_flights %>%
  select(dep_time,dep_delay) %>%
  plot()

my_flights %>%
  select(dep_time,dep_delay) %>%
  filter(!is.na(dep_time)) %>%
  filter(!is.na(dep_delay)) %>%
  cor()

##            dep_time dep_delay
## dep_time  1.0000000 0.2602312
## dep_delay 0.2602312 1.0000000

Interessant ist, dass die ersten Flüge morgens weniger Verspätung haben, und tatsächlich sehen wir hier eine schwache Korrelation.

Distanz

my_flights %>%
  select(distance,dep_delay) %>%
  plot()

Kein Zusammenhang erkennbar.

Flugzeit

my_flights %>%
  select(air_time,arr_delay) %>%
  plot()

Kein Zusammenhang erkennbar.

Humidity

my_flights %>%
  select(humid,dep_delay) %>%
  plot()

Kein Zusammenhang erkennbar.

Temperatur

my_flights %>%
  select(temp_c,dep_delay) %>%
  plot()

Kein Zusammenhang erkennbar.

Windgeschwindigkeit

my_flights %>%
  select(wind_speed,dep_delay) %>%
  plot()

Kein Zusammenhang erkennbar.

my_flights %>%
  select(wind_speed,dep_delay) %>%
  filter(!is.na(wind_speed)) %>%
  filter(!is.na(dep_delay)) %>%
  cor()

##            wind_speed  dep_delay
## wind_speed 1.00000000 0.04742427
## dep_delay  0.04742427 1.00000000

Niederschlag

my_flights %>%
  select(precip,dep_delay) %>%
  plot()

my_flights %>%
  select(precip,dep_delay) %>%
  filter(!is.na(dep_delay)) %>%
  filter(!is.na(precip)) %>%
  cor()

##               precip  dep_delay
## precip    1.00000000 0.09040014
## dep_delay 0.09040014 1.00000000

Kein Zusammenhang erkennbar.

Luftdruck

my_flights %>%
  select(pressure,dep_delay) %>%
  plot()

Kein Zusammenhang erkennbar.

Visibility in Meilen

my_flights %>%
  select(visib,dep_delay) %>%
  plot()

Kein Zusammenhang erkennbar.

Anzahl der Engines

engines_delay <- my_flights %>%
  select(engines,dep_delay) %>%
  filter(!is.na(dep_delay)) %>%
  filter(!is.na(engines))
boxplot(log(engines_delay$dep_delay)~engines_delay$engines, varwidth=TRUE)

## Warning in log(engines_delay$dep_delay): NaNs produced

## Warning in bplt(at[i], wid = width[i], stats = z$stats[, i], out =
## z$out[z$group == : Outlier (-Inf) in boxplot 1 is not drawn

## Warning in bplt(at[i], wid = width[i], stats = z$stats[, i], out =
## z$out[z$group == : Outlier (-Inf) in boxplot 2 is not drawn

## Warning in bplt(at[i], wid = width[i], stats = z$stats[, i], out =
## z$out[z$group == : Outlier (-Inf) in boxplot 4 is not drawn

Kein Zusammenhang erkennbar.

Anzahl der Sitze im Flieger

…es könnte ja sein, dass, je mehr Passagiere einsteigen könnten, es auch mehr zu Verzögerungen kommen kann…

my_flights %>%
  select(seats,dep_delay) %>%
  plot()

my_flights %>%
  select(seats,dep_delay) %>%
  filter(!is.na(seats)) %>%
  filter(!is.na(dep_delay)) %>%
  cor()

##                 seats   dep_delay
## seats      1.00000000 -0.05463222
## dep_delay -0.05463222  1.00000000

Kein Zusammenhang erkennbar.

Liegt es am Carrier?

boxplot(my_flights$arr_delay[my_flights$arr_delay > 20]~my_flights$carrier[my_flights$arr_delay > 20], varwidth=TRUE, xlab="Carrier", ylab="Minuten Verspätung", las=2)

Da man hier nicht so viel sieht, können wir die Daten wieder logarithmisieren:

boxplot(log(my_flights$arr_delay[my_flights$arr_delay > 20])~my_flights$carrier[my_flights$arr_delay > 20], varwidth=TRUE, xlab="Carrier", las = 2) 

ExpressJet Airlines führt viele Flüge durch und hat bei den Verspätungen den höchsten Median. Auch Endeavor Air scheint mehr Verspätungen zu haben als die Marktbegleiter. Bei Alaska Airlines und den anderen Airlines mit dem dünnen Boxplot-Körper sind die Daten zu dünn, aber Skywest Airlines scheint hier die rote Laterne zu tragen.

Zusammenfassung

Die einzige (schwache) Korrelation, die wir gesehen haben, ist die Uhrzeit. Morgens scheint es weniger zu Verspätungen zu kommen, vielleicht auch, weil die Maschinen dann schon da sind. Verspätungen scheinen also aufeinander aufzubauen, bis zu einem bestimmten Punkt.

Transformieren der Daten, es wird ein Wochentag als Faktor hinzugefügt

my_flights <- my_flights %>%
  mutate(my_wday = paste(day,"-",month,"-", year.x, sep="")) %>%
  mutate(the_date = as.Date(my_wday, '%d-%m-%Y')) %>%
  mutate(wday = weekdays(as.Date(my_wday, '%d-%m-%Y'))) %>%
  mutate(wday = factor(wday, levels = c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday")))
head(my_flights)

Anzahl der Flüge pro Tag

(flights_per_day <- my_flights %>%
  select(wday,the_date)%>%
  group_by(wday,the_date)%>%
  mutate(sum_flights = n())%>%
  unique()%>%
  arrange(the_date))

flights_per_day %>%
  ungroup() %>%
  select(the_date,sum_flights) %>%
  plot(., type = "l")

Hier sind bereits einige Ausreißer nach unten zu sehen, zum Beispiel Anfang Juli.

Anzahl der Flüge pro Wochentag

boxplot(flights_per_day$sum_flights~flights_per_day$wday, xlab = "", ylab = "Anzahl Flüge", las=2,varwidth=TRUE,)

Identifizieren von Ausreißern

Hierzu werden die Werte der unteren Whisker-Antennen genutzt:

a <- boxplot(flights_per_day$sum_flights~flights_per_day$wday, plot = FALSE)
a$stats

##        [,1] [,2]   [,3] [,4]   [,5]  [,6]  [,7]
## [1,]  928.0  938  918.0  927  926.0 674.0 875.0
## [2,]  965.0  949  955.0  966  966.0 689.5 891.5
## [3,]  982.5  965  973.5  983  980.5 747.0 907.5
## [4,]  992.5  975  984.0  993  993.0 779.5 916.0
## [5,] 1004.0 1001 1014.0 1006 1002.0 857.0 934.0
## attr(,"class")
##    Monday 
## "integer"

Damit nicht alle Daten einzeln händisch abgetippt werden müssen, wird ein Dataframe aus der ersten Zeile gebildet

outlier <- as.vector(a$stats[1,])
wday <- c("Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday")
b <- as.data.frame(cbind(wday,outlier))

Dieser Dataframe b (kein toller Name!) wird nun mit dem flights_per_day Dataframe gemergt und dann geschaut, an welchem Tag die Abweichungen über die Interquartiel Range gegangen sind:

flights_per_day %>%
  left_join(b) %>%
  ungroup() %>%
  mutate(outlier = as.integer(as.character(outlier))) %>%
  mutate(res = ifelse(sum_flights<outlier,sum_flights-outlier,0)) %>%
  select(the_date,res) %>%
  plot(.,type="l")

## Joining, by = "wday"

## Warning: Column `wday` joining factors with different levels, coercing to
## character vector

Dasselbe wird noch mal als Liste ausgegeben:

flights_per_day %>%
  left_join(b) %>%
  ungroup() %>%
  mutate(outlier = as.integer(as.character(outlier))) %>%
  mutate(res = ifelse(sum_flights<outlier,sum_flights-outlier,0)) %>%
  select(the_date,res) %>%
  filter(res<0)

## Joining, by = "wday"

## Warning: Column `wday` joining factors with different levels, coercing to
## character vector

Generell scheint im Januar weniger geflogen zu werden. Auffallend ist der 26.5. (Memorial Day am 27.5., d.h. die Geschäftsreisenden sind nicht am Sonntag schon für Meetings am 27.5. losgeflogen), der 4.7. (Nationalfeiertag), das Wochenende Ende November (Thanksgiving) und Weihnachten und Neujahr.

Warum wird Samstags weniger geflogen?

Eine Annahme könnte sein, dass Geschäftsleute Samstags weniger fliegen, Sonntag dann aber wieder mehr, um an einem frühen Termin am nächsten Tag woanders teilnehmen zu können.

my_flights %>%
  filter(wday == "Sunday") %>%
  select(hour) %>%
  group_by(hour) %>%
  summarize(n = n()) %>%
  plot(.,type="l")

my_flights %>%
  filter(wday == "Wednesday") %>%
  select(hour) %>%
  group_by(hour) %>%
  summarize(n = n()) %>%
  plot(.,type="l")

Tatsächlich wird Sonntags am Nachmittag stärker weggeflogen. Schauen wir uns einmal die Ziele an:

my_flights %>%
  filter(wday == "Sunday") %>%
  select(dest) %>%
  group_by(dest) %>%
  summarize(n = n()) %>%
  arrange(desc(n))

Atlanta, Chicago und Los Angeles sind die Haupt-Destinations am Sonntag:

my_flights %>%
  filter(wday == "Thursday") %>%
  select(dest) %>%
  group_by(dest) %>%
  summarize(n = n()) %>%
  arrange(desc(n))

Am Donnerstag ist Boston dabei, die Spitzenreiter bleiben gleich.

my_flights %>%
  filter(wday == "Saturday") %>%
  select(dest) %>%
  group_by(dest) %>%
  summarize(n = n()) %>%
  arrange(desc(n))

Am Samstag haben wir Orlando drin in Florida, der am Donnerstag weiter unten ist. Wir sehen am Sonntag also etwas mehr die Flugmuster eines Wochentags als die eines Samstags.