De opdracht

Voor het vak Software Engineering hebben wij een case opdracht gekregen om een blog te schrijven. Wij hebben ervoor gekozen om onderzoek te doen naar verscheidene oorzaken van vertragingen en uitvallen binnen de NS.

Wij maken gebruik van 2 datasets, beide te vinden op de site: www.rijdendetreinen.nl

Datasets: Treinstoringen 2011 t/m 2019 en CSV-bestand met alle stations in Nederland

Wij willen gedurende onderzoek antwoord geven op de volgende vragen:

• Hoe ziet het treinverkeer er in Nederland uit?

• Neemt het aantal defecte treinen de laatste jaren af?

• Spelen omgevingsfactoren een belangrijke rol?

• Is er een trend te vinden met het aantal aanrijdingen per personen?

Wanneer wij antwoord hebben gegeven op de bovenstaande onderzoeksvragen willen wij uiteindelijk antwoord geven op onze hoofdvraag:

• Wat zijn de grootste pijnpunten van de NS over de afgelopen 8 jaar?

Hoe ziet het treinverkeer er in Nederland uit?

De kaart van Nederland: Voordat het onderzoek begint, moet er eerst worden afgebakend wat er concreet wordt onderzocht. Uit onderstaande map kan er worden afgelezen dat er veel, vooral stoptreinstations, verspreid zijn over het hele land. Wat ook heel goed te zien is op deze kaart is dat er rondom het hele land, langs de grenzen van de Noordzee, België en Duitsland als het ware een lijn is te zien die de kaart van Nederland tekent. Daarnaast kun je van de kaart aflezen dat van het oosten naar het westen meerdere treinlijnen samenkomen op het drukste station van Nederland, Utrecht Centraal.

stations <- stations %>%
  mutate(n = as.integer(type))


pal <- colorFactor(
  palette = c("green", "pink", "red", "blue", "orange", "yellow", "purple", "cyan"),
  domain =  stations$n
)
pal1 <- colorFactor(
  palette = c("green", "pink", "red", "blue", "orange", "yellow", "purple", "cyan"),
  domain =  stations$type
)

Map_Nederland <- leaflet(data = stations) %>%
  addTiles()  %>% 
  setView(lng = 5.1101691, lat = 52.0893191, zoom = 7) %>%
  addProviderTiles("CartoDB") %>%
  addCircles(lng = ~geo_lng, 
             lat = ~geo_lat,
             weight = 0,
             radius = 2000,
             fillColor = ~pal(n),
             label = ~name_long,
             fillOpacity = 10) %>%
  addLegend("topleft",  pal = pal1, values = stations$type, title = "Station")
Map_Nederland

Top 5 trajecten met de meeste defecte treinen:"

storing_rdt <- separate_rows(storing_cl, rdt_lines, sep = ", ", convert = FALSE)

storing_def2 <- storing_rdt %>%
  filter(cause_nl == "defecte trein") %>%
  group_by(rdt_lines) %>%
  count(rdt_lines) %>%
  arrange(desc(n))

storing_def2 <- storing_def2[1:5, ]

pal3 <- colorFactor(
  palette = c("red", "purple", "orange", "green", "lightblue"),
  domain =  storing_def2$rdt_lines
)


Top5_Map <- leaflet(data = storing_def2) %>%
  addTiles()  %>% 
  setView(lng = 5.1101691, lat = 52.0893191, zoom = 8) %>%
  addProviderTiles("CartoDB") %>%
  addPolylines(lng = c(4.900272, 4.8382975, 4.7682744), lat = c(52.3791283, 52.3890302, 52.3105386), color = "red") %>%
  addPolylines(lng = c(4.4694783, 4.7682744), lat = c(51.9244818,   52.3105386), color = "lightblue") %>%
  addPolylines(lng = c(4.7797223, 4.4694783), lat = c(51.5810111,   51.9244818), color = "purple") %>%
  addPolylines(lng = c(4.480527, 4.7682744), lat = c(52.164675, 52.3105386), color = "orange") %>%
  addPolylines(lng = c(5.4727185, 5.05853435200663, 4.7682744), lat = c(52.5079328, 52.30444305, 52.3105386), color = "green") %>%
  addLegend(position = "bottomright", pal = pal3, values = ~rdt_lines, title = "Traject")

