Dzisiaj pokażę jak, za pomocą R oraz pakietów ggmap, dplyr i animation, zwizualizować zmiany natężenia kursów tramwajów i autobusów w ciągu dnia. Co ciekawego, oprócz wrażeń estetycznych, można z tych rysunków wyciągnąć? Choćby to, że uwidaczniają one niezwykle duże natężenie kursowania tramwajów w ścisłym centrum, nawet poza godzinami szczytu. Ten fakt odpowiada, przynajmniej częściowo, na pytanie postawione w tytule dzisiejszego wpisu. Tramwaje częściej kursować nie mogą bo… nie ma na nie miejsca. Właściwie wszystkie linie kursują przez ścisłe centrum miasta. Zupełnie inaczej ma się sprawa z autobusami.

W poprzednim wpisie pokazałem jak wygląda natężenie kursów mpk, ale nie napisałem zbyt dużo o kodzie eRowym. Tym razem oprócz nowych rysunków, animacji, pokażę dokładniej jak można je uzyskać w R.

Zobaczmy zatem jak wygląda natężenie kursów tramwajowych i autobusowych w dni robocze. Oto pierwsza grafika:

animacja_mpk2

Być może jest to kwestia złego doboru kolorów i skali przezroczystości, ale ten wykres wydaje mi się mało czytelny. Użycie jasnego koloru dla rejonów o wyższej intensywności, które było naturalnym wyborem dla wykresów z poprzedniego wpisu, w połączeniu z animacją, daje mi mylne intuicje. Być może jest to kwestia indywidualna, ale dla mnie każda zmiana koloru na ciemniejszy przykuwa uwagę. Wobec tego mimo, że kursów ubywa, ja mam wrażenie jakby trend był odwrotny. Spróbujemy temu zaradzić za pomocą nowego rysunku

animacja_mpk4

Wydaje mi się, że jest on dużo bardziej przejrzysty od poprzedniego. Bardzo klarownie widać na nim zarówno rozjeżdżanie się tramwajów z i do zajezdni, jak i istotną redukcję liczby kursów w środku dnia. Ciekawy jest też rozkład kursowania autobusów nocnych, pokrywają one, mniej więcej jednostajnie, cały obszar miasta.

A teraz czas na pokazanie bebechów.

Wczytywanie i przetwarzanie danych

Do przetwarzania danych używam pakietu dplyr. Dla chcących poznać tajniki tego pakietu polecam ściągawkę ze strony RStudio.

przystanki dec=",", colClasses=c("numeric","numeric","numeric","factor"),
col.names = c('lon', 'lat', 'id', 'type'))
levels(przystanki$type) %
filter(slupek %in% przystanki$id) %>%
inner_join(przystanki, by = c("slupek" = "id")) -> rozklady_przystanki

Zwracam uwagę na możliwość wykonywania operacji łączenia dwóch ramek danych, w taki sam sposób, jak robi się to z tabelami w SQLu. Interesuje nas podział na linie tramwajowe i autobusowe

tramwaje = factor(c('0L', '0P', '1', '10', '11', '14', '15', '17', '2', '20', '23', '24', '3', '31', '32', '33', '4', '5', '6', '7', '8', '9'),
levels = levels(rozklady_przystanki$linia))

rozklady_przystanki %>%
filter(dzien=="roboczy",
linia %in% tramwaje) %>%
mutate(typ = "tramwaj") %>%
select(slupek, lon, lat, typ, godzina) %>%
bind_rows(rozklady_przystanki %>%
filter(dzien=="roboczy",
! linia %in% tramwaje) %>%
mutate(typ = "autobus") %>%
select(slupek, lon, lat, typ, godzina)) -> rozklady_dzien_roboczy

Tworzenie pierwszej animacji

Animacje w R tworzę za pomocą pakietu animation.

require(animation)
wroclaw = get_map("wrocław", color="bw", zoom = 12)
WroclawMap = ggmap(wroclaw, extent = "device", legend = "bottom")
godziny = 0:23
plot_mpk = function(){
for(i in 1:length(godziny)){
tytul = paste("Natężenie ruchu komunikacji miejskiej we Wrocławiunmiędzy godzinami",
paste(godziny[[i]], "a", godziny[[i]]+1, collapse=","))
p = WroclawMap + stat_density2d(
aes(x = lon, y = lat, fill = ..level.., alpha =..level..),
size = 30, bins=20,
data = rozklady_dzien_roboczy %>%
filter(godzina %in% godziny[[i]]),
geom = "polygon") +
scale_alpha(range = c(.05, .3), guide = FALSE) +
scale_fill_gradient("Natężenienkomunikacjinmiejskiej", guide = "colourbar",
limits=c(0, 800)) +
guides(fill = guide_colorbar(barwidth = 15, barheight = 1)) +
facet_grid(. ~typ) +
ggtitle(tytul) +
theme(plot.title=element_text(size=20, face="bold", colour="steelblue"))
print(p)
}
}
oopt = ani.options(interval = 2, nmax = length(godziny), ani.width = 1100, ani.height = 700)
saveGIF(plot_mpk(), movie.name = "nazwa_pliku.gif")

Tworzenie drugiej animacji

WroclawMap = ggmap(wroclaw, extent = "device", legend = "bottomright")
godziny = 0:23
plot_mpk = function(){
for(i in 1:length(godziny)){
tytul = paste("Natężenie ruchu na przystankach komunikacji miejskiej we Wrocławiunmiędzy godzinami",
paste(godziny[[i]], "a", godziny[[i]]+1, collapse=","))
p = WroclawMap +
geom_point(aes(x = lon, y = lat, color = typ, size = count, alpha =.4),
data = rozklady_dzien_roboczy %>%
filter(godzina %in% godziny[[i]]) %>%
group_by(slupek, lon, lat, typ) %>%
summarise(count = n()) %>%
select(lon, lat, typ, count)) +
scale_alpha(guide = FALSE) +
scale_color_discrete("Rodzaj przystanku") +
scale_size_area("Liczba połączeń na dobę", max_size = 15, limits=c(0, 100)) +
ggtitle(tytul) +
theme(plot.title=element_text(size=20, face="bold", colour="steelblue"))
print(p)
}
}
oopt = ani.options(interval = 2, nmax = length(godziny), ani.width = 1000, ani.height = 1000)
saveGIF(plot_mpk(), movie.name = "nazwa_pliku.gif")