Introducción

El objetivo de este análisis es analizar el uso del servicio por parte de los usuarios generales, es decir, aquellos con user_type distinto a 3, ya que estos son los usuarios de mantenimiento.

Carga de los datasets

Cargo los datasets que voy a necesitar para el análisis. Por una parte el de movimientos y por otra el de las estaciones.

# cargo el dataset de movimientos
movimientos <- fread("C:/Users/rodsp/Desktop/movimientos2019-jun2020.csv") 

# del total de movimientos filtro aquellos movimientos de los usuarios de mantenimiento
movs_usu <- movimientos%>%filter(user_type!=3)

# cargo los dataset de estaciones en los que ya he tratado previamente el fichero de estaciones para quedarme sólo con los datos de longitud, latitud, dirección e id_station.
est_orig <- readRDS("C:/Users/rodsp/Desktop/est_orig")
est_dest <- readRDS("C:/Users/rodsp/Desktop/est_dest")

Análisis de las variables descriptivas de los usuarios.

Hacemos a continuación un análisis de las variables ageRange, user_type y user_day_code.

Análisis por edad (ageRange)

# Análisis descriptivo
movs_usu2 <- movs_usu[,c("ageRange","user_type")]
movs_usu2$ageRange <- as.factor(movs_usu2$ageRange)
movs_usu2$user_type <- as.factor(movs_usu2$user_type)
tot <- movs_usu2 %>% group_by(ageRange) %>% count ()
tot$n <- tot$n*100/nrow(movs_usu)
tot

## # A tibble: 6 x 2
## # Groups:   ageRange [6]
##   ageRange      n
##   <fct>     <dbl>
## 1 1         0.946
## 2 2         0.843
## 3 3         9.18 
## 4 4        50.5  
## 5 5        37.5  
## 6 6         1.04

Se observa que el mayor porcentaje de los movimientos se han realizado por usuarios con edades comprendidas entre 27 y 65 años.

Análisis por tipo de usuario (user_type)

tot2 <- movs_usu2 %>% group_by(user_type) %>% count ()
tot2$n <- tot2$n*100/nrow(movs_usu)
tot2

## # A tibble: 2 x 2
## # Groups:   user_type [2]
##   user_type     n
##   <fct>     <dbl>
## 1 1         98.9 
## 2 2          1.14

Se observa que la mayoría de los usuarios se han realizado por usuarios con abono anual, por tanto Bicimad no sea un medio de transporte muy demandado por los turistas.

Análisis codigo único de usuarios (user_day_code)

# agrupamos los movimientos por user_day_code, ya que este código es único por usuario y día.
freq_usu <- movs_usu %>% group_by(user_day_code) %>% count()
freq_usu$user_day_code <- 1
freq_usu <- freq_usu %>% group_by(n) %>% count()
#multiplicamos para saber el volumen total de movimientos para cada frecuencia y calculo el % sobre el total de movimientos.
freq_usu$nnn <- freq_usu$nn*freq_usu$n
freq_usu$nnnn <- round(freq_usu$nnn*100/nrow(movs_usu))
colnames(freq_usu)<- c("movs_dia","usuarios","totalmovs", "% movs")
freq_usu[1:10,]

## # A tibble: 10 x 4
##    movs_dia usuarios totalmovs `% movs`
##       <int>    <int>     <int>    <dbl>
##  1        1  1501957   1501957       32
##  2        2   901584   1803168       38
##  3        3   215226    645678       14
##  4        4   110547    442188        9
##  5        5    25660    128300        3
##  6        6    13697     82182        2
##  7        7     4233     29631        1
##  8        8     3995     31960        1
##  9        9     1271     11439        0
## 10       10     1205     12050        0

Se observa que la mayoría de los movimientos se realizan por usuarios que utilizan el servicio entre 1 y 2 veces/día, y que más de 4 veces/días es casi residual.

Nuevas variables dataset de movimientos.

Unimos los ficheros de movimientos y estaciones, para tener las variables de geolocalización a nivel de los movimientos.

# cruzamos el fichero de movimientos con los dos de estaciones para tener esta información en un mismo dataset.
movs_est <- merge(movs_usu,est_orig,id="idunplug_station")
movs_est <- merge(movs_est,est_dest,id="idplug_station")

A continuación, calculamos el número de días que ha estado disponible cada estación, ya que de cara a ver las estaciones con mayor demanda es importante tener esta información, ya que como hemos visto Bicimad ha estado en continuo crecimiento desde los inicios.

# vemos cuantos días ha estado en uso cada una de las estaciones
# para ello por una parte agrupamos por mes, día y estación.
estO_numdias <- movs_est %>% group_by(idunplug_station,fe_year,fe_month,fe_day) %>% count()
# nos quedamos con los campos ("idunplug_station","fe_year","fe_month","fe_day") 