Top5_Map

Neemt het aantal defecte treinen de laatste jaren af?

Welke storingen komen het vaakst voor per jaar: Het begin van de analyse is ook de basis voor diepgaandere onderzoeken. Als eerste wordt er in dit onderzoek onderzocht hoe frequent een bepaalde melding daadwerkelijk voorkomt, hoeveel minuten dit duurt en of er een trend is te zien over de afgelopen acht jaar.

Op onderstaande histogram, figuur 1, is het aantal meldingen per soort oorzaak gesorteerd. Hieruit kan je aflezen dat er zes duidelijke uitschieters zijn in het geheel, namelijk: beperkingen in het materieelinzet, defect spoor, defecte spoorbrug, persoon op het spoor, uitloop van werkzaamheden, verstoringen elders. Er zijn hier drie onduidelijke variabelen waar op dit moment nog niets mee gedaan kan worden, namelijk: beperkingen in het materieelinzet, uitloop van werkzaamheden en verstoringen elders. Op deze drie variabelen zijn nog heel veel vragen open: Welk materieel is beperkt, welke werkzaamheden lopen uit en waar ontstaan de verstoringen elders? Op de drie andere variabelen spreekt de oorzaak eigenlijk voor zich en die kunnen verder worden gebruikt voor dit onderzoek.

Het aantal meldingen hoeft niet per definitie een probleem te zijn, hoewel er natuurlijk veel tijd zit in het doen van een melding en deze op te lossen. Om te kijken welke oorzaken het meeste tijd kosten, worden deze meegenomen in de volgende deelvraag.

Figuur1 <- storing_cl %>%
  group_by(cause_nl) %>%
  summarize(Aantal = n())

ggplot(Figuur1, aes(x = cause_nl, y = Aantal)) +
  geom_bar(stat = "identity", color="orangered4", fill="orangered4") +  
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
  ylim(0,500) +
  labs(title = "Het aantal storingen per oorzaak", x = "Oorzaak", y = "Aantal meldingen per soort")

De gemiddelde duur van een storing per oorzaak: Om specifieker te kunnen analyseren welke oorzaken voor de grootste problemen zorgen. Wordt er met dit onderzoek onderzocht hoelang een storing per oorzaak gemiddeld duurt. Uiteindelijk zijn de oorzaken die voor de meeste verspilling aan tijd zorgen, de oorzaken die het langst duren om opgelost te worden.

Wat er in het onderstaande figuur, figuur 2, goed zichtbaar gemaakt wordt is dat er vier grote uitschieters zijn die er meteen uitgehaald kunnen worden, namelijk: beperkingen in het materieelinzet, een defecte wissel, meerdere verstoringen en wateroverlast. Nu zijn de variabelen: meerdere verstoringen en beperkingen in het materieelinzet vrij vaag en geven niet specifiek aan waar het nou aan ligt. De andere twee variabelen: wateroverlast en een defecte wissel geven wel heel specifiek aan wat de storing inhoudt.

Figuur2 <- storing_cl %>%
  group_by(cause_nl) %>%
  mutate(GemTijd = round(mean(duration_minutes))) %>%
  select(cause_nl, GemTijd) %>%
  unique()

ggplot(Figuur2, aes(x = cause_nl, y = GemTijd)) +
  geom_bar(stat = "identity", color="orangered4", fill="orangered4") +  
  theme_minimal() +
  labs(title = "De gemiddelde duur van een storing per oorzaak", x = "Oorzaak", y = "Gemiddelde tijd (min)") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
  ylim(0, 500) 

