Vilniaus viešojo transporto vėlavimų analizė su dplyr

Niekada iki šiol nenaudojau dplyr R paketo, tad norėjau pasižiūrėti, kaip jis veikia (o veikia jis tikrai patogiai!). Kadangi neseniai buvo paviešinti Vilniaus Viešojo Transporto vėlavimų duomenys, tai kaip tik šis duomenų rinkinys pasirodė tinkamas pasižaidimui.

Pirmiausia, ką reikėjo padaryti, tai parsisiųsti duomenis:

git clone https://github.com/vilnius/transportas-velavimai.git

Tada įsikrauname reikiamas bibliotekas.

In [1]:
options(jupyter.plot_mimetypes = "image/png")
library(dplyr)
library(stringr)
library(lubridate)
library(ggplot2)
Attaching package: 'dplyr'

The following objects are masked from 'package:stats':

    filter, lag

The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union


Attaching package: 'lubridate'

The following object is masked from 'package:base':

    date

Kadangi duomenys pateikiami padieniui atskiruose failuose, tai juos visus nusiskaitom ir sudedam į vieną duomenų lentelę. MacOSX sistemoje viskas veikė be žagsėjimų (bet ten ir lokalė kita), o ant Linux kilo problemų dėl UTF-8 Byte Order Mark: sako, jog Windows sistemos tokį mėgsta sugeneruoti failo pradžioje ir tai kartais klaidina kitas sistemas. Tad su funkcija remove.BOM nugnybam tuos nereikalingus baitus.

Be to, kiekvieno failo pavadinimas yra duomenų data, o šita informacija mums bus reikalinga. Išsisaugom prie kiekvieno įrašo.

In [2]:
remove.BOM <- function(df) { names(df)=c(substring(names(df)[1], 5),names(df)[-1]); df; } 

path <- '/home/moxliukas/notebooks/transportas-velavimai/rpt3/'
files <- list.files(path=paste0(path, "."), pattern="2*.tsv")
traffic <- NULL
for (f in files) {
  dat <- read.table(paste0(path, f), header=T, encoding="UTF-8-BOM", sep="\t")
  dat <- remove.BOM(dat)
  dat$fname <- basename(f)
  traffic <- rbind(traffic, dat)
}

Dabar keletas duomenų pamanipuliavimų:

  • reik ištrint įrašus, kurie pilni brūkšniukų (visada antra CSV failo eilutė tokia)
  • reik FaktTrips, PlanTrips ir RegularTrips pversti į normalius skaičius, o ne faktorius
  • paskaičiuojam faktinių ir nevėluojančių kelionių procentą
  • ignoruojam įrašus, kur kas nors dalijama iš nulio
  • jei autobuso pavadinime yra 'ž', tai pažymim, jog tai žemagrindis autobusas
  • išskaičiuojam datą
  • išskaičiuojam iš datos savaitės dieną
In [3]:
traffic %>%
  filter(Marsrutas != '---------') %>%
  mutate(FaktTrips = as.numeric(as.character(FaktTrips))) %>%
  mutate(PlanTrips = as.numeric(as.character(PlanTrips))) %>%
  mutate(RegularTrips = as.numeric(as.character(RegularTrips))) %>%
  mutate(fakt_proc = FaktTrips / PlanTrips) %>%
  mutate(not_late = RegularTrips / FaktTrips) %>%
  mutate(effectiveness = RegularTrips / PlanTrips) %>%
  filter(!is.nan(effectiveness)) %>%
  filter(!is.nan(not_late)) %>%
  mutate(zemagrindis = str_detect(Pavadinimas, 'ž')) %>%
  mutate(Date = str_sub(fname, 0, -5)) %>%
  mutate(Date = as.Date(Date)) %>%
  mutate(weekday = wday(as.Date(Date))) -> traffic

Braižom grafiką, kokią dalį suplanuotų kelionių kasdien įvykdė VVT ir privatūs vežėjai

In [4]:
traffic %>%
  group_by(Date, Operator) %>%
  summarize(avg_effectiveness = mean(effectiveness, rm.na=TRUE)) %>%
  ggplot(aes(x=Date, y=avg_effectiveness, color=Operator, group=Operator)) + geom_point() + geom_smooth()
Warning message:
: Removed 2 rows containing non-finite values (stat_smooth).Warning message:
: Removed 2 rows containing missing values (geom_point).

Atrodo, jog privatūs vežėjai dažniausiai efektyvesni ir tvarkingai įvykdo didesnį procentą suplanuotų kelionių. O ar galima teigti, kad privatūs vežėjai yra punktualesni?

In [5]:
traffic %>%
  group_by(Date, Operator) %>%
  summarize(avg_not_late = mean(not_late, rm.na=TRUE)) %>%
  ggplot(aes(x=Date, y=avg_not_late, color=Operator, group=Operator)) + geom_point() + geom_smooth()
Warning message:
: Removed 2 rows containing non-finite values (stat_smooth).Warning message:
: Removed 2 rows containing missing values (geom_point).

Atrodo, jog tai statistiškai patikima: Privatūs vežėjai vėluoja rečiau. O gal yra skirtumas tarp autobusų ir troleibusų?

In [6]:
traffic %>%
  group_by(Date, Transportas) %>%
  summarize(avg_effectiveness = mean(not_late, rm.na=TRUE)) %>%
  ggplot(aes(x=Date, y=avg_effectiveness, color=Transportas, group=Transportas)) + geom_point() + geom_smooth()
Warning message:
: Removed 2 rows containing non-finite values (stat_smooth).Warning message:
: Removed 2 rows containing missing values (geom_point).

Troleibusai yra patikimesnė transporto priemonė nei autobusai. Pažiūrėkim, ar priklauso vėlavimas nuo savaitės dienos.

In [7]:
traffic %>%
     mutate(weekday=wday(Date, label=T)) %>% 
     filter(!is.na(weekday)) %>% 
     group_by(weekday) %>%
     summarize(avg_effectiveness = mean(not_late, rm.na=TRUE)) %>%
     ggplot(aes(weekday, avg_effectiveness)) + geom_bar(stat="identity") + 
      xlab("Savaites diena") + ylab("Reisai be velavimu")

Savaitgaliais vėlavimų mažiau, o paprastomis savaitės dienomis nuo pirmadienio iki penktadienio reikalai vis blogėja. Panaši istorija kartojasi tiek su autobusais, tiek su troleibusais.

In [8]:
traffic %>%
    mutate(weekday=wday(Date, label=T)) %>% filter(!is.na(weekday)) %>% group_by(weekday, Transportas) %>%
    summarize(avg_effectiveness = mean(not_late, rm.na=TRUE)) %>%
    ggplot(aes(weekday, avg_effectiveness, fill=Transportas)) + geom_bar(stat="identity", position="dodge") +
      xlab("Savaites diena") + ylab("Reisai be velavimu")
In [9]:
traffic %>%
    mutate(weekday=wday(Date, label=T)) %>% filter(!is.na(weekday)) %>% group_by(weekday, Operator) %>%
    summarize(avg_not_late = mean(not_late, rm.na=TRUE)) %>%
    ggplot(aes(weekday, avg_not_late, fill=Operator)) + geom_bar(stat="identity", position="dodge") + 
      xlab("Savaites diena") + ylab("Reisai be velavimu")
In [ ]:

In [ ]: