R-ohjelmointi.org

Tilastotieteellistä ohjelmointia R-kielellä

HSL:n datapaketti joukkoliikenteestä

Helsingin kaupunginvaltuutettu Otso Kivekäs mainitsi blogikirjoituksessaan pari kuukautta takaperin HSL:n datapaketista, josta löytyy pääkaupunkiseudun bussien ja ratikoiden saapumis- ja lähtöajankohdat kullakin pysäkillä. Data-paketissa on aineistoa noin viikon ajalta tammikuulta 2013.

Datalle on helppo kuvitella useitakin käyttötarkoituksia, mutta koska en ole aiemmin tutustunut joukkoliikenneaineistoon, yritin saada aineiston luonteesta yleissilmäyksen tekemällä muutamia kaavioita eri bussilinjoista hahmottaakseni keskimääräisten ajoaikojen hajontaa linjan matkalla. Lisäksi olin erityisen kiinnostunut linjasta 52, jolla kuljen silloin tällöin. Olen jo pitkään ihmetellyt, kulkeeko bussi jotenkin hyvin epäsäännöllisesti, koska se tuntuu toisinaan tulevan pysäkille hyvin myöhässä. Tämän aineiston perusteella käsitykseni ei saanut vahvistusta, pikemminkin päinvastoin. Bussi nimittäin kulkee varsin ajallaan, jopa joitakin minuutteja etuajassa aikatauluun verrattuna, ja olen siis itse ollut myöhässä kun olen tullut pysäkille viime tingassa!

Ladataanpa ensin itse datapaketti. Aineisto on zip-pakatussa tiedostossa, ja R:ää käyttäen se voidaan ladata verkon yli ja purkaa lennossa. Funktiolla download.file() ladataan tiedosto, ja kun se on ladattu väliaikaiskansioon, puretaan pakkaus funktiolla unz(), ja samalla luetaan purettu data R:ään komennolla read.table():

temp <- tempfile()
download.file("http://tuukka.kapsi.fi/tmp/visudata/hastusgps20130114-20130120.zip",temp)
d <- read.table(unz(temp, "hastusgps20130114-20130120.rdm"), header=F, sep=";")
unlink(temp)

Tiedoston sarakkeiden sisältö on kuvattu aavistuksen kryptisesti, mutta sarake 4 sisältää linjan tunnuksen, sarake 5 linjan ajosuunnan, sarake 7 pysäkin juoksevan numeron, sarake 10 ajopäivän, sarake 11 aikataulun mukaisen ohitusajan ja sarake 12 havaitun ohitusajan.

Tutkitaanpa seuraavaksi tarkemmin linjan 52 tietoja. Lasketaan ensin linjakohtaiset havaintojen lukumäärät, ja asetetaan muuttujan i arvoksi 14, sillä se vastaa linjaa 52, jolta on siis järjestyksessä 14. eniten havaintoja. Poimitaan sitten pelkästään linjan 52 tiedot erilliseksi aineistoksi d2:

linjat<-rownames(data.frame(sort(table(d$V4), decreasing=T)))
i<-14
d2<-d[d$V4==linjat[i],]

Lasketaan seuraavaksi hieman lisätietoja. Koska tavoitteena on laskea aikataulun ja havaitun pysäkiltä lähtöajan välinen erotus, on dataa ensin tarpeen hieman muokata. Aikataulun mainitsemassa ajassa on nimittäin aika minuutin tarkkuudella, havaituissa ajoajoissa puolestaan ovat mukana myös sekunnit. Lisäksi jos ajan tuntiosa on alle 10, puuttuu siitä etunolla, mikä ei toimi yhteen komennon strptime() kanssa. Ennen aikojen erotusten laskemista on siis tarpeen lisätä aikoihin etunollat, mikä onnistuu komentoa formatC() käyttäen. Optiolla flag=0 komento lisää lukuihin etunollia kunnes määrätty merkitsevien numeroiden tarkkuus saavutetaan. Kun aikojen erot on laskettu, poistetaan aineistosta pysäkit ennen lähtöpysäkkiä ja kuvataan kunkin pysäkin ohitusaikoja keskiarvolla, ja keskihajonnalla sekä empiirisellä 95% välillä:

a1<-d2[which(d2$V11=="14/01/2013" & d2$V5==2),]
a2<-d2[which(d2$V11=="15/01/2013" & d2$V5==2),]
a3<-d2[which(d2$V11=="16/01/2013" & d2$V5==2),]
a4<-d2[which(d2$V11=="17/01/2013" & d2$V5==2),]
a5<-d2[which(d2$V11=="18/01/2013" & d2$V5==2),]
a6<-d2[which(d2$V11=="19/01/2013" & d2$V5==2),]
a7<-d2[which(d2$V11=="20/01/2013" & d2$V5==2),]
a<-rbind(a1, a2, a3, a4, a5, a6, a7)
a$V10<-formatC(a$V10, format="fg", digits=3, flag=0)
a$V13<-formatC(a$V13, format="fg", digits=5, flag=0)
a$aikataulu<-strptime(paste(a$V11, a$V10), format="%d/%m/%Y %H%M")
a$havlahto <-strptime(paste(a$V11, a$V13), format="%d/%m/%Y %H%M%S")
a$erotus<-difftime(a$havlahto, a$aikataulu, units="secs")
a$erotusm<-difftime(a$havlahto, a$aikataulu, units="mins")
a$lahtotunti<-substr(a$havlahto, 12, 13)
a<-a[a$V7>=0,]
ag<-data.frame(aggregate(a$erotus, list(a$V7), function(x) mean(x, na.rm=T)), sd=aggregate(a$erotus, list(a$V7), function(x) sd(x, na.rm=T))$x)
agq<-aggregate(a$erotus, list(a$V7), function(x) quantile(x, c(0.025, 0.975), na.rm=T))
 