estO_numdias <- estO_numdias[,c("idunplug_station","fe_year","fe_month","fe_day")]
# y agrupamos por idunplug_station para ver el número de días 
estO_numdias <- estO_numdias %>% group_by(idunplug_station) %>% count()
colnames(estO_numdias)  <- c("idunplug_station", "fe_diasdispO")

#cómo para el calculo de días disponibles, el si la estación es de origen o destino no aplica, creo un dataset similar para las estaciones destino con el objetivo de poder cruzar más adelante estos dataframe con el de movimientos tanto por estación origen como destino. 
estD_numdias <- estO_numdias 
colnames(estD_numdias)  <- c("idplug_station", "fe_diasdispD")

# Cruzo el fichero de movimientos con los de días disponibles.

# movs hasta feb.2020
movs_est <- merge(movs_est,estO_numdias,id="idunplug_station")
movs_est <- merge(movs_est,estD_numdias,id="idplug_station")

Para análisis posteriores, separo en dos dataset los movimientos para tener de forma independiente los movimientos hasta febrero.2020 y desde marzo 2020 y de esta forma poder ver el impacto de la covid-19 a través de los movimientos.

movs_a2019 <- movs_est %>% filter(fe_year==2019)
movs_a2020 <- movs_est %>% filter((fe_year==2020)&(fe_month<3))

movs_nocovid <- rbind(movs_a2019,movs_a2020)
movs_covid <- movs_est %>% filter((fe_year==2020)&(fe_month>=3))

Análisis horario de la demanda por día de la semana

A continuación analizamos la distribución horaria de los movimientos por día de la semana. Los volumenes corresponden a la media diaria de movimientos.

Análisis de los movimientos hasta febrero.2020

# agrupamos los movimientos por hora y día de la semana 
movs_tot <- movs_nocovid %>% group_by(fe_hour, fe_wday)%>% count() %>% arrange (-n)

# divido los movimientos por el total de semanas, para sacar la media
movs_tot$n <- movs_tot$n/56

colnames(movs_tot) <- c("hora","dia_semana","num_movs")

movs_tot$hora <- as.factor(movs_tot$hora)
movs_tot$dia_semana <- as.factor(movs_tot$dia_semana)

ggplot(movs_tot, aes(x=hora, y=num_movs, group = dia_semana, colour =dia_semana)) + 
  geom_line()  + 
  geom_point( size=2, shape=21, fill="white") + 
  theme_minimal()+
  labs(title = "Distribución de la demanda por día de la semana y hora")

Cómo se puede ver, se observan picos de demanda a las 8:00 y a las 18:00 para los días de lunes a jueves, lo que coincide con las jornadas laborales. Los viernes reflejan una distribución mixta entre un día de semana y un fin de semana. Para los fines de semana, se observa que hay mayores movimientos en la madrugada, si bien en general la demanda del servicio disminuye bastante.

Análisis de los movimientos desde marzo.2020

Hacemos lo mismo pero para el dataset de movs_nocovid.

Para estos movimientos, se observa una disminución en la demanda del servicio debido al estado de alarma y al confinamiento. La diferencia de la demanda entre los fines de semana y los días de diario ya no es tan marcada. A las 18:00 se sigue registrando un pico en la demanda del servicio.

Análisis de las estaciones con mayor demanda.

A continuación hacemos un análisis de la demanada a nivel de estación de origen y destino, para el total de los movimientos.

En estos gráficos se mostrarán:

En azul: estaciones de anclaje/desanclaje de más de 120 movimientos/día
En verde: estaciones de anclaje/desanclaje entre 90 y 120 movimientos/día
En amarillo: estaciones de anclaje/desanclaje entre 45 y 90 movimientos/día
En rojo: estaciones de anclaje/desanclaje de menos de 45 movimientos/día

Análisis por estación de desanclaje

movs_orig <- movs_est %>% group_by(idunplug_station,fe_diasdispO,lat_orig,long_orig)%>% count() %>% arrange (-n)
movs_orig$num_dia <- round(movs_orig$n/movs_orig$fe_diasdispO)

myMap_orig <- NULL
df_orig <- movs_orig %>% filter(fe_diasdispO>0)
# añado las columnas nuevas inicializadas
df_orig$colour <- "white"
df_orig$radius <- 10
df_orig$weight <- 1

i = 1
while (i <= nrow(df_orig)){
  num <- df_orig$num_dia[i]
  if (num >=120){
    df_orig$colour[i]  <- "blue"
    df_orig$radius[i]  <- 10
    df_orig$weight[i]  <- 2
  }
  if ((num<120)&(num>=90)){ 
    df_orig$colour[i]  <-  "green" 
    df_orig$radius[i]  <- 5
    df_orig$weight[i]  <- 2
  }
  if ((num<90)&(num>=45)){
    df_orig$colour[i] <-  "yellow" 
    df_orig$radius[i] <- 3
    df_orig$weight[i] <- 2
  }
  if ((num<45)&(num>=0)){
    df_orig$colour[i] <- "red"
    df_orig$radius[i] <- 1
    df_orig$weight[i] <- 2
  }
  i = i+1
}