Trend in aantal defecte treinen: Nu het totaal duidelijk in kaart is gebracht van het aantal meldingen en de gemiddelde tijd dat een bepaalde storing duurt voordat het is opgelost. Kan er worden onderzocht of er een trend is te zien in de laatste jaren. Uit onderstaand nieuwsbericht blijkt dat het aantal reizigers per jaar toeneemt. Kunnen we hier een trend ontdekken? Of is er een trend in het aantal specifieke maanden, oftewel is er meer vertraging in de winter dan in de zomer?

Het aantal treinreizigers is tussen begin 2015 en eind 2019 met 14 procent gegroeid. NS verwacht dat de groei de komende jaren door zal zetten. Dat heeft het spoorbedrijf donderdag bekend gemaakt. NS: 14% reizigersgroei in 5 jaar

Figuur 3 geeft aan dat er vanaf begin 2017, het aantal defecte treinen toeneemt. Het is een trend die ook niet meer afneemt. De pieken en dalen zijn dan uiteraard nog wel te zien maar dalen niet meer terug naar het niveau van de jaren hiervoor.

storing_def <- storing_cl %>%
  filter(cause_nl == "defecte trein") %>%
  mutate(start_time = as.POSIXct(start_time, format = c("%Y-%m-%d %H:%M:%S")), 
         end_time = as.POSIXct(end_time, format = c("%Y-%m-%d %H:%M:%S"))) %>%
  mutate(RoundStart = round_date(start_time, unit = "month"), RoundEnd = round_date(end_time, unit = "month"))

Figuur3 <- storing_def %>%
  group_by(RoundStart) %>%
  mutate(Aantal = n()) %>%
  select(RoundStart, Aantal) %>% 
  unique()

ggplot(Figuur3, aes(x = RoundStart, y = Aantal)) +
  geom_point(size = 0.7) +
  geom_line(color = "orangered4") +
  theme_minimal() +
  labs(title = "Het aantal defecte treinen per maand vanaf 2017", x = "Tijd (Maand)", y = "Aantal defecte treinen")

De bovenstaande trend is goed te verklaren: Daarnaast is het goed om je te realiseren dat er sinds 2017 ook meer storingen gemeld zijn, omdat NS toen een nieuw systeem heeft geintroduceerd waarmee ook kortdurende storingen sneller gemeld werden. Het aantal storingen vanaf 2017 vergelijken met het aantal storingen in de jaren daarvoor is daardoor niet goed mogelijk (tenzij je alle kortdurende storingen niet meetelt). www.rijdendetreinen.nl

Trend in aantal defecte treinen vanaf 2017: Hoewel de gemiddelde tijdsduur nog steeds relevant blijft, verandert dit wel het aantal meldingen. Om goed in kaart te brengen of er een trend is in het aantal meldingen per maand, wordt de scope verkleind. Dit wordt gedaan om te onderzoeken of er in het najaar (herfst en winter) er meer meldingen zijn dan in het voorjaar (lente en zomer). Een van de aannames was, voordat dit onderzoek begon, dat de weeromstandigheden een belangrijke factor is voor het aantal vertragingen.

In figuur 4 kunt u zien dat er zeven momenten van significante stijging is. Deze zeven stijgingen lijken op het eerste oog geen verband met elkaar te hebben. Echter zie je dat deze zeven momenten gebeuren op het moment dat de tempratuur heel erg stijgt (mei t/m augustus), of heel erg daalt (november t/m februari).

storing_def <- storing_cl %>%
  filter(cause_nl == "defecte trein") %>%
  mutate(start_time = as.POSIXct(start_time, format = c("%Y-%m-%d %H:%M:%S")), 
         end_time = as.POSIXct(end_time, format = c("%Y-%m-%d %H:%M:%S"))) %>%
  mutate(RoundStart = round_date(start_time, unit = "month"), RoundEnd = round_date(end_time, unit = "month"))


