JUNTAR DATASET MOVIMIENTOS Y PRIMER EDA
Grupo 2
1 Introducción
El presente RMarkdown contiene el código para juntar los datos de movimientos de BiciMAD por mes proporcionados por la web web OpenData de la EMT. Todos los datos se proporcionan en formato json.
Link: https://opendata.emtmadrid.es/Datos-estaticos/Datos-generales-(1)
Hemos extraido los datos de movimientos de todo el año 2019 y los de 2020 hasta junio que son los que había publicados a fecha 5 de septiembre 2020.
2 Unión de todos meses
Tras importar las librerias necesarias y establecer el directorio de trabajo, pasamos a añadir los datos de movimientos por meses desde enero de 2019 a junio de 2020, ambos incluidos.
# Librerías utilizadas
library(ndjson)
library(rjson)
library(ggplot2)
library(lubridate)
library(data.table)
library(stringr)
library(Hmisc)
library(tidyverse)
library(hrbrthemes)A la hora de importar los datos nos encontramos con algunas peculiariades:
- Los movimientos anteriores a julio de 2019 tenían otro formato, por lo que en otro proceso hemos extraído las mismas columnas y guardado en csv para su importación.
- Los distintos dataset no presentan el mismo orden en las variables por lo que lo solucionamos. Además, los datos hasta julio de 2019 presentaban una variable con distinto nombre.
# Directorio de trabajo
setwd("C:/Users/isabe/OneDrive/Escritorio/M/0_TFM/Juntar datos/DATOS")
# Lectura por meses
enero19 <- as.data.frame(fread(file="201901_movements.csv"))
febrero19 <- as.data.frame(fread(file="201902_movements.csv"))
marzo19 <- as.data.frame(fread(file="201903_movements.csv"))
abril19 <- as.data.frame(fread(file="201904_movements.csv"))
mayo19 <- as.data.frame(fread(file="201905_movements.csv"))
junio19 <- as.data.frame(fread(file="201906_movements.csv"))
julio19 <- as.data.frame(ndjson::stream_in("201907_movements.json"))
agosto19 <- as.data.frame(ndjson::stream_in("201908_movements.json"))
septiembre19 <- as.data.frame(ndjson::stream_in("201909_movements.json"))
octubre19 <- as.data.frame(ndjson::stream_in("201910_movements.json"))
noviembre19 <- as.data.frame(ndjson::stream_in("201911_movements.json"))
diciembre19 <- as.data.frame(ndjson::stream_in("201912_movements.json"))
enero20 <- as.data.frame(ndjson::stream_in("202001_movements.json"))
febrero20 <- as.data.frame(ndjson::stream_in("202002_movements.json"))
marzo20 <- as.data.frame(ndjson::stream_in("202003_movements.json"))
abril20 <- as.data.frame(ndjson::stream_in("202004_movements.json"))
mayo20 <- as.data.frame(ndjson::stream_in("202005_movements.json"))
junio20 <- as.data.frame(ndjson::stream_in("202006_movements.json"))# Dos listas de orden ya que hay una variable que tiene distinto nombre
orden1 <- c("_id.$oid","user_day_code","user_type","ageRange", "idplug_base","idunplug_base","idplug_station","idunplug_station",
"unplug_hourTime.$date","travel_time","zip_code")
orden2 <- c("_id.$oid","user_day_code","user_type","ageRange", "idplug_base","idunplug_base","idplug_station","idunplug_station",
"unplug_hourTime","travel_time","zip_code")
enero19 <- enero19[,orden1]
febrero19 <- febrero19[,orden1]
marzo19 <- marzo19[,orden1]
abril19 <- abril19[,orden1]
mayo19 <- mayo19[,orden1]
junio19 <- junio19[,orden1]
julio19 <- julio19[,orden2]
agosto19 <- agosto19[,orden2]
septiembre19 <- septiembre19[,orden2]
octubre19 <- octubre19[,orden2]
noviembre19 <- noviembre19[,orden2]
diciembre19 <- diciembre19[,orden2]
enero20 <- enero20[,orden2]
febrero20 <- febrero20[,orden2]
marzo20 <- marzo20[,orden2]
abril20 <- abril20[,orden2]
mayo20 <- mayo20[,orden2]
junio20 <- junio20[,orden2]
# Corregimos el nombre de esa variable distinta
todo <- rbind(enero19, febrero19, marzo19, abril19, mayo19, junio19)
colnames(todo)[9] <- "unplug_hourTime"Además, esta variable cuenta con una letra Z al final por lo que también la igualamos:
f <- str_sub(todo$unplug_hourTime,1,19)
f2 <- paste(f,"Z")
f3 <- str_replace_all(f2," ","")
# Se sustituye la antigua variable por la nueva
todo$unplug_hourTime <- f3Unión de todos los meses:
3 EDA
A continuación, exploramos las variables de este dataset creado con los datos de movimientos de BiciMAD desde enero de 2019 a febrero de 2020.
## 'data.frame': 5063509 obs. of 11 variables:
## $ _id.$oid : chr "5c4b07ea2f38432e007daab8" "5c4b07ea2f38432e007daaba" "5c4b07ea2f38432e007daabb" "5c4b07ea2f38432e007daabe" ...
## $ user_day_code : chr "b3b5b61509ab89afbf4d1e589d229bebe6637c2de819f5d612762c939b8d7f1f" "a18550d468153bb8e1808d4f0a85955579951832772996de08a154d7b4b11ee0" "905737396c2fe343c84d62eaee3ab66e19632638c5bea772b1e82a9d68f6a8b0" "ed1c1a22c120e7d42cc522c33ab41db549791f3914b273a1f3926d62f6b9203a" ...
## $ user_type : num 1 1 1 1 1 1 1 1 1 1 ...
## $ ageRange : num 0 5 0 4 0 0 5 4 0 4 ...
## $ idplug_base : num 14 10 5 4 17 3 17 13 20 1 ...
## $ idunplug_base : num 23 1 3 12 4 2 11 2 2 23 ...
## $ idplug_station : num 83 36 90 44 125 11 171 65 110 91 ...
## $ idunplug_station: num 82 133 25 51 44 17 100 67 65 77 ...
## $ unplug_hourTime : chr "2019-01-01T00:00:00Z" "2019-01-01T00:00:00Z" "2019-01-01T00:00:00Z" "2019-01-01T00:00:00Z" ...
## $ travel_time : num 162 415 545 448 639 362 468 149 337 514 ...
## $ zip_code : chr "" "28005" "" "28005" ...Tenemos 5.063.509 observaciones en 11 variables de las cuales: - 7 son numéricas - 4 son de caracteres
La descripción de todas variables se describe en el modelo de BiciMAD “Servicios-y-estructuras-Bicimad” propocionado por la web OpenData de la EMT. La descripción de las variables con las que nos hemos quedado nosotros sería la siguiente:
id.$oid: identificador del movimiento
user_day_code: código del usuario para una misma fecha
user_type: tipo de usuario que utiliza BiciMAD, existen cuatro tipos:
- 0, no se ha podido determinar
- 1, correspende a usuarios con bono anual
- 2, usuarios temporales
- 3, personal de mantenimiento de BiciMAD
ageRange: rango de edad de los usuarios de BiciMAD, se clasifica en:
- 0, no se ha podido determinar
- 1, de 0 a 16 años. Tenemos que destacar que según la normativa de BiciMAD, los usuarios menores de 14 años no pueden utilizar el servicio
- 2, 17 y 18 años
- 3, entre 18 y 26 años
- 4, entre 27 y 40 años
- 5, entre 41 y 65 años
- 6, 66 años o más
idplug_base: anclaje dentro de la estación de destino
idunplug_base: anclaje dentro de la estación de origen
idplug_station: estación donde se engancha, es decir, Destino
idunplug_station: estación donde se desengancha, es decir, Origen
unplug_hourTime: franja horaria en la que se inicia el viaje (se desengancha la bicicleta)
travel_time: tiempo que dura el viaje
zip_code: código postal del usuario
Pasamos a entender las variables una a una:
3.1 _id.$oid y user_day_code
Estas dos variables son identificadores de los movimientos, aportarán poco al modelo predictivo pero serán útiles para otras cosas.
3.2 user_type
Tenemos 4 tipos de usuarios:
Tipo 0 que está practicamente vacío y directamente eliminamos
Los mayoritarios son los de tipo 1, es decir, los que cuentan con un bono anual.
Los usuarios tipo 2 o temporales son los más escasos. En esta categoría, según la política de BiciMAD, tenemos usuarios que compran un bono de hasta 5 días pero no se hace distinción. Podría ser interesante realizar campañas de marketing para potenciar estos usuarios, sobre todo en epocas de mayor turismo.
Los usuarios tipo 3 son personal de mantenimiento de BiciMAD. Para nuestra modelo predictivo optaremos por eliminar los usuarios tipo 3 ya que no son viajes propiamente dichos.
3.3 ageRange
Observamos que la categórias mayoritaria es la 0, es decir, la que no se ha podido determinar.
Para solucionar esto, imputamos esta categoría por aleatorio y tras ello vemos de nuevo el gráfico.
Las categorías más populares son la 4 y la 5. La 4 corresponde a edades entre los 27 y los 40 y la 5 a los 41-65, es decir, en general observamos que los usuarios de BiciMAD son adultos con capacidad económica independiente. Además es un poco más popular la categoría 4 y es razonable, en ese rango de edad se es más joven y ágil, y probablemente sin cargas familiares (recordamos que no pueden usar BiciMAD menores de 14 años).
# Imputar
movimientos$ageRange <- replace(movimientos$ageRange, which(movimientos$ageRange == 0), NA)
movimientos$ageRange <- impute(movimientos$ageRange,"random")
# Visualizar
ggplot(data=movimientos, aes(x=ageRange)) + geom_bar(fill="#69b3a2", color="#e9ecef")
3.4 idplug_base y idunplug_base
Observamos que tanto en la estación de origen como en la destino existen un número máximo de 30 anclajes o bicis. Estas variables nos dicen poco más pues no es relevante en que número de anclaje está la bici, solo para ver si unas estaciones son más grandes que otras.
3.5 idplug_station y idunplug_station
Estas variables nos dicen el número de estaciones de destino y de origen. Observamos que el valor 2008 es un outlier o seguramente un error de codificación.
# boxplot de la variable original. Creamos lista para poder mostrarlos en el mismo gráfico
lista <- list(movimientos$idplug_station, movimientos$idunplug_station)
names(lista) <- c('idplug_station', 'idunplug_station')
boxplot(lista , col="#69b3a2")
Los pasamos a NA e imputamos por aleatorio.
movimientos$idplug_station <- replace(movimientos$idplug_station, which(movimientos$idplug_station == 2008), NA)
movimientos$idunplug_station <- replace(movimientos$idunplug_station, which(movimientos$idunplug_station == 2008), NA)
movimientos$idunplug_station <- impute(movimientos$idunplug_station,"random")
movimientos$idplug_station <- impute(movimientos$idplug_station,"random")Después de esto, vemos que tenemos 219 estaciones y que algunas son más populares que otras. A posteriori realizaremos un análisis de las rutas más frecuentes.
## Don't know how to automatically pick scale for object of type impute. Defaulting to continuous.
## Don't know how to automatically pick scale for object of type impute. Defaulting to continuous.
3.6 unplug_hourTime [feature engineering]
Esta variable tenemos que modificarla para poder trabajar con ella. Primero la pasamos a formato fecha con la libreria lubridate y con ella creamos variables de año, mes, día y día de la semana que parece más interesante, y hora. Además, con la distribución de meses creamos una variable de estación del año.
# Nuevas variables de fecha
movimientos$fe_year <- year(movimientos$unplug_hourTime)
movimientos$fe_month <- month(movimientos$unplug_hourTime)
movimientos$fe_day <- day(movimientos$unplug_hourTime)
movimientos$fe_wday <- wday(movimientos$unplug_hourTime)
movimientos$fe_hour <- hour(movimientos$unplug_hourTime)
movimientos$fe_season <- cut(movimientos$fe_month, breaks = c(0, 4, 7, 10, 13), labels = c("Invierno", "Primavera", "Verano", "Otoño"))Sabemos que tenemos más datos en 2019 ya que solo estamos considerando la mitad del año 2020, por lo que vamos a ver los gráficos unicamente para el año 2019 y así ver el comportamiento de los usuarios de Bicimad en un año natural completo.Esto son estudios a priori que se desarrollaran a lo largo del trabajo.
# Nos quedamos solo con 2019 para este análisis
movimientos_2019 <- subset(movimientos, movimientos$fe_year == 2019)Por meses es destacable los bajos niveles de julio, probablemente por el calor. Enero y diciembre por el frio y abril por la lluvias.
# Visualización por meses
ggplot(data=movimientos_2019, aes(x=fe_month)) + geom_bar(fill="#69b3a2", color="#e9ecef")
En estaciones del año, la menos popular el otoño, probablemente también por motivos de clima (viento y lluvia)
# Visualización por estación del año
ggplot(data=movimientos_2019, aes(x=fe_season)) + geom_bar(fill="#69b3a2", color="#e9ecef")
Por días no es relevante y por día de la semana vemos que se usa menos en lunes y domingo. Esto nos sorprende bastante, la razón que encontramos es que los domingos es día de descanso/familiar y los lunes día de adaptación a la semana.
# Visualización por día del mes
ggplot(data=movimientos_2019, aes(x=fe_day)) + geom_bar(fill="#69b3a2", color="#e9ecef")
# Visualización por día de la semana
ggplot(data=movimientos_2019, aes(x=fe_wday)) + geom_bar(fill="#69b3a2", color="#e9ecef")
Por horas vemos un pico a las 8 de la mañana, usuarios que probablemente la utilicen para ir a trabajar y de ahí el nuevo pico a las 18h, cuando salen.
# Visualización por horas
ggplot(data=movimientos_2019, aes(x=fe_hour)) + geom_bar(fill="#69b3a2", color="#e9ecef")
3.7 travel_time
Vemos que el tiempo mínimo de viaje es negativo por lo que todos los valores negativos vamos a pasarlos a NA e imputarlos.
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -969693 461 700 1490 1071 192728893.8 zip_code
En el código postal del usuarios vemos que hay algunos códigos vacios que pasaremos todos ellos a NA e imputamos por aleatorio.
#unique(movimientos$zip_code) #como tengamos que ir uno a uno con los unique nos eternizamos no se podría hacer un distinto a 5 caracteres??
movimientos$zip_code <- replace(movimientos$zip_code, which(movimientos$zip_code == "" ), NA)
# imputar
movimientos$zip_code <- impute(movimientos$zip_code, "random")4 Guardar datos
Guardamos estos datos para utilizarlos en nuestros posteriores análisis.
## 'data.frame': 5062186 obs. of 17 variables:
## $ _id.$oid : chr "5c4b07ea2f38432e007daab8" "5c4b07ea2f38432e007daaba" "5c4b07ea2f38432e007daabb" "5c4b07ea2f38432e007daabe" ...
## $ user_day_code : chr "b3b5b61509ab89afbf4d1e589d229bebe6637c2de819f5d612762c939b8d7f1f" "a18550d468153bb8e1808d4f0a85955579951832772996de08a154d7b4b11ee0" "905737396c2fe343c84d62eaee3ab66e19632638c5bea772b1e82a9d68f6a8b0" "ed1c1a22c120e7d42cc522c33ab41db549791f3914b273a1f3926d62f6b9203a" ...
## $ user_type : num 1 1 1 1 1 1 1 1 1 1 ...
## $ ageRange : 'impute' num 5 5 5 4 1 5 5 4 3 4 ...
## ..- attr(*, "imputed")= int 1 3 5 6 9 11 14 15 17 18 ...
## $ idplug_base : num 14 10 5 4 17 3 17 13 20 1 ...
## $ idunplug_base : num 23 1 3 12 4 2 11 2 2 23 ...
## $ idplug_station : 'impute' num 83 36 90 44 125 11 171 65 110 91 ...
## ..- attr(*, "imputed")= int 153390 788637 788638 1024840 1024841 1024842 1326444 1340981 1340982 1581648 ...
## $ idunplug_station: 'impute' num 82 133 25 51 44 17 100 67 65 77 ...
## ..- attr(*, "imputed")= int 153390 788637 788638 1024840 1024841 1024842 1326444 1340981 1340982 1581648 ...
## $ unplug_hourTime : POSIXct, format: "2019-01-01 00:00:00" "2019-01-01 00:00:00" ...
## $ travel_time : 'impute' num 162 415 545 448 639 362 468 149 337 514 ...
## ..- attr(*, "imputed")= int 2164390 3193202 3193203 3193204 3193205 3193206 3193207 3193208 3193209 3193210 ...
## $ zip_code : 'impute' chr "28003" "28005" "28004" "28005" ...
## ..- attr(*, "imputed")= int 1 3 5 6 9 11 14 15 17 18 ...
## $ fe_year : int 2019 2019 2019 2019 2019 2019 2019 2019 2019 2019 ...
## $ fe_month : int 1 1 1 1 1 1 1 1 1 1 ...
## $ fe_day : int 1 1 1 1 1 1 1 1 1 1 ...
## $ fe_wday : int 3 3 3 3 3 3 3 3 3 3 ...
## $ fe_hour : int 0 0 0 0 0 0 0 0 0 0 ...
## $ fe_season : Factor w/ 4 levels "Invierno","Primavera",..: 1 1 1 1 1 1 1 1 1 1 ...