colnames(df_orig) <- c("idunplug_station","fe_diasdisp","latitude","longitude","n","num_dia", "colour","radius","weight")

myMap_orig = leaflet(df_orig) %>%
  setView(lng = -3.69, lat = 40.41, zoom = 12) %>%
  addTiles()

myMap_orig %>% addCircleMarkers(radius = ~radius, color = ~colour, fill = ~colour ,popup= ~paste0("Origen de ", num_dia, " movimientos/dia")) %>%
  addLegend("bottomright", colors = c("blue", "green", "yellow", "red"), labels = c("estaciones > 120 movs/dia", "estaciones entre 90 y 120 movs/dia", "estaciones entre 45 y 90 movs/dia", "estaciones < 45 movs/dia"))

Análisis por estación de anclaje.

Análisis de las rutas con mayor demanda

En este apartado, el objetivo es que desplazamientos se realizan.

Análisis de los movimientos hasta febrero.2020

Análizamos las veces que se hacen de forma media mensual las rutas.

# sacamos el número de veces que se ha hecho cada ruta, es decir, cada combinación de id_unplugstation&idplug_station
rutas_nocovid <- movs_nocovid %>% group_by(idunplug_station, idplug_station,lat_orig,long_orig,lat_dest,long_dest,dir_dest,dir_orig)%>% count() %>% arrange (-n)
# hacemos el calculo mensual
rutas_nocovid$n <- round(rutas_nocovid$n/14)

De todas las rutas, vamos a analizar las rutas que se hacen más de 50 veces al mes. A continuación lo que hacemos es ver el número de movimientos por ruta única, es decir, sin tener en cuenta si es origen-destino o destino-origen la combinación de las estaciones.

# Hacemos filtro de las rutas que se hacen más de 50 veces la mes. 
rutasNC <- rutas_nocovid %>% filter(n>50)

# lo movemos a un nuevo dataset para ver cuales son las rutas repetidas pero en sentido contrario
rutasNC2 <- rutasNC

# añadimos una nueva columna para poder ver si la ruta es o no repetida.
rutasNC2$rep <- 0 

# hacemos un bucle para ver que rutas son la misma pero en sentido contrario
i=1
while (i <= nrow(rutasNC2) ){
  if (rutasNC2$rep[i]==0){
     a <- rutasNC2$idunplug_station[i]
     b <- rutasNC2$idplug_station[i]
    j = 1
    while (j<= nrow(rutasNC2)){
        if (a==b){break}
        else {if((rutasNC2$idplug_station[j]==a)&(rutasNC2$idunplug_station[j]==b)){
            rutasNC2$n[i] <- rutasNC2$n[i]+rutasNC2$n[j]
            rutasNC2$rep[j] <- 1
            break
        }}
    j = j+1
    }
  }
  i = i +1
}

A continuación vemos cuales son las rutas más populares.

## # A tibble: 206 x 5
##    idunplug_station idplug_station     n dir_orig            dir_dest           
##               <int>          <int> <dbl> <chr>               <chr>              
##  1                9            149   360 Plaza de Alonso Ma~ Calle Santa Engrac~
##  2              130            149   252 Calle Santa Engrac~ Calle Santa Engrac~
##  3              135            175   243 Paseo de la Choper~ Calle Segovia      
##  4               78             64   236 Avenida de Menende~ Plaza de la Indepe~
##  5               27            175   227 Calle Carlos III  ~ Calle Segovia      
##  6              175              1   223 Calle Segovia       Puerta del Sol  nu~
##  7              132            175   220 Paseo de la Florid~ Calle Segovia      
##  8              132            135   215 Paseo de la Florid~ Paseo de la Choper~
##  9              135             49   211 Paseo de la Choper~ Glorieta de la Pue~
## 10              175             43   208 Calle Segovia       Plaza de la Cebada~
## # ... with 196 more rows

A continuación trazamos las rutas 100 más populares. A continuación indicamos que representa dada color:

azul: rutas que se tienen más de 200 movimientos/mes
verde: rutas que tienen entre 100 y 200 movimientos/mes
negro:rutas que tienen entre 50 y 100 movimientos/mes.
blanco: rutas que tienen misma estación de desanclaje y anclaje

# nos quedamos con el top 100 de las rutas 
top100_rutasNC  <- rutasNC2[1:100,]

#inicializamos las columnas del dataframe que vamos a crear para poder dibujar las ruta de forma conjunta.
group <- NULL
colour <- NULL
radius <- NULL
weight <- NULL
latitude <- NULL
longitude <- NULL
station <- NULL

