London5
lgp
8/6/2021
ANALISIS DE MOVIMIENTOS Y FLUJOS URBANOS
Cargamos librerias a utilizar
library(tidyverse)
library(ggmap)
library(sf)
library(lubridate)
library(osrm)
library(leaflet)Preparación de datasets
Haremos un análisis del uso de bicicletas de alquiler en Londres, continuando con el análisis realizado en la Tarea 3.
Usaremos el dataset obtenido del portal de datos de la ciudad de Londres https://data.london.gov.uk/
london_bikes <- read.csv("TFL Cycle Hire 2017.csv",stringsAsFactors=TRUE)dim(london_bikes)## [1] 10011238 16head(london_bikes)## StartStation.Lat StartStation.Lon StartStaton.Docks EndStation.Lat
## 1 51.49016 -0.190393 29 51.49095
## 2 51.49016 -0.190393 29 51.49095
## 3 51.49016 -0.190393 29 51.49095
## 4 51.49016 -0.190393 29 51.49095
## 5 51.49016 -0.190393 29 51.49095
## 6 51.49016 -0.190393 29 51.49095
## EndStation.Lon EndStationDocks Rental.Id Duration Bike.Id StartDate
## 1 -0.18119 30 63751445 180 3428 2017-04-05 22:47:00
## 2 -0.18119 30 64016293 180 13909 2017-04-12 21:41:00
## 3 -0.18119 30 64334332 180 11693 2017-04-23 19:20:00
## 4 -0.18119 30 64567541 240 4552 2017-05-01 20:12:00
## 5 -0.18119 30 64787260 180 5270 2017-05-08 19:44:00
## 6 -0.18119 30 65022982 180 2123 2017-05-15 22:12:00
## StartStation.Id StartStation.Name EndDate
## 1 219 Bramham Gardens, Earl's Court 2017-04-05 22:50:00
## 2 219 Bramham Gardens, Earl's Court 2017-04-12 21:44:00
## 3 219 Bramham Gardens, Earl's Court 2017-04-23 19:23:00
## 4 219 Bramham Gardens, Earl's Court 2017-05-01 20:16:00
## 5 219 Bramham Gardens, Earl's Court 2017-05-08 19:47:00
## 6 219 Bramham Gardens, Earl's Court 2017-05-15 22:15:00
## EndStation.Id EndStation.Name Year
## 1 216 Old Brompton Road, South Kensington 2017
## 2 216 Old Brompton Road, South Kensington 2017
## 3 216 Old Brompton Road, South Kensington 2017
## 4 216 Old Brompton Road, South Kensington 2017
## 5 216 Old Brompton Road, South Kensington 2017
## 6 216 Old Brompton Road, South Kensington 2017summary(london_bikes)## StartStation.Lat StartStation.Lon StartStaton.Docks EndStation.Lat
## Min. :51.45 Min. :-0.236769 Min. :10.00 Min. :51.45
## 1st Qu.:51.50 1st Qu.:-0.162418 1st Qu.:20.00 1st Qu.:51.50
## Median :51.51 Median :-0.124121 Median :26.00 Median :51.51
## Mean :51.51 Mean :-0.125726 Mean :27.72 Mean :51.51
## 3rd Qu.:51.52 3rd Qu.:-0.092762 3rd Qu.:33.00 3rd Qu.:51.52
## Max. :51.55 Max. :-0.002275 Max. :64.00 Max. :51.55
##
## EndStation.Lon EndStationDocks Rental.Id Duration
## Min. :-0.236769 Min. :10.00 Min. :61395909 Min. : -3360
## 1st Qu.:-0.159919 1st Qu.:20.00 1st Qu.:64159124 1st Qu.: 480
## Median :-0.124121 Median :26.00 Median :66902368 Median : 840
## Mean :-0.125442 Mean :27.71 Mean :66890646 Mean : 1223
## 3rd Qu.:-0.092921 3rd Qu.:34.00 3rd Qu.:69628349 3rd Qu.: 1309
## Max. :-0.002275 Max. :64.00 Max. :72340790 Max. :1984694
##
## Bike.Id StartDate StartStation.Id
## Min. : 1 2017-01-09 08:29:00: 132 Min. : 1.0
## 1st Qu.: 4098 2017-01-09 08:32:00: 127 1st Qu.:159.0
## Median : 8073 2017-01-09 08:22:00: 125 Median :330.0
## Mean : 7987 2017-01-09 09:00:00: 124 Mean :362.3
## 3rd Qu.:12128 2017-07-18 17:39:00: 123 3rd Qu.:562.0
## Max. :15642 2017-01-09 08:41:00: 122 Max. :826.0
## (Other) :10010485
## StartStation.Name EndDate
## Belgrove Street , King's Cross : 95421 2017-01-09 08:54:00: 137
## Hyde Park Corner, Hyde Park : 87439 2017-01-09 08:55:00: 134
## Waterloo Station 3, Waterloo : 82942 2017-07-11 08:54:00: 132
## Black Lion Gate, Kensington Gardens: 61551 2017-06-15 08:57:00: 128
## Albert Gate, Hyde Park : 60030 2017-01-09 08:56:00: 123
## Waterloo Station 1, Waterloo : 56799 2017-09-26 08:55:00: 123
## (Other) :9567056 (Other) :10010461
## EndStation.Id EndStation.Name Year
## Min. : 1.0 Belgrove Street , King's Cross : 93197 Min. :2017
## 1st Qu.:156.0 Hyde Park Corner, Hyde Park : 87746 1st Qu.:2017
## Median :322.0 Waterloo Station 3, Waterloo : 78682 Median :2017
## Mean :359.1 Hop Exchange, The Borough : 64299 Mean :2017
## 3rd Qu.:558.0 Albert Gate, Hyde Park : 60653 3rd Qu.:2017
## Max. :826.0 Black Lion Gate, Kensington Gardens: 60100 Max. :2017
## (Other) :9566561names(london_bikes)## [1] "StartStation.Lat" "StartStation.Lon" "StartStaton.Docks"
## [4] "EndStation.Lat" "EndStation.Lon" "EndStationDocks"
## [7] "Rental.Id" "Duration" "Bike.Id"
## [10] "StartDate" "StartStation.Id" "StartStation.Name"
## [13] "EndDate" "EndStation.Id" "EndStation.Name"
## [16] "Year"En primer lugar convertiremos en formato de fecha los timestamp de inicio i finalización
london_bikes <- london_bikes %>%
mutate(StartDate=ymd_hms(StartDate),StartDate=ymd_hms(StartDate))y le agregamos columnas con información de fechas que servirán para posteriores análisis
london_bikes <- london_bikes %>%
mutate(mes=month(StartDate, label=TRUE), diasem=wday(StartDate, label=TRUE, abbr=TRUE), diasemN=wday(StartDate, label=FALSE), hora=hour(StartDate))head(london_bikes)## StartStation.Lat StartStation.Lon StartStaton.Docks EndStation.Lat
## 1 51.49016 -0.190393 29 51.49095
## 2 51.49016 -0.190393 29 51.49095
## 3 51.49016 -0.190393 29 51.49095
## 4 51.49016 -0.190393 29 51.49095
## 5 51.49016 -0.190393 29 51.49095
## 6 51.49016 -0.190393 29 51.49095
## EndStation.Lon EndStationDocks Rental.Id Duration Bike.Id StartDate
## 1 -0.18119 30 63751445 180 3428 2017-04-05 22:47:00
## 2 -0.18119 30 64016293 180 13909 2017-04-12 21:41:00
## 3 -0.18119 30 64334332 180 11693 2017-04-23 19:20:00
## 4 -0.18119 30 64567541 240 4552 2017-05-01 20:12:00
## 5 -0.18119 30 64787260 180 5270 2017-05-08 19:44:00
## 6 -0.18119 30 65022982 180 2123 2017-05-15 22:12:00
## StartStation.Id StartStation.Name EndDate
## 1 219 Bramham Gardens, Earl's Court 2017-04-05 22:50:00
## 2 219 Bramham Gardens, Earl's Court 2017-04-12 21:44:00
## 3 219 Bramham Gardens, Earl's Court 2017-04-23 19:23:00
## 4 219 Bramham Gardens, Earl's Court 2017-05-01 20:16:00
## 5 219 Bramham Gardens, Earl's Court 2017-05-08 19:47:00
## 6 219 Bramham Gardens, Earl's Court 2017-05-15 22:15:00
## EndStation.Id EndStation.Name Year mes diasem diasemN
## 1 216 Old Brompton Road, South Kensington 2017 abr mié\\. 4
## 2 216 Old Brompton Road, South Kensington 2017 abr mié\\. 4
## 3 216 Old Brompton Road, South Kensington 2017 abr dom\\. 1
## 4 216 Old Brompton Road, South Kensington 2017 may lun\\. 2
## 5 216 Old Brompton Road, South Kensington 2017 may lun\\. 2
## 6 216 Old Brompton Road, South Kensington 2017 may lun\\. 2
## hora
## 1 22
## 2 21
## 3 19
## 4 20
## 5 19
## 6 22Representación espacial, mapas de calor
Usaremos un mapa de fondo para interpretar los scatterplots de cantidades de viajes de salida y llegada a cada una de las estaciones. Previamente armamos la bbox que contiene a todas las estaciones
bbox_london <- make_bbox(london_bikes$StartStation.Lon, london_bikes$StartStation.Lat)bbox_london## left bottom right top
## -0.2484937 51.4500211 0.0094497 51.5540999Obtenemos el mapa base
mapa_london <- get_stamenmap(bbox = bbox_london,
maptype = "toner-lite",
zoom=12)ggmap(mapa_london)
Tráfico a lo largo de los días de la semana
Veamos como resulta la distribución temporal de la cantidad de viajes durantel el día, tomando como parámetros los días de la semana y los meses a lo largo del año.
ggplot(london_bikes %>%
group_by(mes, diasem, hora) %>%
summarise(cantidad=n()))+
geom_line(aes(x=hora, y=cantidad, color=diasem))+
facet_wrap(~mes)+
scale_colour_manual(values=c("darkgreen", "blue","darkorange","darkcyan","darkviolet","darkred","green"))## `summarise()` has grouped output by 'mes', 'diasem'. You can override using the `.groups` argument.
Como podemos ver las formas de comportamiento general son muy similares de mes a mes, aunque se pueden apreciar las diferencias de cantidades atribuibles a cuestiones estacionales. Tambien se pueden notar la presencia de dos patrones diferentes, uno para los dias hábiles y otro para los fines de semana. Los días habiles aparecen dos picos en lugar de uno, el primero ligeramente más alto que el segundo. Este comportamiento parece razonable teniendo en cuenta los horarios pico de entrada y salida de los trabajos.
Crearemos dos datasets, uno para días laborables, y otro para los fines de semana
london_bikes_laboral <- filter(london_bikes, diasemN %in% c(2:6))Agrupamos por estación y contabilizamos la cantidad de viajes de salida de las estaciones
london_bikes_laboral_starts <- london_bikes_laboral %>%
group_by(StartStation.Id, StartStation.Name) %>%
summarise(cant=n(), StartStation.Lat=mean(StartStation.Lat), StartStation.Lon=mean(StartStation.Lon)) %>%
arrange(desc(cant))## `summarise()` has grouped output by 'StartStation.Id'. You can override using the `.groups` argument.head(london_bikes_laboral_starts)## # A tibble: 6 x 5
## # Groups: StartStation.Id [6]
## StartStation.Id StartStation.Name cant StartStation.Lat StartStation.Lon
## <int> <fct> <int> <dbl> <dbl>
## 1 14 Belgrove Street , Kin~ 87165 51.5 -0.124
## 2 154 Waterloo Station 3, W~ 79666 51.5 -0.113
## 3 374 Waterloo Station 1, W~ 52582 51.5 -0.114
## 4 191 Hyde Park Corner, Hyd~ 51134 51.5 -0.154
## 5 217 Wormwood Street, Live~ 39813 51.5 -0.0824
## 6 101 Queen Street 1, Bank 39798 51.5 -0.0929Veamos como quedan representadas las estaciones en el mapa y cuales son las de mayor tránsito
ggmap(mapa_london)+
geom_point(data=london_bikes_laboral_starts, aes(x=StartStation.Lon, y=StartStation.Lat, color=cant, size=cant))
Lo que resulta interesante son las ubicaciones de las estaciones con mayor tráfico Hay dos que estan en ubicaciones cercanas a dos grandes estaciones ferroviarias de Londres, mientras aparecen otras de alto tráfico que parecen estar en los alrededores y el interior del Hyde Park.
Entre las estaciones con mayor tráfico aparece como la que presenta más viajes de salida una que queda cerca del acceso a la estación de tren King Cross (que está junto a otra St Pancras International)
El primer análisis que haremos será sobre el Top 10 de los viajes desde la estación “Belgrove Street , King’s Cross” la que presenta mayor cantidad de viajes de salida y compararemos el resultado con el Top 10 de viajes durante los fines de semana.
Armamos el dataset de los fines de semana:
london_bikes_finde <- filter(london_bikes, diasemN %in% c(1,7))Agrupamos por estación y contabilizamos la cantidad de viajes de salida de las estaciones
london_bikes_finde_starts <- london_bikes_finde %>%
group_by(StartStation.Id, StartStation.Name) %>%
summarise(cant=n(), StartStation.Lat=mean(StartStation.Lat), StartStation.Lon=mean(StartStation.Lon)) %>%
arrange(desc(cant))## `summarise()` has grouped output by 'StartStation.Id'. You can override using the `.groups` argument.head(london_bikes_finde_starts)## # A tibble: 6 x 5
## # Groups: StartStation.Id [6]
## StartStation.Id StartStation.Name cant StartStation.Lat StartStation.Lon
## <int> <fct> <int> <dbl> <dbl>
## 1 191 "Hyde Park Corner, Hy~ 36305 51.5 -0.154
## 2 307 "Black Lion Gate, Ken~ 24668 51.5 -0.188
## 3 303 "Albert Gate, Hyde Pa~ 23790 51.5 -0.158
## 4 248 "Triangle Car Park, H~ 21617 51.5 -0.170
## 5 553 "Regent's Row , Hagge~ 16795 51.5 -0.0625
## 6 213 "Wellington Arch, Hyd~ 16647 51.5 -0.150Veamos como quedan representadas las estaciones en el mapa y cuales son las de mayor tránsito
ggmap(mapa_london)+
geom_point(data=london_bikes_finde_starts, aes(x=StartStation.Lon, y=StartStation.Lat, color=cant, size=cant))
Como se puede apreciar, y ya lo vimos en la tarea3, la mayor cantidad de viajes se dan en los alrededores y dentro del Hyde Park. aparece una zona con algunas estaciones muy utilizadas en el centro-este de Londres. Veremos que resulta despues del ruteo de estos viajes durante los fines de semana.
ANALISIS Origen-Destino
Haremos una comparación entre los viajes de fin de semana y los de días laborables en base a las representaciones de matrices origen-destino de cada dataset
viajes_laboral <- london_bikes_laboral %>%
group_by(StartStation.Id, StartStation.Name, EndStation.Id, EndStation.Name) %>%
summarise(cant=n(), StartStation.Lat=mean(StartStation.Lat), StartStation.Lon=mean(StartStation.Lon),EndStation.Lat=mean(EndStation.Lat),EndStation.Lon=mean(EndStation.Lon))## `summarise()` has grouped output by 'StartStation.Id', 'StartStation.Name', 'EndStation.Id'. You can override using the `.groups` argument.head(viajes_laboral)## # A tibble: 6 x 9
## # Groups: StartStation.Id, StartStation.Name, EndStation.Id [6]
## StartStation.Id StartStation.Name EndStation.Id EndStation.Name cant
## <int> <fct> <int> <fct> <int>
## 1 1 River Street , Cler~ 1 River Street , Clerk~ 203
## 2 1 River Street , Cler~ 3 Christopher Street, ~ 18
## 3 1 River Street , Cler~ 4 St. Chad's Street, K~ 21
## 4 1 River Street , Cler~ 6 Broadcasting House, ~ 61
## 5 1 River Street , Cler~ 7 Charlbert Street, St~ 1
## 6 1 River Street , Cler~ 9 New Globe Walk, Bank~ 2
## # ... with 4 more variables: StartStation.Lat <dbl>, StartStation.Lon <dbl>,
## # EndStation.Lat <dbl>, EndStation.Lon <dbl>ggplot() +
geom_tile(data = viajes_laboral, aes(x = StartStation.Id, y = EndStation.Id, fill = cant))+
scale_fill_distiller(palette = "RdYlGn") +
labs(title="Viajes en días laborables",subtitle="Matriz Origen-Destino")
No aparecen patrones particulares, salvo que entre las estaciones entre la de id 400 a 600 no parece haber tanta densidad de tránsito como en las otras. No se marca una diagonal notoria de viajes circulares.
viajes_finde <- london_bikes_finde %>%
group_by(StartStation.Id, StartStation.Name, EndStation.Id, EndStation.Name) %>%
summarise(cant=n(), StartStation.Lat=mean(StartStation.Lat), StartStation.Lon=mean(StartStation.Lon), EndStation.Lat=mean(EndStation.Lat),EndStation.Lon=mean(EndStation.Lon))## `summarise()` has grouped output by 'StartStation.Id', 'StartStation.Name', 'EndStation.Id'. You can override using the `.groups` argument.head(viajes_finde)## # A tibble: 6 x 9
## # Groups: StartStation.Id, StartStation.Name, EndStation.Id [6]
## StartStation.Id StartStation.Name EndStation.Id EndStation.Name cant
## <int> <fct> <int> <fct> <int>
## 1 1 River Street , Cler~ 1 River Street , Clerk~ 72
## 2 1 River Street , Cler~ 3 Christopher Street, ~ 3
## 3 1 River Street , Cler~ 4 St. Chad's Street, K~ 5
## 4 1 River Street , Cler~ 5 Sedding Street, Sloa~ 1
## 5 1 River Street , Cler~ 6 Broadcasting House, ~ 6
## 6 1 River Street , Cler~ 7 Charlbert Street, St~ 1
## # ... with 4 more variables: StartStation.Lat <dbl>, StartStation.Lon <dbl>,
## # EndStation.Lat <dbl>, EndStation.Lon <dbl>ggplot() +
geom_tile(data = viajes_finde, aes(x = StartStation.Id, y = EndStation.Id, fill = cant))+
scale_fill_distiller(palette = "Spectral") +
labs(title="Viajes en fines de semana",subtitle="Matriz Origen-Destino")
Tampoco aparecen patrones muy determinados, si tres regiones que mostrarían un mayor tráfico entre estaciones de similar zona de id (quizás la distribución de id sea por regiones de Londres, pero no lo pude verificar). Se nota una zona entre el id 0 al 400, otra entre 400 y 600 y otra entre 600 y 800. No se aprecia una diagonal de viajes circulares
viajes_finde_circ_T10 <- viajes_finde %>%
filter(StartStation.Id==EndStation.Id) %>%
arrange(desc(cant)) %>%
head(10)head(viajes_finde_circ_T10,20)## # A tibble: 10 x 9
## # Groups: StartStation.Id, StartStation.Name, EndStation.Id [10]
## StartStation.Id StartStation.Name EndStation.Id EndStation.Name cant
## <int> <fct> <int> <fct> <int>
## 1 191 Hyde Park Corner, Hy~ 191 Hyde Park Corner, ~ 11008
## 2 785 Aquatic Centre, Quee~ 785 Aquatic Centre, Qu~ 5969
## 3 307 Black Lion Gate, Ken~ 307 Black Lion Gate, K~ 5603
## 4 248 Triangle Car Park, H~ 248 Triangle Car Park,~ 4955
## 5 303 Albert Gate, Hyde Pa~ 303 Albert Gate, Hyde ~ 4822
## 6 111 Park Lane , Hyde Park 111 Park Lane , Hyde P~ 4333
## 7 404 Palace Gate, Kensing~ 404 Palace Gate, Kensi~ 2629
## 8 789 Podium, Queen Elizab~ 789 Podium, Queen Eliz~ 2194
## 9 213 Wellington Arch, Hyd~ 213 Wellington Arch, H~ 1963
## 10 350 Queen's Gate, Kensin~ 350 Queen's Gate, Kens~ 1955
## # ... with 4 more variables: StartStation.Lat <dbl>, StartStation.Lon <dbl>,
## # EndStation.Lat <dbl>, EndStation.Lon <dbl>Vemos que de cualquier manera hay una gran cantidad de viajes circulares, en particular desde Hyde Park Corner, un hot spot turístico. Del Top10, ocho corresponden al Hyde Park (Kensington Gardens queda en el centro del Hyde Park). Pero aparecen dos relacionados con el Parque Olímpico, la zona donde se desarrollaron los juegos de 2012. Quizás esto se corresponda con los spots que aparecian en el mapa cuando analizamos las cantidad de viajes por estación origen en la zona centro-este de la ciudad.
Eliminar Viajes circulares
A pesar de su importancia durante los fines de semana, para hacer un análisis de ruteo es necesario eliminar los viajes circulares, ya que no tiene sentido encontrar una ruta en esos casos.
viajes_laboral_SC <- viajes_laboral %>%
filter(StartStation.Id!=EndStation.Id) %>%
arrange(desc(cant))head(viajes_laboral_SC)## # A tibble: 6 x 9
## # Groups: StartStation.Id, StartStation.Name, EndStation.Id [6]
## StartStation.Id StartStation.Name EndStation.Id EndStation.Name cant
## <int> <fct> <int> <fct> <int>
## 1 671 Parsons Green Statio~ 729 St. Peter's Terrace~ 3152
## 2 307 Black Lion Gate, Ken~ 404 Palace Gate, Kensin~ 3113
## 3 191 Hyde Park Corner, Hy~ 248 Triangle Car Park, ~ 3026
## 4 248 Triangle Car Park, H~ 191 Hyde Park Corner, H~ 2890
## 5 404 Palace Gate, Kensing~ 307 Black Lion Gate, Ke~ 2613
## 6 191 Hyde Park Corner, Hy~ 303 Albert Gate, Hyde P~ 2523
## # ... with 4 more variables: StartStation.Lat <dbl>, StartStation.Lon <dbl>,
## # EndStation.Lat <dbl>, EndStation.Lon <dbl>Armamos el Top 10 de viajes durante los dias laborables desde la estación King Cross
viajes_laboral_KingCrossT10 <- viajes_laboral %>%
filter(StartStation.Id==14) %>%
arrange(desc(cant)) %>%
head(10)head(viajes_laboral_KingCrossT10,20)## # A tibble: 10 x 9
## # Groups: StartStation.Id, StartStation.Name, EndStation.Id [10]
## StartStation.Id StartStation.Name EndStation.Id EndStation.Name cant
## <int> <fct> <int> <fct> <int>
## 1 14 Belgrove Street , Ki~ 436 Red Lion Street, H~ 2190
## 2 14 Belgrove Street , Ki~ 66 Holborn Circus, Ho~ 1796
## 3 14 Belgrove Street , Ki~ 109 Soho Square , Soho 1792
## 4 14 Belgrove Street , Ki~ 433 Wren Street, Holbo~ 1702
## 5 14 Belgrove Street , Ki~ 71 Newgate Street , S~ 1693
## 6 14 Belgrove Street , Ki~ 159 Great Marlborough ~ 1599
## 7 14 Belgrove Street , Ki~ 68 Theobald's Road , ~ 1286
## 8 14 Belgrove Street , Ki~ 57 Guilford Street , ~ 1283
## 9 14 Belgrove Street , Ki~ 64 William IV Street,~ 1231
## 10 14 Belgrove Street , Ki~ 24 British Museum, Bl~ 1119
## # ... with 4 more variables: StartStation.Lat <dbl>, StartStation.Lon <dbl>,
## # EndStation.Lat <dbl>, EndStation.Lon <dbl>RUTEO Viajes en dias laborables desde la estación King Cross
Empezamos por el trayecto más utilizado
viaje1_KingCross <- viajes_laboral_KingCrossT10 %>%
ungroup() %>%
filter(cant==max(cant))viaje1_KingCross## # A tibble: 1 x 9
## StartStation.Id StartStation.Name EndStation.Id EndStation.Name cant
## <int> <fct> <int> <fct> <int>
## 1 14 Belgrove Street , King~ 436 Red Lion Street, ~ 2190
## # ... with 4 more variables: StartStation.Lat <dbl>, StartStation.Lon <dbl>,
## # EndStation.Lat <dbl>, EndStation.Lon <dbl>ruteo_viaje1_KingCross <- osrmRoute(src = c(viaje1_KingCross$StartStation.id, viaje1_KingCross$StartStation.Lon, viaje1_KingCross$StartStation.Lat),
dst = c(viaje1_KingCross$EndStation.id, viaje1_KingCross$EndStation.Lon, viaje1_KingCross$EndStation.Lat),
returnclass = "sf",
overview = "full",
osrm.profile = "bike")## Warning: Unknown or uninitialised column: `StartStation.id`.## Warning: Unknown or uninitialised column: `EndStation.id`.ruteo_viaje1_KingCross## Simple feature collection with 1 feature and 4 fields
## Geometry type: LINESTRING
## Dimension: XY
## Bounding box: xmin: -0.12366 ymin: 51.51824 xmax: -0.11473 ymax: 51.52993
## Geodetic CRS: WGS 84
## src dst duration distance geometry
## src_dst src dst 9.09 1.9223 LINESTRING (-0.12366 51.529...Veamos la ruta resultante en un mapa interactivo
leaflet(ruteo_viaje1_KingCross) %>%
addTiles() %>%
addPolylines(color = "red",
label = paste("Distancia:", ruteo_viaje1_KingCross$distance, "|",
"Duración:", ruteo_viaje1_KingCross$duration))El trayecto va desde la estación King Cross a una zona comercial del centro de Londres, donde además hay dos edificios de la Universidad de Londres y las Oficinas del Underground de Londres. El trayecto no es largo, solo 2 Km y se estima que se recorre en unos 9 minutos.
Ruteo Top 10 en días laborables
Armamos la función para rutear
rutear_bikes <- function(StartStation.Name, StartStation.Lon, StartStation.Lat,
EndStation.Name, EndStation.Lon, EndStation.Lat) {
ruta <- osrmRoute(src = c(StartStation.Name, StartStation.Lon, StartStation.Lat),
dst = c(EndStation.Name, EndStation.Lon, EndStation.Lat),
returnclass = "sf",
overview = "full",
osrm.profile = "bike")
cbind(ORIGEN = StartStation.Name, DESTINO = EndStation.Name, ruta)
}ruteo_top10 <- list(viajes_laboral_KingCrossT10$StartStation.Name,
viajes_laboral_KingCrossT10$StartStation.Lon,
viajes_laboral_KingCrossT10$StartStation.Lat,
viajes_laboral_KingCrossT10$EndStation.Name,
viajes_laboral_KingCrossT10$EndStation.Lon,
viajes_laboral_KingCrossT10$EndStation.Lat)ruteo_top10 <- pmap(ruteo_top10, rutear_bikes) %>%
reduce(rbind)summary(ruteo_top10)## ORIGEN DESTINO
## Belgrove Street , King's Cross :10 British Museum, Bloomsbury :1
## Abbey Orchard Street, Westminster: 0 Great Marlborough Street, Soho:1
## Abbotsbury Road, Holland Park : 0 Guilford Street , Bloomsbury :1
## Aberdeen Place, St. John's Wood : 0 Holborn Circus, Holborn :1
## Aberfeldy Street, Poplar : 0 Newgate Street , St. Paul's :1
## Abingdon Green, Westminster : 0 Red Lion Street, Holborn :1
## (Other) : 0 (Other) :4
## src dst duration distance
## Min. :61 Min. : 98.0 Min. : 5.335 Min. :1.091
## 1st Qu.:61 1st Qu.:310.8 1st Qu.: 7.849 1st Qu.:1.618
## Median :61 Median :515.0 Median :10.064 Median :2.017
## Mean :61 Mean :487.2 Mean :11.136 Mean :2.123
## 3rd Qu.:61 3rd Qu.:665.0 3rd Qu.:14.476 3rd Qu.:2.692
## Max. :61 Max. :768.0 Max. :20.172 Max. :3.390
##
## geometry
## LINESTRING :10
## epsg:4326 : 0
## +proj=long...: 0
##
##
##
## veamos como queda en general en un mapa estático
ggmap(mapa_london)+
geom_sf(data=ruteo_top10, color="red", size=1.5, inherit.aes = FALSE)+
labs(title="Top 10 Recorridos desde King Cross",
subtitle="Dias laborables 2017",
caption="Fuente: https://www.bluebikes.com/system-data")+
scale_color_viridis_c(direction=-1)+
theme_void()## Coordinate system already present. Adding new coordinate system, which will replace the existing one.
Como vemos se distribuye en racimo hacia distintos putos de la zona centro de Londres y la city de Londres
Si hacemos una acercamiento con un mapa estático
bbox_zoom <- as.numeric(st_bbox(ruteo_top10))
mapa_london_zoom <- get_stamenmap(bbox_zoom,
color="bw",
zoom = 13)## Source : http://tile.stamen.com/terrain/13/4092/2723.png## Source : http://tile.stamen.com/terrain/13/4093/2723.pngruteo_top10 <- ruteo_top10 %>%
left_join(viajes_laboral_KingCrossT10, by=c("ORIGEN"="StartStation.Name", "DESTINO"="EndStation.Name"))ggmap(mapa_london_zoom)+
geom_sf(data=ruteo_top10, aes(color=cant), size=1.5, inherit.aes = FALSE)+
labs(title="Top 10 Recorridos desde King Cross",
subtitle="Dias laborables 2017",
caption="Fuente: https://www.bluebikes.com/system-data")+
scale_color_viridis_c(direction=-1)+
theme_void()## Coordinate system already present. Adding new coordinate system, which will replace the existing one.
Veamos como queda en uno dinámico para tener más detalles
Armamos una paleta de colores para diferenciar cada tramo
paleta <- c(low="blue", high= "red")leaflet(ruteo_top10) %>%
addTiles() %>%
addPolylines(color = ~colorNumeric(paleta, ruteo_top10$distance)(distance), label = paste("Distancia:", ruteo_top10$distance, "|",
"Duración:", ruteo_top10$duration))Las estaciones de destino están en distintas zonas de actividad comercial, aunque a algunas se las puede asociar con destinos turísticos.
ANALISIS DE FINES DE SEMANA
viajes_finde_SC_t10 <- viajes_finde %>%
filter(StartStation.Id!=EndStation.Id) %>%
arrange(desc(cant)) %>%
head(10)head(viajes_finde_SC_t10)## # A tibble: 6 x 9
## # Groups: StartStation.Id, StartStation.Name, EndStation.Id [6]
## StartStation.Id StartStation.Name EndStation.Id EndStation.Name cant
## <int> <fct> <int> <fct> <int>
## 1 191 Hyde Park Corner, Hyd~ 303 Albert Gate, Hyde ~ 2372
## 2 191 Hyde Park Corner, Hyd~ 248 Triangle Car Park,~ 2269
## 3 248 Triangle Car Park, Hy~ 191 Hyde Park Corner, ~ 2206
## 4 307 Black Lion Gate, Kens~ 191 Hyde Park Corner, ~ 2106
## 5 303 Albert Gate, Hyde Park 191 Hyde Park Corner, ~ 1981
## 6 307 Black Lion Gate, Kens~ 404 Palace Gate, Kensi~ 1779
## # ... with 4 more variables: StartStation.Lat <dbl>, StartStation.Lon <dbl>,
## # EndStation.Lat <dbl>, EndStation.Lon <dbl>Veamos como queda una matriz origen destino
viajes_finde_T10 <- viajes_finde %>%
arrange(desc(cant)) %>%
head(10)head(viajes_finde_T10,20)## # A tibble: 10 x 9
## # Groups: StartStation.Id, StartStation.Name, EndStation.Id [10]
## StartStation.Id StartStation.Name EndStation.Id EndStation.Name cant
## <int> <fct> <int> <fct> <int>
## 1 191 Hyde Park Corner, Hy~ 191 Hyde Park Corner, ~ 11008
## 2 785 Aquatic Centre, Quee~ 785 Aquatic Centre, Qu~ 5969
## 3 307 Black Lion Gate, Ken~ 307 Black Lion Gate, K~ 5603
## 4 248 Triangle Car Park, H~ 248 Triangle Car Park,~ 4955
## 5 303 Albert Gate, Hyde Pa~ 303 Albert Gate, Hyde ~ 4822
## 6 111 Park Lane , Hyde Park 111 Park Lane , Hyde P~ 4333
## 7 404 Palace Gate, Kensing~ 404 Palace Gate, Kensi~ 2629
## 8 191 Hyde Park Corner, Hy~ 303 Albert Gate, Hyde ~ 2372
## 9 191 Hyde Park Corner, Hy~ 248 Triangle Car Park,~ 2269
## 10 248 Triangle Car Park, H~ 191 Hyde Park Corner, ~ 2206
## # ... with 4 more variables: StartStation.Lat <dbl>, StartStation.Lon <dbl>,
## # EndStation.Lat <dbl>, EndStation.Lon <dbl>ggplot() +
geom_tile(data = viajes_finde_T10,
aes(x = as.factor(StartStation.Id),
y = as.factor(EndStation.Id),
fill = cant)) +
scale_fill_distiller(palette = "RdYlGn") +
labs(title="Top 10 en Fines de semana incluídos viajes circulares",
subtitle="Matriz Origen-Destino",
x="Estacion Origen",
y="Estación Destino",
fill="Viajes")
Vemos que la mayoría son viajes circulares, compatibles con el uso recreativo, de hecho el más usado es el viaje circular desde y hacia Hyde Park Corner. Los que no son circulares, pero tambien numeroso tienen a Hyde Park Corner como origen, dos de ellos, y otro la tiene como destino. Tambien aparece el que tiene id 785 que corresponde a una de las estaciones del Parque Olímpico
Repitamos pero ahora sacando los viajes circulares
ggplot() +
geom_tile(data = viajes_finde_SC_t10,
aes(x = as.factor(StartStation.Id),
y = as.factor(EndStation.Id),
fill = cant)) +
scale_fill_distiller(palette = "RdYlGn") +
labs(title="Top 10 en Fines de semana incluídos viajes circulares",
subtitle="Matriz Origen-Destino",
x="Estacion Origen",
y="Estación Destino",
fill="Viajes")
Sacando los viajes circulares Hyde Park Corner sigue siendo muy utilizada, como origen y como destino.
Ahora si ruteamos el Top 10 de fin de semana sin viajes circulares
ruteo_top10_findes <- list(viajes_finde_SC_t10$StartStation.Name,
viajes_finde_SC_t10$StartStation.Lon,
viajes_finde_SC_t10$StartStation.Lat,
viajes_finde_SC_t10$EndStation.Name,
viajes_finde_SC_t10$EndStation.Lon,
viajes_finde_SC_t10$EndStation.Lat)ruteo_top10_findes <- pmap(ruteo_top10_findes, rutear_bikes) %>%
reduce(rbind)summary(ruteo_top10_findes)## ORIGEN
## Black Lion Gate, Kensington Gardens :3
## Hyde Park Corner, Hyde Park :3
## Albert Gate, Hyde Park :1
## Lee Valley VeloPark, Queen Elizabeth Olympic Park:1
## Palace Gate, Kensington Gardens :1
## Triangle Car Park, Hyde Park :1
## (Other) :0
## DESTINO src
## Hyde Park Corner, Hyde Park :3 Min. : 16.0
## Albert Gate, Hyde Park :2 1st Qu.: 78.0
## Black Lion Gate, Kensington Gardens :2 Median :353.0
## Aquatic Centre, Queen Elizabeth Olympic Park:1 Mean :289.7
## Palace Gate, Kensington Gardens :1 3rd Qu.:385.2
## Triangle Car Park, Hyde Park :1 Max. :692.0
## (Other) :0
## dst duration distance geometry
## Min. : 16.00 Min. : 1.757 Min. :0.3892 LINESTRING :10
## 1st Qu.: 42.75 1st Qu.: 8.007 1st Qu.:1.6038 epsg:4326 : 0
## Median :215.50 Median : 8.536 Median :1.8276 +proj=long...: 0
## Mean :247.00 Mean : 9.128 Mean :1.8221
## 3rd Qu.:353.00 3rd Qu.:12.836 3rd Qu.:2.4459
## Max. :692.00 Max. :15.788 Max. :2.9801
## leaflet(ruteo_top10_findes) %>%
addTiles() %>%
# addProviderTiles(providers$CartoDB.Positron) %>%
addPolylines(color = ~colorNumeric(paleta, ruteo_top10_findes$distance)(distance), label = paste("Distancia:", ruteo_top10_findes$distance, "|",
"Duración:", ruteo_top10_findes$duration))Como vemos aparecen dos zonas, la de Hyde Park donde además hay muchos trayectos circulares y arriba a la derecha el trayecto que une dos estaciones en el Parque Olímpico.
Queda claro el uso recreativo predominante en la zona del Hyde Park durante los fines de semana. Si van a Londres los invito a pasear en bici por la zona del Regent Park,es muy pintoresco, está el zoo y no van a chocarse con tanta gente!!!