a1<-d2[which(d2$V11=="14/01/2013" & d2$V5==1),]
a2<-d2[which(d2$V11=="15/01/2013" & d2$V5==1),]
a3<-d2[which(d2$V11=="16/01/2013" & d2$V5==1),]
a4<-d2[which(d2$V11=="17/01/2013" & d2$V5==1),]
a5<-d2[which(d2$V11=="18/01/2013" & d2$V5==1),]
a6<-d2[which(d2$V11=="19/01/2013" & d2$V5==1),]
a7<-d2[which(d2$V11=="20/01/2013" & d2$V5==1),]
a<-rbind(a1, a2, a3, a4, a5, a6, a7)
a$V10<-formatC(a$V10, format="fg", digits=3, flag=0)
a$V13<-formatC(a$V13, format="fg", digits=5, flag=0)
a$aikataulu<-strptime(paste(a$V11, a$V10), format="%d/%m/%Y %H%M")
a$havlahto <-strptime(paste(a$V11, a$V13), format="%d/%m/%Y %H%M%S")
a$erotus<-difftime(a$havlahto, a$aikataulu, units="secs")
a$erotusm<-difftime(a$havlahto, a$aikataulu, units="mins")
a$lahtotunti<-substr(a$havlahto, 12, 13)
a<-a[a$V7>=0,]
ag2<-data.frame(aggregate(a$erotus, list(a$V7), function(x) mean(x, na.rm=T)), sd=aggregate(a$erotus, list(a$V7), function(x) sd(x, na.rm=T))$x)
agq2<-aggregate(a$erotus, list(a$V7), function(x) quantile(x, c(0.025, 0.975), na.rm=T))

Kun yllä olevalla koodilla on laskettu tarvittavat tiedot, voidaan bussin reitistä ja ohitusajoista piirtää kaavioita. Seuraava koodi piirtää linjan reitille erillisen kuvan kummastakin ajosuunnasta. Vaaka-akselilla on kunkin pysäkin järjestysnumero alusta loppuun, ja pystyakselilla on aikataulun ilmoittaman ajan ja havaitun lähtöajan erotus. Kukin piste kuvaa yhtä havaintoa. Paksu punainen viiva ilmoittaa kunkin pysäkin aikaerojen keskiarvon, ja vaaleampi punainen alue ilmoittaa sen välin, jolle 95% havainnoista sijoittuu. Itse koodissa ei ole mitään ihmeellistä, ainoastaan tavanomaista kuvien veivausta R:llä:

 
par(mfrow=c(2,1))
 
par(mar=c(5,5,5,5))
plot(x=min(ag2$Group.1):max(ag2$Group.1), y=ag2$x, type="l", lwd=2, ylim=c(-1000, 1000), main=paste("Linja ", d2$V4[1], "suunta 1", sep=""), xlab="Pysäkki", ylab="Ero aikataulusta keskimäärin (s)", las=1)
abline(h=c(seq(0, 1000, 60), seq(0, -1000, -60)), col="grey85")
abline(v=c(0,10,20,30,40,50,60), col="grey85")
polygon(x=c(min(ag2$Group.1):max(ag2$Group.1), rev(min(ag2$Group.1):max(ag2$Group.1))), y=c(agq2$x[,2], rev(agq2$x[,1])) , col="#CC000022", border=NA)
axis(side=4, at=c(seq(0, 1000, 60), -seq(0, 1000, 60)), labels=c(seq(0, 1000, 60), seq(0, -1000, -60))/60, las=1, cex.axis=0.75)
mtext(side=4, line=3, text="Ero aikataulusta keskimäärin (m)")
for(j in min(ag2$Group.1):max(ag$Group.1)) {
   points(x=rep(j, length(a$erotus[a$V7==j])), y=a$erotus[a$V7==j], pch=16, cex=0.5)
}
lines(x=min(ag2$Group.1):max(ag2$Group.1), y=ag2$x, col="#CC0000", lwd=4)
abline(h=0, col="black")
box()
 