# De gemiddelde stakingsduur per jaar   
Figuur4 <- storing_def %>%
  group_by(RoundStart) %>%
  mutate(Aantal = n()) %>%
  select(RoundStart, Aantal) %>% 
  filter(RoundStart >= "2017-01-01") %>%
  unique()

ggplot(Figuur4, aes(x = RoundStart, y = Aantal)) +
  geom_point() +
  geom_line(color = "orangered4") +
  theme_minimal() +
  labs(title = "Het aantal defecte treinen per maand vanaf 2017", x = "Tijd (Maand)", y = "Aantal defecte treinen")

Voordat dit onderzoek werd gedaan was er een sterk vermoeden dat er een causaal verband is tussen slecht weer(regen en sneeuw) en het aantal defecte treinen. Echter hebben ook hoge temperaturen een zichtbaar causaal verband met het aantal defecte treinen. Hier was op voorhand niet aan gedacht. De pieken halverwege 2017, 2018 en 2019 zouden toch verklaard moeten kunnen worden? Onderstaand nieuwsbericht vertelt ons het volgende:

De NS kan door de hitte minder treinen dan gebruikelijk inzetten op drie drukke trajecten. Het gaat om de hoge snelheidslijn (HSL) tussen Amsterdam - Schiphol - Rotterdam en de verbinding tussen Amsterdam-Eindhoven en Eindhoven-Heerlen. Doordat de treinen gisteren urenlang zijn blootgesteld aan hoge temperaturen, hebben ze meer en langer onderhoud nodig en kan er dus minder materieel worden ingezet. NS dunt dienstregeling uit: Door lange blootstelling aan hitte meer onderhoud nodig

Gemiddelde tijdsduur per jaar: Om een conclusie aan de storingen te kunnen verbinden moet er nog onderzocht worden of er een trend is te ontdekken in de gemiddelde tijdsuur van de storingen over de laatste jaren. Enerzijds omdat het aantal meldingen pas vanaf 2017 representatief is, maar anderzijds omdat de totale tijdsduur het gegeven is wat de reizigers daadwerkelijk raakt.

Op figuur5 is er te zien dat er een lineaire groei te zien is in de jaren 2011 t/m 2019. Met uitzondering van de grote pieken in 2012 en 2018. Op de deelvraag “Neemt het aantal defecte treinen de laatste jaren af?” kan er duidelijk geconcludeerd worden dat dit niet het geval is.

Date <- separate(storing_cl, start_time, c("start", "time"))

#Figuur5
Figuur5 <- Date %>%
  group_by(start) %>%
  mutate(GemTijd = mean(duration_minutes/60))


ggplot(Figuur5, aes(x = start, y = GemTijd)) +
  geom_bar(stat = "identity", color="orangered4", fill="orangered4") +  
  theme_minimal() +   
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
  labs(title = "Het gemiddelde tijdsduur van storingen per jaartal", x = "Het jaartal", y = "Gemiddeld aantal in uren")

Spelen omgevingsfactoren een belangrijke rol?

Bij de vorige vraag stond het proces vanuit NS zelf centraal. Daar bleek dat het weer een belangrijke factor is in het aantal vertragingen. Uiteraard is het makkelijk om de verantwoordelijkheid volledig bij NS te leggen maar welke omgevingsfactoren kunnen er meer een belangrijke invloed hebben op het rijden op de tijden volgens de normale dienstregeling.

Van Veldhoven benadrukt dat mensen “natuurlijk” het recht hebben om te staken en dat dit “uiteraard” ook geldt voor de mensen die bij het openbaar vervoer werken. “Maar voor al die reizigers die van het openbaar vervoer afhankelijk zijn, is dit echt heel vervelend. Ik hoop dat de mensen die gaan staken dat weten en ook meewegen.” NS en kabinet waarschuwen reizigers voor ov-staking dinsdag

