Ejemplo Metro SantiagoCL
Joshua Kunst
Sat Apr 29 20:30:16 2017
Introducción
Ejercicio de manipulación de datos y visualización de datos de subidas de paraderos del metro de Santiago.
Se utilizará:
readrpara la lectura de datos.dplyrytidypara manipulación de información.ggplot2para la visualización.stringrpara tratamiento de strings.#’
Cargando paquetes
library(readr)
library(dplyr)
library(ggplot2)
library(hrbrthemes)
library(viridis)
library(stringr)
library(tidyr)
library(purrr)Estudiando las dubidad de
Los datos de _matrices de viaje son obtenidos de Directorio de Transporte Público: http://www.dtpm.gob.cl/index.php/2013-04-29-20-33-57/matrices-de-viaje.
dfsubidas <- read_csv2("data/2015.04_Subidas_paradero_mediahora_web.csv")Primera inspección;
dfsubidas## # A tibble: 358,543 × 3
## paraderosubida mediahora subidas_laboral_promedio
## <chr> <time> <chr>
## 1 ALCANTARA 05:30:00 2.6000000000000000
## 2 ALCANTARA 06:00:00 13.2000000000000000
## 3 ALCANTARA 06:30:00 53.4000000000000000
## 4 ALCANTARA 07:00:00 184.8000000000000000
## 5 ALCANTARA 07:30:00 364.0000000000000000
## 6 ALCANTARA 08:00:00 546.2000000000000000
## 7 ALCANTARA 08:30:00 478.6000000000000000
## 8 ALCANTARA 09:00:00 359.0000000000000000
## 9 ALCANTARA 09:30:00 275.4000000000000000
## 10 ALCANTARA 10:00:00 229.6000000000000000
## # ... with 358,533 more rowsLa tabla contiene información de subidas promedios en días laborales por cada media hora. La variable subidas_laboral_promedio se ha cargado como carácter en lugar de numérica.
dfsubidas <- mutate(dfsubidas, subidas_laboral_promedio = as.numeric(subidas_laboral_promedio))
dfsubidas## # A tibble: 358,543 × 3
## paraderosubida mediahora subidas_laboral_promedio
## <chr> <time> <dbl>
## 1 ALCANTARA 05:30:00 2.6
## 2 ALCANTARA 06:00:00 13.2
## 3 ALCANTARA 06:30:00 53.4
## 4 ALCANTARA 07:00:00 184.8
## 5 ALCANTARA 07:30:00 364.0
## 6 ALCANTARA 08:00:00 546.2
## 7 ALCANTARA 08:30:00 478.6
## 8 ALCANTARA 09:00:00 359.0
## 9 ALCANTARA 09:30:00 275.4
## 10 ALCANTARA 10:00:00 229.6
## # ... with 358,533 more rowsCuantos paraderos contiene la tabla:
count(dfsubidas, paraderosubida)## # A tibble: 11,222 × 2
## paraderosubida n
## <chr> <int>
## 1 - 45
## 2 ALCANTARA 37
## 3 BAQUEDANO L1 37
## 4 BAQUEDANO L5 36
## 5 BARRANCAS 37
## 6 BELLAS ARTES 37
## 7 BELLAVISTA DE LA FLORIDA 37
## 8 BLANQUEADO 37
## 9 CAL Y CANTO 36
## 10 CAMINO AGRICOLA 37
## # ... with 11,212 more rowsContiene 11222. Filtramos solamente paradas de metro.
set.seed(1234)
sample(dfsubidas$paraderosubida, 20)## [1] "L-13-3-35-SN" "L-8-22-10-NS" "L-7-45-6-SN" "L-8-32-5-NS"
## [5] "T-27-224-NS-15" "PEDRERO" "E-20-189-PO-5" "L-21-18-20-OP"
## [9] "T-11-83-SN-10" "L-34-40-50-PO" "T-13-97-SN-35" "L-34-7-60-OP"
## [13] "L-23-36-15-SN" "T-33-264-SN-30" "L-23-6-20-OP" "T-23-376-NS-7"
## [17] "L-23-4-25-PO" "L-2-26-10-NS" "L-17-42-5-NS" "L-21-18-10-PO"Luego de explorar un poco está columna se selecciona lo que no posea un string que comience con T, L, I o E y un guión:
dfsubidas <- filter(dfsubidas, !str_detect(paraderosubida, "^(T|L|I|E)?-"))
count(dfsubidas, paraderosubida)## # A tibble: 106 × 2
## paraderosubida n
## <chr> <int>
## 1 ALCANTARA 37
## 2 BAQUEDANO L1 37
## 3 BAQUEDANO L5 36
## 4 BARRANCAS 37
## 5 BELLAS ARTES 37
## 6 BELLAVISTA DE LA FLORIDA 37
## 7 BLANQUEADO 37
## 8 CAL Y CANTO 36
## 9 CAMINO AGRICOLA 37
## 10 CARLOS VALDOVINOS 37
## # ... with 96 more rowsY luego del filtros nos quedamos con 106 estaciones (de metro supuestamente). Sin embargo vemos que aparece Baquedano dos veces dado que es una estación de combinación. En esta oportunidad la consideraremos como una por lo que al nomnre de la estación removeremos la parte que hace distición a que línea es " L\\d" donde "\\d" es algún número.
Entonces removemos, agrupamos para sumar los casos de combinaciones:
dfsubidas <- dfsubidas %>%
mutate(paraderosubida = str_replace(paraderosubida, " L\\d$", "")) %>%
group_by(paraderosubida, mediahora) %>%
summarise(subidas_laboral_promedio = sum(subidas_laboral_promedio)) %>%
ungroup()
count(dfsubidas, paraderosubida)## # A tibble: 101 × 2
## paraderosubida n
## <chr> <int>
## 1 ALCANTARA 37
## 2 BAQUEDANO 37
## 3 BARRANCAS 37
## 4 BELLAS ARTES 37
## 5 BELLAVISTA DE LA FLORIDA 37
## 6 BLANQUEADO 37
## 7 CAL Y CANTO 36
## 8 CAMINO AGRICOLA 37
## 9 CARLOS VALDOVINOS 37
## 10 CEMENTERIOS 37
## # ... with 91 more rows;)!.
Ahora contemos si todas las estaciones contiene la misma cantidad de registros
dfsubidas %>%
count(paraderosubida) %>%
count(n)## # A tibble: 3 × 2
## n nn
## <int> <int>
## 1 36 38
## 2 37 62
## 3 38 1Existe una estación que contiene 38 registros y otras 38 estaciones que contiene 36 regitros.
dfsubidas %>%
count(mediahora)## # A tibble: 38 × 2
## mediahora n
## <time> <int>
## 1 00:00:00 1
## 2 05:30:00 101
## 3 06:00:00 101
## 4 06:30:00 101
## 5 07:00:00 101
## 6 07:30:00 101
## 7 08:00:00 101
## 8 08:30:00 101
## 9 09:00:00 101
## 10 09:30:00 101
## # ... with 28 more rowsdfsubidas %>%
count(mediahora) %>%
filter(n != 101)## # A tibble: 2 × 2
## mediahora n
## <time> <int>
## 1 00:00:00 1
## 2 23:30:00 63# Eliminaremos las 12AM.
dfsubidas <- filter(dfsubidas, mediahora != 0)
# dfsubidas <- complete(dfsubidas, paraderosubida, mediahora,
# fill = list(subidas_laboral_promedio = 0)) Ahora visualizaremos los registros por líneas y veremos la tencendia a través de un suavizamientos:
gg <- ggplot(dfsubidas) +
geom_line(aes(mediahora, subidas_laboral_promedio,
group = paraderosubida), alpha = 0.25) +
geom_smooth(aes(mediahora, subidas_laboral_promedio), size = 1.3) +
scale_x_time() +
scale_y_comma()
gg
Se observa lo esperado: mucha gente ingresa a las 8 y 18.30 app además de un leve peak a las 13.00 horas.
Por diversión agregaremos las horas puntas:
library(lubridate)
dfhorarios <- data_frame(
xmin = c(hms("7:00:00"), hms("18:00:00")),
xmax = c(hms("8:59:59"), hms("19:59:69")),
ymin = c(0, 0),
ymax = rep(7000, 2),
g = c(1, 2)
)
gg <- gg +
geom_rect(data = dfhorarios,
aes(xmin = xmin, xmax = xmax,
ymin = ymin, ymax = ymax), alpha = 0.2)
gg
## Agrupando Estaciones
Vemos que algunas estaciones
dfsubidas2 <- spread(dfsubidas, mediahora, subidas_laboral_promedio)
dfsubidas2## # A tibble: 101 × 38
## paraderosubida `05:30:00` `06:00:00` `06:30:00` `07:00:00`
## * <chr> <dbl> <dbl> <dbl> <dbl>
## 1 ALCANTARA 2.6 13.2 53.4 184.8
## 2 BAQUEDANO 88.0 132.6 234.6 493.4
## 3 BARRANCAS 37.0 195.4 406.4 736.8
## 4 BELLAS ARTES 6.6 37.0 92.2 177.6
## 5 BELLAVISTA DE LA FLORIDA 157.6 297.8 565.8 1113.6
## 6 BLANQUEADO 35.8 199.6 411.4 646.4
## 7 CAL Y CANTO 103.0 575.2 1281.0 2309.0
## 8 CAMINO AGRICOLA 38.2 113.2 281.6 530.6
## 9 CARLOS VALDOVINOS 46.2 113.0 210.4 342.4
## 10 CEMENTERIOS 20.8 78.4 167.6 249.8
## # ... with 91 more rows, and 33 more variables: `07:30:00` <dbl>,
## # `08:00:00` <dbl>, `08:30:00` <dbl>, `09:00:00` <dbl>,
## # `09:30:00` <dbl>, `10:00:00` <dbl>, `10:30:00` <dbl>,
## # `11:00:00` <dbl>, `11:30:00` <dbl>, `12:00:00` <dbl>,
## # `12:30:00` <dbl>, `13:00:00` <dbl>, `13:30:00` <dbl>,
## # `14:00:00` <dbl>, `14:30:00` <dbl>, `15:00:00` <dbl>,
## # `15:30:00` <dbl>, `16:00:00` <dbl>, `16:30:00` <dbl>,
## # `17:00:00` <dbl>, `17:30:00` <dbl>, `18:00:00` <dbl>,
## # `18:30:00` <dbl>, `19:00:00` <dbl>, `19:30:00` <dbl>,
## # `20:00:00` <dbl>, `20:30:00` <dbl>, `21:00:00` <dbl>,
## # `21:30:00` <dbl>, `22:00:00` <dbl>, `22:30:00` <dbl>,
## # `23:00:00` <dbl>, `23:30:00` <dbl>dfsubidas3 <- select(dfsubidas2, -1) %>%
mutate_all(function(x) ifelse(is.na(x), 0, x)) %>%
mutate_all(scale)
kmeans <- map_df(1:10, function(k){ # k <- 6
set.seed(123)
kmod <- kmeans(dfsubidas3, centers = k)
data_frame(k = k, wcss = 1 - kmod$betweenss/kmod$totss, kmod = list(kmod))
})
ggplot(kmeans) +
geom_line(aes(k, wcss)) +
scale_y_continuous(labels = scales::percent) +
scale_x_continuous(breaks = seq(1:10), minor_breaks = NULL)
K <- 4
dfsubidas2 <- mutate(dfsubidas2, grupo = kmeans$kmod[[K]]$cluster)
dfsubidas <- left_join(dfsubidas, select(dfsubidas2, paraderosubida, grupo))
dfsubidas## # A tibble: 3,699 × 4
## paraderosubida mediahora subidas_laboral_promedio grupo
## <chr> <time> <dbl> <int>
## 1 ALCANTARA 05:30:00 2.6 3
## 2 ALCANTARA 06:00:00 13.2 3
## 3 ALCANTARA 06:30:00 53.4 3
## 4 ALCANTARA 07:00:00 184.8 3
## 5 ALCANTARA 07:30:00 364.0 3
## 6 ALCANTARA 08:00:00 546.2 3
## 7 ALCANTARA 08:30:00 478.6 3
## 8 ALCANTARA 09:00:00 359.0 3
## 9 ALCANTARA 09:30:00 275.4 3
## 10 ALCANTARA 10:00:00 229.6 3
## # ... with 3,689 more rowsggplot(dfsubidas, aes(mediahora, subidas_laboral_promedio)) +
geom_line(aes(group = paraderosubida), alpha = 0.15) +
geom_smooth(aes(group = grupo, color = factor(grupo))) +
scale_color_viridis(discrete = TRUE) +
scale_x_time() +
facet_wrap(~grupo) +
theme(legend.position = "none")
Geográficamente
routes <- read_csv("data/routes.txt")
trips <- read_csv("data/trips.txt")
stops <- read_csv("data/stops.txt")
shapes <-read_csv("data/shapes.txt")
stops_metro <- stops %>%
filter(!grepl("\\d", stop_id)) %>%
mutate(stop_url = basename(stop_url))
routes_metro <- filter(routes, grepl("^L\\d",route_id))
shapes_metro <- routes %>%
filter(grepl("^L\\d",route_id)) %>%
semi_join(trips, .) %>%
semi_join(shapes, .) %>%
### IMPORTANTE
filter(str_detect(shape_id, "-I")) %>%
mutate(shape_id2 = str_replace(shape_id, "-I", ""))
colors_metro <- distinct(shapes, shape_id) %>%
left_join(distinct(trips, shape_id, route_id)) %>%
left_join(distinct(routes, route_id, route_color)) %>%
semi_join(shapes_metro) %>%
mutate(route_color = paste0("#", route_color))
str_to_id2 <- function(x) {
x %>%
str_trim() %>%
str_to_lower() %>%
str_replace_all("\\s+", "_") %>%
str_replace_all("\\s+de\\s+", "") %>%
str_replace_all("á", "a") %>%
str_replace_all("é", "e") %>%
str_replace_all("í", "i") %>%
str_replace_all("ó", "o") %>%
str_replace_all("ú", "u") %>%
str_replace_all("ñ", "n") %>%
str_replace_all("`", "") %>%
str_replace_all("_de_", "_") %>%
str_replace_all("rondizonni", "rondizzoni")
}
dfsubidas2 <- mutate(dfsubidas2, id = str_to_id2(paraderosubida))
stops_metro_data <- stops_metro %>%
mutate(id = str_to_id2(stop_name)) %>%
left_join(select(dfsubidas2, grupo, id))
ggplot()+
geom_path(data = shapes_metro,
aes(x = shape_pt_lon, y = shape_pt_lat, group = shape_id, color = shape_id),
size = 1.2) +
geom_point(data = stops_metro_data,
aes(x = stop_lon, y = stop_lat, color = factor(grupo)),
size = 2, alpha = 0.95) +
scale_color_manual(values = c(colors_metro$route_color, viridis(K))) +
# scale_color_viridis(discrete = TRUE) +
facet_wrap(~grupo) +
scale_x_continuous(breaks = NULL) +
scale_y_continuous(breaks = NULL) +
coord_fixed() +
theme_minimal() +
theme(legend.position = "left")