par(mar=c(5,5,5,5))
plot(x=min(ag$Group.1):max(ag$Group.1), y=ag$x, type="l", lwd=2, ylim=c(-1000, 1000), main=paste("Linja ", d2$V4[1], "suunta 2", sep=""), xlab="Pysäkki", ylab="Ero aikataulusta keskimäärin (s)", las=1)
abline(h=c(seq(0, 1000, 60), seq(0, -1000, -60)), col="grey85")
abline(v=c(0,10,20,30,40,50,60), col="grey85")
polygon(x=c(min(ag$Group.1):max(ag$Group.1), rev(min(ag$Group.1):max(ag$Group.1))), y=c(agq$x[,2], rev(agq$x[,1])) , col="#CC000022", border=NA)
axis(side=4, at=c(seq(0, 1000, 60), -seq(0, 1000, 60)), labels=c(seq(0, 1000, 60), seq(0, -1000, -60))/60, las=1, cex.axis=0.75)
mtext(side=4, line=3, text="Ero aikataulusta keskimäärin (m)")
for(j in min(ag$Group.1):max(ag$Group.1)) {
   points(x=rep(j, length(a$erotus[a$V7==j])), y=a$erotus[a$V7==j], pch=16, cex=0.5)
}
lines(x=min(ag$Group.1):max(ag$Group.1), y=ag$x, col="#CC0000", lwd=4)
abline(h=0, col="black")
box()

Lopputuloksen syntyy seuraava kuva:

Alemmassa kuvassa on linjan 52 toisinaan käyttämäni ajosuunta. Esimerkiksi pysäkillä 27 bussi on toisinaan etuajassa, jopa viisi minuuttia, mutta se voi toisaalta olla myöhässäkin, muttei juuri koskaan yli 11 minuuttia, mikä on vähemmän kuin vuoroväli. Oletukseni, että bussi on pahasti myöhässä, jos sitä ei kuulu ennen kuin seuraava vuoro on jo paikalla, on siis todennäköisesti väärä. Jos odotusaika on yli 5 minuuttia aikatauluun merkityn ajan, on bussi todennäköisesti jo mennyt, mutten vain ole ehtinyt siihen. Jos siis jatkossa olen viimeistään 4 minuuttia ennen aikatauluun merkittyä ohitusaikaa pysäkillä, minulla pitäisi olla hyvät mahdollisuudet ennättää kyytiin.

Ylipäätään aineistoa tarkasteltuani havaitsin linjojen välillä kiintoisia eroja. Suurimmalla osalla linjoista aikataulun ja havaitun ajan erotusten hajonta kasvaa linjan loppua kohden, muttei suinkaan kaikilla. Joillakin linjoilla hajonta pysyy jokseenkin tasaisena koko linjan matkalla. Toisaalta sellaisia linjoja, joilla hajonta pienenisi loppua kohden ei juurikaan ole. En osaa sanoa, miksi joillakin linjoilla hajonta säilyy vakioisena, mutta jokin selitys siihen varmasti on. Todennäköisesti esimerkiksi linjan pituus ja matkustajamäärä vaikuttavat asiaan. Esimerkki jokseenkin tasaisen hajonnan linjasta on 71. Vastaavasti linjoilla 54 ja 506 hajonta suorastaa räjähtää käsiin. Paras linjahan olisi varmasti sellainen, joka olisi mahdollisimman hyvin ajallaan paikalla, ja jonka hajonta olisi mahdollisimman pientä. Eri linjoilla on varmasti erilaisia keinoja vaikuttaa tähän asiaan.

Tässä aineistossa on yhden viikon raapaisu HSL:n aineistosta, enkä ole viitsinyt puhdistaa sitä mm. poikkeavista havainnoista kovinkaan tarkkaan, koska olin enemmänkin kiinnostunut yleiskatsauksesta. Aineisto on kuitenkin tavattoman mielenkiintoinen ja monikäyttöinen, ja olisi hyvin toivottavaa saada HSL:ltä lisää vastaavankaltaisia avauksia, vaikka HSL on toki jo tähänkin mennessä kiitettävästi avannut tietovarastojaan esimerkiksi avoimen rajapinnan kautta.

Kuvat 164 linjasta, joilta on eniten havaintoja.

2 Responses to “HSL:n datapaketti joukkoliikenteestä”

  • Otso Kivekäs kirjoitti:

    Kysymys: kuinka moni noista epäluotettavista linjoista kulkee Pasilan aseman kautta? Näppituntumalla se taitaa olla yksi merkittävimpiä bussilinjojen luotettavuutta heikentäviä paikkoja.

  • Jarno Tuimala kirjoitti:

    Hyvä kysymys! Linja 506:han kulkee Pasilan kautta, mutta linja 54 taas ei. Ilmeisesti Pasila ei siis ole ainoa reitin loppua kohti tapahtuvan hajonnan lisääntymistä selittävä tekijä. En osaa suoraan sanoa, kuinka moni epäluotettavista linjoista kulkee Pasilan kautta, mutta voin tutkia asiaa aineistosta. Nopeana vastauksena lisäsin postaukseni loppuun PDF-tiedoston, jossa on yllä olevan kuvan kaltaiset kuvat niille 164:lle linjalle, joilta on eniten havaintoja.


Vastaa

Sähköpostiosoitettasi ei julkaista. Pakolliset kentät on merkitty *