storing_staking <- storing_cl %>%
  filter(cause_nl == "staking") %>%
  mutate(start_time = as.POSIXct(start_time, format = c("%Y-%m-%d %H:%M:%S")), 
         end_time = as.POSIXct(end_time, format = c("%Y-%m-%d %H:%M:%S")))

  
storing_staking2 <- separate(storing_staking, start_time, c("start", "time"))

Totaal_minuten <- sum(storing_staking2$duration_minutes)
Totaal_uren <- Totaal_minuten / 60
Totaal_uren

## [1] 2235.867

Er is dus een totaal van 2235 uren gestaakt over de laatste zeven jaar. Dat is enorm veel tijd. Om inzichtelijk te krijgen hoe dit per jaar is verdeeld, is dit visueel gemaakt in het onderstaande figuur, figuur6. Een belangrjke vermelding is dat in de jaren 2013 en 2017 er geen stakingen zijn geweest.

#Figuur6
Figuur6 <- storing_staking2 %>%
  group_by(start) %>%
  mutate(GemTijd = round(mean(duration_minutes))) %>%
  select(start, GemTijd) %>%
  unique()
  
ggplot(Figuur6, aes(x = start, y = GemTijd, group = 1)) +
  geom_bar(stat = "identity", color="darkred", fill="orangered4") +  
  theme_minimal() +
  labs(title = "Het gemiddelde tijdsduur van stakingen per jaartal", x = "Het jaartal", y = "Gemiddeld aantal in minuten")

Het bovenstaande figuur laat zien dat er met name in het jaar 2018 enorm veel gestaakt is. Een conclusie tussendoor vanuit figuur5 leert ons ook dat dit het jaar met de meeste storingen is geweest. Het gemiddelde van het totaal is relevant om te kijken hoe het aantal minuten in staking zich verhoudt op de andere storingen.

Om kritischer te kijken naar puur de impact van stakingen is figuur7 gemaakt:

Figuur7 <- storing_staking2 %>%
  group_by(start) %>%
  mutate(Tijd = sum(duration_minutes)) %>%
  select(start, Tijd) %>%
  unique()
  
ggplot(Figuur7, aes(x = start, y = Tijd, group = 1)) +
  geom_bar(stat = "identity", color="darkred", fill="orangered4") +  
  theme_minimal() +
  labs(title = "De totale stakingsduur per jaar in minuten", x = "Het jaartal", y = "Totale tijd in minuten")

Is er een trend te vinden met het aantal aanrijdingen per personen?

Tijdens de brainstormsessie bleek dat we erg nieuwsgierig waren naar het aantal aanrijdingen per persoon. De NS werkt samen met verscheidene dienstverleners zoals de politie en ambulance, om aanrijdingen met personen te voorkomen. Toch leefde bij ons het gevoel dat dit de laatste jaren toeneemt.

Allereerst laten figuur8 zien dat ons gevoel gedeeltelijk klopt. De laatste drie jaar nemen het aantal aanrijdingen toe:

#summary(storing_cl$cause_nl)

storing_aan <- storing_cl %>%
  filter(cause_nl == "aanrijding met een persoon") %>%
  mutate(start_time = as.POSIXct(start_time, format = c("%Y-%m-%d %H:%M:%S")), 
         end_time = as.POSIXct(end_time, format = c("%Y-%m-%d %H:%M:%S"))) %>%
  mutate(RoundStart = round_date(start_time, unit = "year"), 
         RoundEnd = round_date(end_time, unit = "year"))


Figuur8 <- storing_aan %>%
  group_by(RoundStart) %>%
  mutate(Aantal = n()) %>%
  select(RoundStart, Aantal) %>% 
  filter(RoundStart >= "2012-01-01", RoundStart < "2020-01-01") %>%
  unique()

ggplot(Figuur8, aes(x = RoundStart, y = Aantal)) +
  geom_point() +
  geom_line(color = "orangered4") +
  labs(title = "Het aantal aanrijdingen met personen per maand van de afgelopen 8 jaar", x = "Tijd (Maand)", y = "Aantal aanrijdingen met een persoon") 