# en el siguiente bucle vamos recorriendo las rutas y vamos generando un dataframe que tendrá para cada ruta dos filas, de forma unicas por el campo group. De esta forma a la hora de trazar puedo relacionar origen y destino de la misma ruta. Adicionalmente, el color de la ruta lo hemos marcado diferenciado según el número de veces que se realiza dicha ruta.
i = 1
j = 1
while (i <= nrow(top100_rutasNC)){
  latitude <- rbind(latitude, top100_rutasNC$lat_orig[i],top100_rutasNC$lat_dest[i])
  station <-  rbind(station,j)
  longitude <- rbind(longitude, top100_rutasNC$long_orig[i],top100_rutasNC$long_dest[i])
  j = j+1
  station <-  rbind(station,j)
  group <- rbind(group,i,i)
  num <- top100_rutasNC$n[i]
  if ((num >=200)&(top100_rutasNC$idunplug_station[i]!=top100_rutasNC$idplug_station[i])){ 
    colour <- rbind(colour,"blue", "blue")
    radius <- rbind(radius,"10", "10")
    weight <- rbind(weight,"1", "1")
  }
  if (((num<200)&(num>=100))&(top100_rutasNC$idunplug_station[i]!=top100_rutasNC$idplug_station[i])){  
    colour <- rbind(colour,"green", "green")
    radius <- rbind(radius,"10", "10")
    weight <- rbind(weight,"1", "1")
  }
  if (((num<100)&(num>=50))&(top100_rutasNC$idunplug_station[i]!=top100_rutasNC$idplug_station[i])){ 
    colour <- rbind(colour,"red", "red")
    radius <- rbind(radius,"10", "10")
    weight <- rbind(weight,"1", "1")
  }
  if (top100_rutasNC$idunplug_station[i]==top100_rutasNC$idplug_station[i]){ 
    colour <- rbind(colour,"black", "black")
    radius <- rbind(radius,"10", "10")
    weight <- rbind(weight,"5", "5")
  }
  i = i+1
  j = j+1
}

group <- as.factor(group)

df = cbind.data.frame(station, latitude, longitude, colour, group, radius, weight)
colnames(df) = c("station", "latitude", "longitude", "colour", "group", "radius", "weight")

# dibujo el mapa con las rutas.
top_rutas = leaflet() %>%
  setView(lng = -3.69, lat = 40.4, zoom =12) %>%
  addTiles()%>%
  addCircles(data = df,
             lng = ~ longitude, lat = ~ latitude,
             color = "yellow",
             radius = 30,
             stroke = TRUE,
             opacity = 2,
             weight = 1,
             fillColor = "yellow",
             fillOpacity = 1)%>%
  addLegend("bottomright", colors = c("blue", "green", "red", "black"), labels = c("rutas > 200 movs/mes", "rutas entre 100 y 200 movs/mes", "rutas entre 50 y 100 movs/mes","rutas con mismo origen y destino")) 

for(group in levels(df$group)){
    top_rutas = addPolylines(top_rutas, 
                       lng= ~ longitude,
                       lat= ~ latitude,
                       data=df[df$group == group,], 
                       color= ~ colour,
                       weight = ~ weight)
}

top_rutas

Análisis de los movimientos desde marzo.2020

Hacemos el mismo tratamiento que hemos hecho para el dataset de movs_covid.

A continuación vemos cuales son las rutas únicas con mayor demanda.

## # A tibble: 177 x 5
##    idunplug_station idplug_station     n dir_orig            dir_dest           
##               <int>          <int> <dbl> <chr>               <chr>              
##  1              175            175   280 Calle Segovia       Calle Segovia      
##  2              132            132   239 Paseo de la Florid~ Paseo de la Florid~
##  3              172            172   221 Calle Colombia  nu~ Calle Colombia  nu~
##  4              135            135   214 Paseo de la Choper~ Paseo de la Choper~
##  5               43             43   213 Plaza de la Cebada~ Plaza de la Cebada~
##  6              175             43   187 Calle Segovia       Plaza de la Cebada~
##  7              208            208   175 Gta. Quevedo        Gta. Quevedo       
##  8              177            177   171 Toledo              Toledo             
##  9              197            197   166 Virgen de la Alegr~ Virgen de la Alegr~
## 10              163            163   165 Calle del General ~ Calle del General ~
## # ... with 167 more rows

De forma análoga, trazamos a continuación las 100 rutas con más movimientos.

Cómo se puede observar, en estos meses el comportamiento ha sido muy diferente, casi no hay desplazamientos entre zonas y muchos movimientos tienen misma estación origen y destino.

ANALISIS USUARIOS GENERALES

Grupo 2

12/09/2020