Objetivo 1. Análisis introductorio Centro vs Periferia
Grupo 4
Introducción
Como análisis introductorio y con el objetivo también de familiarizarnos con el comportamiento de las estaciones, especialmente de las del centro y la periferia de Valencia. Con este primer análisis, buscamos encontrar comportamientos similares entre las estaciones del centro y las estaciones de la periferia.
Librerías utilizadas
Abordamos este objetivo principalmente desde el punto de la visualización, por lo que muchas de las librerías utilizadas brindan herramientas para elaborar gráficos, animaciones y mapas interactivos que permitan sacar conclusiones.
library(sf)
library(animation)
library(dplyr)
library(leaflet)
library(lubridate)
library(ggplot2)
library(tidyr)
library(gganimate)
library(av)
library(gifski)
library(sp)
library(htmlwidgets)
library(leafem)
library(leaflet.extras)
library(rmarkdown)Selección de observaciones
set.seed(1)
load('df_agrupado.Rda')Dobles 0
Para comenzar, se cargarán los datos del dataframe obtenido durante el tratamiento de los datos y se le llamará a este data. A continuación eliminaremos de data las estaciones 11, 17, 47, 113, 155, 166 y 232. Esto se debe a que durante los análisis, hemos encontrado que estas estaciones tienen varias observaciones en las que el número de bicicletas disponibles es 0 y el número de bornes disponibles también es 0; lo cual nos hace pensar que se trata de un error y podría afectar a los resultados. Si bien, habrá usos futuros del dataframe df_merge original del tratamiento en los que se incluyan estas estaciones.
Así, data se ve de la siguiente manera:
est_bad <- unique(df_merge[df_merge$avg_av == 0 & df_merge$avg_free == 0, ]$number_)
data <- df_merge
eliminar_estacion <- function(data, n) {
data <- data[data$number_ != n, ]
return(data)
}
for (n in est_bad) {
data <- eliminar_estacion(data, n)
}
paged_table(data[1:5,])Selección de barrios
A continuación, obtendremos el dataframe estaciones ya usado en el tratamiento de los datos, que contiene los datos estáticos de cada estación, que no cambian con el paso del tiempo. Con este dataframe, seleccionaremos las estaciones que se encuentran en los barrios que deseamos, pudiendo así seleccionar las estaciones de barrios céntricos por una parte y las estaciones de barrios periféricos por otra.
estaciones <- data %>% select(c('number_', 'name', 'address', 'avg_total','coddistbar', 'nombre_barrio', 'codbarrio', 'coddistrit', 'geometry_punto', 'geometry_barrio', 'nombre_distrito', 'geometry_distrito'))
estaciones <- estaciones %>% distinct(number_, .keep_all = TRUE)
paged_table(estaciones[1:5,])Una vez tenemos este dataframe, podemos elegir “a ojo” los barrios que deseamos considerar en el análisis tanto como periféricos como centrales. Así, los barrios de la periferia serán:
periferia <- c('SOTERNES','LA LLUM', 'LA FONTSANTA','VARA DE QUART','SANT ISIDRE','SAFRANAR','FAVARA','CAMI REAL','L\'HORT DE SENABRE','SANT MARCEL.LI','LA CREU COBERTA','MALILLA','LA FONTETA S.LLUIS','NA ROVELLA','CIUTAT DE LES ARTS I DE LES CIENCIES','LA PUNTA','NATZARET','EL GRAU','PENYA-ROJA','CABANYAL-CANYAMELAR','LA CREU DEL GRAU','AIORA','L\'ILLA PERDUDA','BETERO','LA MALVA-ROSA','LA CARRASCA','CAMI DE VERA','BENIMACLET','SANT LLORENS','ELS ORRIOLS','TORREFIEL','BENICALAP','CIUTAT FALLERA','SANT PAU','BENIMAMET')
periferia## [1] "SOTERNES"
## [2] "LA LLUM"
## [3] "LA FONTSANTA"
## [4] "VARA DE QUART"
## [5] "SANT ISIDRE"
## [6] "SAFRANAR"
## [7] "FAVARA"
## [8] "CAMI REAL"
## [9] "L'HORT DE SENABRE"
## [10] "SANT MARCEL.LI"
## [11] "LA CREU COBERTA"
## [12] "MALILLA"
## [13] "LA FONTETA S.LLUIS"
## [14] "NA ROVELLA"
## [15] "CIUTAT DE LES ARTS I DE LES CIENCIES"
## [16] "LA PUNTA"
## [17] "NATZARET"
## [18] "EL GRAU"
## [19] "PENYA-ROJA"
## [20] "CABANYAL-CANYAMELAR"
## [21] "LA CREU DEL GRAU"
## [22] "AIORA"
## [23] "L'ILLA PERDUDA"
## [24] "BETERO"
## [25] "LA MALVA-ROSA"
## [26] "LA CARRASCA"
## [27] "CAMI DE VERA"
## [28] "BENIMACLET"
## [29] "SANT LLORENS"
## [30] "ELS ORRIOLS"
## [31] "TORREFIEL"
## [32] "BENICALAP"
## [33] "CIUTAT FALLERA"
## [34] "SANT PAU"
## [35] "BENIMAMET"Y los barrios céntricos serán:
centro <- c('EL MERCAT','LA XEREA','LA SEU','SANT FRANCESC','EL CARME','EL PILAR')
centro## [1] "EL MERCAT" "LA XEREA" "LA SEU" "SANT FRANCESC"
## [5] "EL CARME" "EL PILAR"barrios = st_read("barris-barrios.geojson")## Reading layer `barris-barrios' from data source
## `C:\Users\Jose\Documents\Documentos\Examenes\Proyecto II, integración y preparación de datos\Objetivo_1\Objetivo_1\barris-barrios.geojson'
## using driver `GeoJSON'
## Simple feature collection with 88 features and 8 fields
## Geometry type: POLYGON
## Dimension: XY
## Bounding box: xmin: -0.432535 ymin: 39.27893 xmax: -0.2753685 ymax: 39.56659
## Geodetic CRS: WGS 84estaciones2 <- rbind(estaciones[estaciones$nombre_barrio %in% periferia,],
estaciones[estaciones$nombre_barrio %in% centro,])
estaciones2$latitud <- st_coordinates(estaciones2$geometry_punto)[, "Y"]
estaciones2$longitud <- st_coordinates(estaciones2$geometry_punto)[, "X"]
barrios <- barrios[barrios$nombre %in% unique(estaciones2$nombre_barrio),]En el siguiente mapa pueden observarse los barrios seleccionados.
mapa_seleccion <- leaflet() %>%
addTiles() %>%
addPolygons(data = barrios, popup = ~nombre, fillColor = "blue", fillOpacity = 0.5, color = "black", weight = 1) %>%
addCircleMarkers(data = estaciones2, lng = ~longitud, lat = ~latitud, label = ~name,
radius = 3, fillColor = "red", fillOpacity = 1, stroke = FALSE)mapa_seleccionsaveWidget(mapa_seleccion,"mapa_seleccion.html")Por último, seleccionamos las observaciones de data pertenecientes a las estaciones de los barrios seleccionamos y añadimos una nueva columna llamada zona, cuyo valor será “c” para estaciones del centro y “p” para estaciones de la periferia.
data_cent <- subset(data, nombre_barrio %in% centro)
data_per <- subset(data, nombre_barrio %in% periferia)
data_cent$zona <- rep("c", nrow(data_cent))
data_per$zona <- rep("p", nrow(data_per))
data2 <- rbind(data_cent, data_per)
paged_table(data2[1:5,])Modificación de variables
Para poder tener una variable que abarque la instancia temporal completamente, se han creado las variables datetime_char y datetime que combinan la variables fecha y hora_hora. La primera de estas variables es tipo texto y la segunda contiene objetos POSIXct.
data3 <- data2 %>%
mutate(datetime_char = paste(fecha, hora_hora))
data3 <- data3 %>%
mutate(datetime = as.POSIXct(datetime_char, format = "%d/%m/%Y %H:%M:%S"))Este último dataframe obtenido se llamará data3.
paged_table(data3[1:5,])Medias de la periferia y el centro
A continuación, obtendremos un dataframe en el que cada observación es una hora y se recoge la media de bornes libres y bicis disponibles tanto en la periferia como en el centro para cada hora.
est_centro <- unique(data3[data3$zona == "c",]$number_)
est_peri <- unique(data3[data3$zona == "p",]$number_)
c <- length(est_centro)
p <- length(est_peri)
df_bicis <- data3 %>%
select(number_, avg_av, datetime)
datetimes_bicis <- pivot_wider(df_bicis,
names_from = number_,
values_from = avg_av,
values_fill = NA)
colnames(datetimes_bicis)[1] <- "datetime"
datetimes_bicis <- datetimes_bicis %>%
mutate(periferia = rowMeans(select(.,(c+2):(c+1+p))))
datetimes_bicis <- datetimes_bicis %>%
mutate(centro = rowMeans(select(.,2:(c+1))))
datetimes_bicis <- select(datetimes_bicis, datetime, centro, periferia)
datetimes_bicis <- arrange(datetimes_bicis, datetime)
df_bornes <- data3 %>%
select(number_, avg_free, datetime)
datetimes_bornes <- pivot_wider(df_bornes,
names_from = number_,
values_from = avg_free,
values_fill = NA)
colnames(datetimes_bornes)[1] <- "datetime"
datetimes_bornes <- datetimes_bornes %>%
mutate(periferia = rowMeans(select(.,(c+2):(c+1+p))))
datetimes_bornes <- datetimes_bornes %>%
mutate(centro = rowMeans(select(.,2:(c+1))))
datetimes_bornes <- select(datetimes_bornes, datetime, centro, periferia)
datetimes_bornes <- arrange(datetimes_bornes, datetime)
datetimes <- cbind(datetimes_bicis, datetimes_bornes[,c("centro","periferia")])
colnames(datetimes) <- c("datetime","bicis_centro","bicis_periferia","bornes_centro","bornes_periferia")El formato del dataframe datetimes es el siguiente:
paged_table(datetimes[1:5,])Evolución a lo largo del tiempo
Evolución durante todo el tiempo
A partir de este dataframe, podemos visualizar la evolución de los valores del centro y de la periferia a lo largo del tiempo. De especial interés es la evolución que tienen a lo largo de un día.
limites_base <- c(min(datetimes$datetime), max(datetimes$datetime))
lineas <- function(data, limites) {
ggplot(data, aes(x = datetime)) +
geom_line(aes(y = bicis_centro, color = "Bicis centro")) +
geom_line(aes(y = bicis_periferia, color = "Bicis periferia")) +
geom_line(aes(y = bornes_centro, color = "Bornes centro")) +
geom_line(aes(y = bornes_periferia, color = "Bornes periferia")) +
labs(x = "Fecha", y = "Valor", color = "Variable") +
scale_color_manual(values = c("Bicis centro" = "red", "Bicis periferia" = "blue", "Bornes centro" = "red4", "Bornes periferia" = "blue4")) +
scale_x_datetime(limits = limites)
}lineas(datetimes, limites_base)
Se puede observar en el gráfico que en el centro hay muchos más bornes libres que bicicletas disponibles. En cambio, en la periferia los valores son muchos más parecidos y lo normal es que haya tanto bicicletas de sobra como espacios de sobra para aparcar.
Evolución de las muestras
Para hacer más comprobaciones, visualizaremos el mismo gráfico pero solo con las medias de muestras de 10 estaciones del centro y 10 estaciones de la periferia.
sample_est <- function(df, n) {
data_cent <- subset(df, zona == "c")
data_per <- subset(df, zona == "p")
selec_cent <- sample(unique(data_cent$number_), n)
selec_per <- sample(unique(data_per$number_), n)
selec <- c(selec_cent, selec_per)
res <- subset(df, number_ %in% selec)
return(res)
}sample1 <- sample_est(data3, 10)
sample2 <- sample_est(data3, 10)
sample3 <- sample_est(data3, 10)bicis <- function(df) {
df_bicis <- df %>%
select(number_, avg_av, datetime)
datetimes_bicis <- pivot_wider(df_bicis,
names_from = number_,
values_from = avg_av,
values_fill = NA)
colnames(datetimes_bicis)[1] <- "datetime"
datetimes_bicis <- datetimes_bicis %>% mutate(periferia = rowMeans(select(.,12:21)))
datetimes_bicis <- datetimes_bicis %>% mutate(centro = rowMeans(select(.,2:11)))
datetimes_bicis <- select(datetimes_bicis, datetime, centro, periferia)
datetimes_bicis <- arrange(datetimes_bicis, datetime)
return(datetimes_bicis)
}
bornes <- function(df) {
df_bornes <- df %>%
select(number_, avg_free, datetime)
datetimes_bornes <- pivot_wider(df_bornes,
names_from = number_,
values_from = avg_free,
values_fill = NA)
colnames(datetimes_bornes)[1] <- "datetime"
datetimes_bornes <- datetimes_bornes %>% mutate(periferia = rowMeans(select(.,12:21)))
datetimes_bornes <- datetimes_bornes %>% mutate(centro = rowMeans(select(.,2:11)))
datetimes_bornes <- select(datetimes_bornes, datetime, centro, periferia)
datetimes_bornes <- arrange(datetimes_bornes, datetime)
return(datetimes_bornes)
}datetimes_bicis1 <- bicis(sample1)
datetimes_bicis2 <- bicis(sample2)
datetimes_bicis3 <- bicis(sample3)
datetimes_bornes1 <- bornes(sample1)
datetimes_bornes2 <- bornes(sample2)
datetimes_bornes3 <- bornes(sample3)
datetimes1 <- cbind(datetimes_bicis1, datetimes_bornes1[,c("centro","periferia")])
colnames(datetimes1) <- c("datetime","bicis_centro","bicis_periferia","bornes_centro","bornes_periferia")
datetimes2 <- cbind(datetimes_bicis2, datetimes_bornes2[,c("centro","periferia")])
colnames(datetimes2) <- c("datetime","bicis_centro","bicis_periferia","bornes_centro","bornes_periferia")
datetimes3 <- cbind(datetimes_bicis3, datetimes_bornes3[,c("centro","periferia")])
colnames(datetimes3) <- c("datetime","bicis_centro","bicis_periferia","bornes_centro","bornes_periferia")lineas(datetimes1, limites_base)
lineas(datetimes2, limites_base)
lineas(datetimes3, limites_base)
Se puede observar que la evaluación tiene la tendencia que se había concluido.
Evolución en pares de días
A continuación, para poder visualizar mejor la evolución diaria. Filtramos los datos seleccionando solo las observaciones de 2 días. Seleccionamos los día 6 y 7 de febrero de 2023 (lunes y martes)
limites <- c(as.POSIXct("2023-2-6 00:00:00"), as.POSIXct("2023-2-8 00:00:00"))
lineas(datetimes, limites)
lineas(datetimes1, limites)
lineas(datetimes2, limites)
lineas(datetimes3, limites)
Podemos observar que la cantidad de bicis disponibles en el centro sube claramente en el mediodía y se mantiene baja por la mañana y por la noche. En cambio, las estaciones de la periferia tienen una evolución contraria y no tan acentuada.
Observaremos ahora si en el finde semana la tendencia es la misma. Para ello seleccionamos los días 4 y 5 de febrero del 2023 (sábado y domingo).
limites_finde <- c(as.POSIXct("2023-2-4 00:00:00"), as.POSIXct("2023-2-6 00:00:00"))
lineas(datetimes, limites_finde)
lineas(datetimes1, limites_finde)
lineas(datetimes2, limites_finde)
lineas(datetimes3, limites_finde)
Se observa que la tendencia en el finde semana es completamente contraria a los días laborales y las cantidad de bicis disponibles aumenta en el centro durante la noche. En la periferia, sin embargo, se mantienen bastante estables el número de bicis disponibles y de bornes libres durante todo el día.
Estos análisis se han realizado sobre otros pares de días laborales y fines semanas, llegando a las mismas conclusiones. En resumen, durante los días laborales, la cantidad de bicis aumenta durante el mediodía en el centro y se reduce en la periferia. Por otro lado, durante los fines de semana, la cantidad de bicis es máxima en el centro por la noche.
Separación por tramos horarios
A partir de aquí, nos planteamos si la cantidad de bicis en centro y la periferia está relacionada con el tramo horario. Por tanto consideraremos los siguientes tramos horarios:
- Madrugada: Hasta las 06:00h.
- Mañana: De 06:00h a 09:00h.
- Media mañana: De 09:00h a 11:00h.
- Mediodía: De 11:00h a 16:00h.
- Tarde: De 16:00h a 20:00h.
- Noche: A partir de las 20:00h.
puntos_corte <- as.POSIXct(c("00:00:00","06:00:00","09:00:00","11:00:00","16:00:00","20:00:00","23:59:59"), format = "%H:%M:%S")
nombres_tramos <- c("Madrugada","Mañana","Media mañana","Mediodía","Tarde","Noche")Cone esto, creamos un nuevo dataframe llamado tramos que guardará la media de cantidad de bicis disponibles de todos los días de cada estación, por día de la semana y tramo horario. Además se incluirá el tamaño de la estación, la zona (centro o periferia) y las coordenadas. Estas tres últimas variables tendrán obviamente el mismo valor para todas las observaciones de la misma estación.
data4 <- data3 %>%
select(name, hora_hora, avg_av, avg_total, zona, día_semana, geometry_punto)
colnames(data4) <- c("id", "hora", "bicis", "total", "zona", "dia_semana", "coordenadas")
data4$hora <- as.POSIXct(data4$hora, format = "%H:%M:%S")
tramos <- data4 %>%
group_by(id, dia_semana, tramo = cut(hora, breaks = puntos_corte, labels = FALSE)) %>%
summarise(bicis = mean(bicis), total = first(total), zona = first(zona), coordenadas = first(coordenadas)) %>%
mutate(tramo = nombres_tramos[tramo])## `summarise()` has grouped output by 'id', 'dia_semana'. You can override using
## the `.groups` argument.paged_table(tramos[1:15,])Evolución diaria de las muestras
Con las muestras de 20 estaciones en el formato del dataframe ``tramos’’, se han creado animaciones de diagramas de barras que distinguen el tramo horario y evolucionan día a día.
tramos_f <- function(df) {
puntos_corte <- as.POSIXct(c("00:00:00","06:00:00","09:00:00","11:00:00","16:00:00","20:00:00","23:59:59"), format = "%H:%M:%S")
nombres_tramos <- c("Madrugada","Mañana","Media mañana","Mediodía","Tarde","Noche")
df2 <- df %>%
select(number_, fecha, hora_hora, avg_av, avg_total, zona)
colnames(df2) <- c("id", "fecha", "hora", "bicis", "total", "zona")
df2$hora <- as.POSIXct(df2$hora, format = "%H:%M:%S")
tramos <- df2 %>%
group_by(id, fecha, tramo = cut(hora, breaks = puntos_corte, labels = FALSE)) %>%
summarise(bicis = mean(bicis), total = first(total), zona = first(zona)) %>%
ungroup() %>%
mutate(tramo = nombres_tramos[tramo])
}tramos1 <- tramos_f(sample1)## `summarise()` has grouped output by 'id', 'fecha'. You can override using the
## `.groups` argument.tramos2 <- tramos_f(sample2)## `summarise()` has grouped output by 'id', 'fecha'. You can override using the
## `.groups` argument.tramos3 <- tramos_f(sample3)## `summarise()` has grouped output by 'id', 'fecha'. You can override using the
## `.groups` argument.diag_barras <- function(tramos1) {
tramos1$fecha <- as.Date(tramos1$fecha, format = "%d/%m/%Y")
colores <- c("c" = "blue", "p" = "red")
valores_totales <- aggregate(total ~ id, tramos1, mean)
fechas_animacion <- seq(min(tramos1$fecha), max(tramos1$fecha), by = "day")
orden_tramos <- c("Madrugada", "Mañana", "Media mañana", "Mediodía", "Tarde", "Noche")
tramos1$tramo <- factor(tramos1$tramo, levels = orden_tramos)
barras_b <- ggplot(tramos1, aes(x = tramo, y = bicis, fill = zona)) +
geom_bar(stat = "identity", position = "stack") +
geom_hline(data = valores_totales, aes(yintercept = total), color = "black", linetype = "dashed", size = 1) +
facet_wrap(~ id) +
scale_fill_manual(values = colores) +
transition_states(fecha, transition_length = 2, state_length = 1) +
ease_aes('linear') +
theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
labs(title = "Fecha: {closest_state}")
ani_barras <- animate(barras_b, fps = 2, nframes = length(fechas_animacion))
return(ani_barras)
}ani_barras1 <- diag_barras(tramos1)
ani_barras2 <- diag_barras(tramos2)
ani_barras3 <- diag_barras(tramos3)
save_animation(ani_barras1, "diagramas_barras1.gif")
save_animation(ani_barras2, "diagramas_barras2.gif")
save_animation(ani_barras3, "diagramas_barras3.gif")ani_barras1
ani_barras2
ani_barras3
En estas animaciones se da algún indicio de las evoluciones vistas en los diagramas de líneas, pero no deja claro que esta evolución sea así. Por otra parte, se ve claramente que las estaciones de la periferia suelen estar más llenas que las del centro, con más bicis disponibles y menos bornes libres.
Mapa evolución por día de la semana y tramo horario
Por último, se desarrolla un mapa de las estaciones a partir del dataframe ``tramos’’. En este mapa cada estación tendrá 42 anillos alrededor suyo del radio de las bicis disponibles en cada momento, uno por cada tramo horario cada día de la semana. Estos anillos tendrán un color según el tramo horario al que pertenezcan. Además, se añadirá un anillo negro con el tamaño de la estación.
tramos$latitud <- st_coordinates(tramos$coordenadas)[, "Y"]
tramos$longitud <- st_coordinates(tramos$coordenadas)[, "X"]
tramos$tramo <- factor(tramos$tramo, levels = nombres_tramos)
tramos$bicis10 <- tramos$bicis * 2
tramos$total10 <- tramos$total * 2
tramos <- tramos %>%
mutate(lab = paste(tramo, dia_semana))colores_tramos <- colorFactor(c("red", "yellow", "blue", "green", "brown", "violet"), domain = tramos$tramo)
anillos <- leaflet() %>%
addTiles() %>%
addCircleMarkers(data = tramos, lng = ~longitud, lat = ~latitud, label = ~lab, radius = ~bicis10, color = ~colores_tramos(tramo), fillOpacity = 0, weight = 1, fill = FALSE) %>%
addCircleMarkers(data = tramos, lng = ~longitud, lat = ~latitud, label = ~id, radius = ~total10, color = "black", fillOpacity = 0, weight = 2, fill = FALSE)
anillos <- anillos %>%
addLegend(
"bottomright",
colors = c("red", "yellow", "blue", "green", "brown", "violet", "black"),
labels = c(nombres_tramos, "Tamaño estación"),
title = "Tramos"
)
anillos