Om dit te kunnen verklaren is een onderzoek nodig wat veel verder gaat dan het analyseren van de data die wij gebruiken om de NS te analyseren. Wat wel een interessant onderwerp is of er maanden zijn dat er significante verschillen zijn. Bijvoorbeeld: Zorgt een ‘winterdepressie’ voor meer aanrijdingen met personen.

Bij figuur9 zijn de maanden met elkaar vergeleken. Zo zijn alle maanden December van de jaren 2011 t/m 2019 bij elkaar opgeteld. Met de reden om te kunnen vaststellen of onze vraag beantwoord kan worden:

storing_aan <- storing_cl %>%
  filter(cause_nl == "aanrijding met een persoon") %>%
  mutate(start_time = as.POSIXct(start_time, format = c("%Y-%m-%d %H:%M:%S")), 
         end_time = as.POSIXct(end_time, format = c("%Y-%m-%d %H:%M:%S"))) %>%
  mutate(RoundStart = round_date(start_time, unit = "month"), 
         RoundEnd = round_date(end_time, unit = "month"))

storing_aan2 <- separate(storing_aan, start_time, c("start", "time"))

plaatje9 <- storing_aan2 %>%
  group_by(time) %>%
  mutate(Aantal = n()) %>%
  select(time, Aantal) %>% 
  unique()

ggplot(plaatje9, aes(x = time, y = Aantal)) +
  geom_bar(stat = "identity", color="orangered4", fill="orangered4") +  
  theme_minimal() + 
  ylim(0, 250) +
  labs(title = "Het aantal aanrijdingen met personen per maand van de afgelopen 8 jaar", x = "Tijd (Maand)", y = "Aantal aanrijdingen met een persoon") 

Helaas hebben wij geen significante verschillen kunnen ontdekken. Er zit een groei in oktober en november maar om vast te kunnen stellen of dit een bepaald causaal verband met zich mee brengt door bijvoorbeeld dit te vergelijken met de winterdepressie zijn de waardes van december t/m februari te laag. De maand februari heeft de laagste waarde, ook dit kan niet geheel worden uitgelegd. De enige logische verklaring die er op dit moment kan worden getrokken is dat februari minder dagen heeft als januari en maart.

Wat zijn de grootste pijnpunten van de NS over de afgelopen 8 jaar?

De NS kent enorm veel redenen waarom treinen defect zijn of vertraagd op plaats van bestemming aankomen. Echter zien wij dat veel van de oorzaken niet specifiek worden aangegeven zoals: materieelproblemen en meerdere verstoringen en beperkingen. Wat veranderd zou kunnen worden is de zaken die veel worden gemeld specifieker omschrijven. Materieelproblemen kunnen worden gedefinieerd in welke materieelproblemen er daadwerkelijk zijn om specifieker op onderzoek te kunnen gaan naar de oorsprong van het probleem zodat deze in de toekomst kunnen worden voorkomen.

Daarnaast kan er geconcludeerd worden dat het weer een belangrijk impact heeft op de staat van het spoort en de treinen. Er zijn veel meldingen over wateroverlast en zien dat in veel periodes wanneer de tempratuur toeneemt maar ook heel erg daalt, er veel meer vertraging is dan gemiddeld. Hierin is het belangrijk dat de NS blijft investeren in het “futureproof” maken van het spoor waardoor het beter bestemd is tegen wateroverlast, kou en warmte.

Nawoord

Wij hebben tijdens dit project veel geleerd over het onderzoeken naar en het cleanen van data over een voor ons interessant onderwerp. We zijn meer te weten gekomen over het aantal vertragingen en de oorzaken hiervan. Daarnaast hebben wij voor het vak Software Engeneering veel geleerd over het maken van relevante grafieken die ons meer vertellen over de werkelijkse situatie.