TRANSPORTE
juan vargas
29/5/2020
INFRAESTRUCTURA, TRANSPORTE Y NUEVAS TECNOLOGÍAS
MEU 2020
#Sistema de información de ocupación de vagones de tren en tiempo real
#ALUMNOS:Donoso, Rodrigo | Luraschi, Guillermo | Vargas, Juan
options(scipen = 999)library(tidyverse)## -- Attaching packages ----------------------------------------------------- tidyverse 1.3.0 --## v ggplot2 3.3.0 v purrr 0.3.3
## v tibble 2.1.3 v dplyr 0.8.5
## v tidyr 1.0.2 v stringr 1.4.0
## v readr 1.3.1 v forcats 0.5.0## -- Conflicts -------------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(sf)## Linking to GEOS 3.6.1, GDAL 2.2.3, PROJ 4.9.3library(ggmap)## Google's Terms of Service: https://cloud.google.com/maps-platform/terms/.## Please cite ggmap if you use it! See citation("ggmap") for details.library(leaflet)
library(readxl)#Base geografica
AMBA <- st_read("gba_munis.shp")%>%
st_transform(crs=4326)## Reading layer `gba_munis' from data source `C:\Users\usuario\Documents\JUAN\POSGRADOS\MAESTRIA EN ECONOMIA URBANA\2020\TRANSPORTE Y NUEVAS TECNOLOGIAS\TP\maps\mapas TP\gba_munis.shp' using driver `ESRI Shapefile'
## Simple feature collection with 33 features and 4 fields
## geometry type: POLYGON
## dimension: XY
## bbox: xmin: 5579.146 ymin: 6079.627 xmax: 5681.528 ymax: 6208.762
## proj4string: +proj=tmerc +lat_0=-90 +lon_0=-60 +k=1 +x_0=5500000 +y_0=0 +ellps=GRS80 +units=km +no_defsESTACIONES_AMBA <- st_read("amba_puntos.shp")%>%
st_transform(crs=4326)## Reading layer `amba_puntos' from data source `C:\Users\usuario\Documents\JUAN\POSGRADOS\MAESTRIA EN ECONOMIA URBANA\2020\TRANSPORTE Y NUEVAS TECNOLOGIAS\TP\maps\mapas TP\amba_puntos.shp' using driver `ESRI Shapefile'
## Simple feature collection with 302 features and 4 fields
## geometry type: POINT
## dimension: XY
## bbox: xmin: -59.43242 ymin: -35.18423 xmax: -57.94964 ymax: -34.09784
## CRS: 4326ESTACIONES_AMBA <- ESTACIONES_AMBA %>%
rename(Linea="Línea")#Ilustración de mapa
ggplot()+
geom_sf(data=AMBA, aes(fill= MUNICIPIO), color= NA)+
geom_sf(data=ESTACIONES_AMBA, color="blue", size=3)
#Datos demograficos
AMBA_poblacion <- read_excel("POBLACION MUNICIPIOS.xlsx")
head(AMBA_poblacion)## # A tibble: 6 x 2
## MUNICIPIO POBLACION
## <chr> <dbl>
## 1 Almirante Brown 552902
## 2 Avellaneda 342677
## 3 Berazategui 324244
## 4 CABA 2890151
## 5 Cañuelas 51892
## 6 Escobar 213619AMBA <- AMBA %>% left_join(AMBA_poblacion, by="MUNICIPIO")## Warning: Column `MUNICIPIO` joining factor and character vector, coercing into
## character vectornames(AMBA)## [1] "OBJECTID" "MUNICIPIO" "Shape_Leng" "Shape_Area" "POBLACION"
## [6] "geometry"#Visualizamos la distribucion de la población en el territorio
ggplot()+
geom_sf(data=AMBA, aes(fill=POBLACION), color=NA)+
scale_fill_gradient(low="khaki2", high="deeppink4")
#Cargamos los datos de la linea Sarmiento en su ramal ONCE-MORENO del AMBA (Fuente: CNRT|Informe Estadístico Anual 2018 – Red Ferroviaria de Pasajeros del Área Metropolitana de Buenos Aires)
DATOS
#Mostramos la cantidad de viajes por año según cada estación
PASAJEROS <- read_excel("SARMIENTO viajes por ESTACION.xlsx")
head(PASAJEROS)## # A tibble: 6 x 15
## estacion `AÑO 2006` `AÑO 2007` `AÑO 2008` `AÑO 2009` `AÑO 2010` `AÑO 2011`
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Once 16488737 16669013 17069221 15580929 14991825 13735033
## 2 Cabalito 2498483 2463570 2526573 2216651 1908702 1710946
## 3 Flores 3322284 3354709 3437255 3215375 2942751 2674090
## 4 Floresta 1725998 1731749 1872275 1767646 1626399 1489208
## 5 Villa L~ 981305 981488 1041053 1020304 861907 766331
## 6 Liniers 9507799 9681618 9588052 8865199 8182386 7566568
## # ... with 8 more variables: `AÑO 2012` <dbl>, `AÑO 2013` <dbl>, `AÑO
## # 2014` <dbl>, `AÑO 2015` <dbl>, `AÑO 2016` <dbl>, `AÑO 2017` <dbl>, `AÑO
## # 2018` <chr>, PROMEDIO <dbl>summary(PASAJEROS)## estacion AÑO 2006 AÑO 2007 AÑO 2008
## Length:16 Min. : 981305 Min. : 626968 Min. : 1041053
## Class :character 1st Qu.: 2862652 1st Qu.: 2318145 1st Qu.: 2881888
## Mode :character Median : 5956926 Median : 5163608 Median : 6145858
## Mean : 6437789 Mean : 6702085 Mean : 7156327
## 3rd Qu.: 7205279 3rd Qu.:10512132 3rd Qu.:10428384
## Max. :16488737 Max. :16669013 Max. :17069221
## AÑO 2009 AÑO 2010 AÑO 2011 AÑO 2012
## Min. : 1020304 Min. : 861907 Min. : 766331 Min. : 306844
## 1st Qu.: 2519037 1st Qu.: 2110082 1st Qu.: 1863160 1st Qu.: 798032
## Median : 5399030 Median : 4907208 Median : 4311390 Median :1629068
## Mean : 6560649 Mean : 6047174 Mean : 5399432 Mean :2389495
## 3rd Qu.: 9725871 3rd Qu.: 8931790 3rd Qu.: 8034112 3rd Qu.:3505443
## Max. :15580929 Max. :14991825 Max. :13735033 Max. :6911828
## AÑO 2013 AÑO 2014 AÑO 2015 AÑO 2016
## Min. : 53870 Min. : 149825 Min. : 79289 Min. : 0
## 1st Qu.: 156230 1st Qu.: 700957 1st Qu.: 744305 1st Qu.: 1251654
## Median : 307554 Median : 1377948 Median : 1695998 Median : 2071214
## Mean : 701115 Mean : 2460701 Mean : 3439386 Mean : 3573646
## 3rd Qu.: 970348 3rd Qu.: 2752780 3rd Qu.: 4493242 3rd Qu.: 3131018
## Max. :3466409 Max. :11428120 Max. :15147484 Max. :16502913
## AÑO 2017 AÑO 2018 PROMEDIO
## Min. : 443982 Length:16 Min. : 723668
## 1st Qu.: 1362573 Class :character 1st Qu.: 1741412
## Median : 1847864 Mode :character Median : 3323767
## Mean : 3778758 Mean : 4610034
## 3rd Qu.: 3091526 3rd Qu.: 5983814
## Max. :17253889 Max. :14240107ggplot(data=PASAJEROS)+
geom_col(aes(x=estacion, y= PROMEDIO), fill="orange")
#Observamos que para el promedio de viajes para los años entre 2006 y 2018, las estaciones con mas pasajeros soon ONCE, MORON, MERLO y MORENO
#Cargamos los datos de los viajes por mes
PASAJEROS_MES <- read_excel("VIAJES POR MES.xlsx")ggplot(data=PASAJEROS_MES)+
geom_line(aes(x=Analisis, y=ENERO), color="blue", size= 2)+
geom_line(aes(x=Analisis, y=FEBRERO),color="red", size= 2)+
geom_line(aes(x=Analisis, y=MARZO),color="green", size= 2)+
geom_line(aes(x=Analisis, y=ABRIL),color="yellow", size= 2)+
geom_line(aes(x=Analisis, y=MAYO),color="black", size= 2)+
geom_line(aes(x=Analisis, y=JUNIO),color="brown", size= 2)+
geom_line(aes(x=Analisis, y=JULIO),color="orange", size= 2)+
geom_line(aes(x=Analisis, y=AGOSTO),color="pink", size= 2)+
geom_line(aes(x=Analisis, y=SEPTIEMBRE), color="salmon", size= 2)+
geom_line(aes(x=Analisis, y=OCTUBRE), color="violet", size= 2)+
geom_line(aes(x=Analisis, y=NOVIEMBRE), color="gray", size= 2)+
geom_line(aes(x=Analisis, y=DICIEMBRE), color="light blue", size=2)+
labs(title = "PASAJEROS POR MES",
subtitle = "FFCC Sarmiento, ramal ONCE-MORENO",
x="AÑO",
y="MES",
fill="Analisis")
#Estudiamos la correlacion entre la poblacion y el primedio de la cantidad de viajes anuales para los años 2006 al 2018.
ESTACIONES <- read_excel("viajes.xlsx")
head(ESTACIONES)## # A tibble: 6 x 3
## estacion cantidad poblacion
## <chr> <dbl> <dbl>
## 1 Once 14240107 137521
## 2 Caballito 1566949 183396
## 3 Flores 2352255 150484
## 4 Floresta 1361583 39473
## 5 Villa Luro 723668 33058
## 6 Liniers 5456200 44234summary(ESTACIONES)## estacion cantidad poblacion
## Length:16 Min. : 723668 Min. : 33058
## Class :character 1st Qu.: 1741412 1st Qu.: 43289
## Mode :character Median : 3323766 Median :103167
## Mean : 4610034 Mean :136024
## 3rd Qu.: 5983814 3rd Qu.:171717
## Max. :14240107 Max. :452505#Establecemos la correlacion entre la cantidad de viajes y la población donde se encuentra la estación. Para el caso de CABA se toma por barrio y para Pcia de Buenos Aires por municipio
cor(ESTACIONES$cantidad, ESTACIONES$poblacion)## [1] 0.5554576#Se obtiene una correlacion moderada, según la siguiente tabulación:
de 0,7 a 1: de fuerte a total
de 0,5 a 0,7: de moderada a fuerte
de 0,3 a 0,7: de débil a moderada
menor a 0,3: de nula a débilmodelo2 <- lm (poblacion ~ cantidad, data = ESTACIONES)modelo2##
## Call:
## lm(formula = poblacion ~ cantidad, data = ESTACIONES)
##
## Coefficients:
## (Intercept) cantidad
## 58921.70757 0.01672#Para valores constantes, cuando la variable poblacion aumenta en una unidad la cantidad de viajes anuales aumenta en 0.01672. #Por cada aumento de poblacion, la cantidad de viajes aumenta 0.01672
ggplot(data = modelo2) +
geom_point(aes(x = cantidad, y = poblacion), size= 3, color="brown")+
geom_abline(aes(intercept = 58921.70757 , slope =0.01672), color = "orange")+
labs(title = "Correlación entre poblacion y cantidad de viajes por año",
subtitle = "Tren Sarmiento",
y = "viajes anuales") 
MAPA
#Mostraremos la cantidad de viajes relacionadas con el tamaño de la poblacion en el territorio.
#Filtramos las variables hasta obtener las estaciones del FFCC Sarmiento para el ramal ONCE-MORENO
ESTACIONES_AMBA <- ESTACIONES_AMBA %>%
filter(Linea=="Sarmiento") %>%
filter(ETIQUETA %in% c ("Once","Caballito", "Flores", "Floresta", "Villa Luro", "Liniers", "Ciudadela", "Ramos Mejía", "Ramos Mejía", "Morón", "Castelar", "Ituzaingó", "S.A. de Padua", "Merlo", "Paso del Rey", "Moreno"))ESTACIONES_AMBA <- ESTACIONES_AMBA %>%
rename(estacion="ETIQUETA")viajes_estaciones <- ESTACIONES_AMBA %>% left_join(ESTACIONES, by= "estacion") %>%
select(estacion, cantidad, geometry)## Warning: Column `estacion` joining factor and character vector, coercing into
## character vectornames (viajes_estaciones)## [1] "estacion" "cantidad" "geometry"viajes_cantidad <- viajes_estaciones viajes_cantidad <- cbind(viajes_cantidad, st_coordinates(viajes_cantidad)) %>%
st_set_geometry(NULL)summary(viajes_cantidad)## estacion cantidad X Y
## Length:16 Min. : 723668 Min. :-58.79 Min. :-34.66
## Class :character 1st Qu.: 2155928 1st Qu.:-58.73 1st Qu.:-34.65
## Mode :character Median : 4011264 Median :-58.59 Median :-34.64
## Mean : 5354618 Mean :-58.60 Mean :-34.64
## 3rd Qu.: 8069818 3rd Qu.:-58.50 3rd Qu.:-34.64
## Max. :14240107 Max. :-58.41 Max. :-34.61ggplot()+
geom_sf(data=AMBA, aes(fill=POBLACION), color=NA)+
scale_fill_gradient(low="khaki2", high="deeppink4")+
geom_sf_text(data=AMBA, aes(label = MUNICIPIO), size=3, color = "brown")+
geom_point(data = viajes_cantidad, aes(x=X, y=Y, size=cantidad, color="red"))+
labs(title = "FFCC Sarmiento: CANTIDAD DE VIAJES y POBLACION",
subtitle = "Promedio de viajes anuales 2006-2018",
caption = "Fuente CNT estadisticas 2018 para FFCC Sarmiento - ELABORACION PROPIA",
fill = "POBLACION")## Warning in st_point_on_surface.sfc(sf::st_zm(x)): st_point_on_surface may not
## give correct results for longitude/latitude data