Trabajo Final
Juan Guillermo Ferchero
2024-06-20
Trabajo Final Ciencia de Datos I
Introducción
Este análisis forma parte de la evaluación final del módulo Ciencia de Datos I. La idea es llevar adelante un análisis exploratorio acerca de usuarios de Ecobici durante el año 2024. Los datos se encuentran disponibles en el sitio.
(Nota: Este trabajo se encuentra publicado en mi blog y en mi sitio de GitHub)
Ideas
Generar visualizaciones que permitan entender las características sociodemográficas (en este caso edad) del universo de usuarios
Análizar las altas según las fechas o momentos del dia.
El primer paso es limpiar ambiente, cargar datos y librerías y generar summary y glimpse para tener una primera aproximación a nuestros datos.
#Limpiamos ambiente
rm(list = ls())
#Cargamos librerías y datos
library(tidyverse)
library(DT)
library(scales)
#Descarga de datos
#con internet
link <- "https://cdn.buenosaires.gob.ar/datosabiertos/datasets/transporte-y-obras-publicas/bicicletas-publicas/usuarios_ecobici_2024.csv"
df <- read_csv(link)
#sin internet
#df <- read.csv("../data/usuarios_ecobici_2024.csv")
summary(df) #hacemos una primera vista de la información## ID_usuario genero_usuario edad_usuario fecha_alta
## Min. :1083538 Length:67615 Min. : 5.00 Min. :2024-01-01
## 1st Qu.:1100442 Class :character 1st Qu.: 22.00 1st Qu.:2024-01-25
## Median :1117345 Mode :character Median : 28.00 Median :2024-02-24
## Mean :1117345 Mean : 31.34 Mean :2024-02-25
## 3rd Qu.:1134249 3rd Qu.: 38.00 3rd Qu.:2024-03-27
## Max. :1151188 Max. :949.00 Max. :2024-05-01
## NA's :3
## hora_alta Customer.Has.Dni..Yes...No.
## Length:67615 Length:67615
## Class1:hms Class :character
## Class2:difftime Mode :character
## Mode :numeric
##
##
## glimpse(df)## Rows: 67,615
## Columns: 6
## $ ID_usuario <dbl> 1151021, 1151039, 1150886, 1151154, 115103…
## $ genero_usuario <chr> "MALE", "FEMALE", "OTHER", "FEMALE", "FEMA…
## $ edad_usuario <dbl> 28, 19, 18, 25, 55, 27, 19, 22, 56, 18, 27…
## $ fecha_alta <date> 2024-05-01, 2024-05-01, 2024-05-01, 2024-…
## $ hora_alta <time> 15:35:18, 15:55:54, 11:33:34, 19:05:03, 1…
## $ Customer.Has.Dni..Yes...No. <chr> "No", "No", "No", "No", "No", "No", "No", …usuarios <- nrow(unique(df)) #generamos objetos para texto y grafico
desde <- min(df$fecha_alta) #generamos objetos para texto y grafico
hasta <- max(df$fecha_alta) #generamos objetos para texto y graficoA partir de los análisis iniciales se observa que la base contiene 67615 usuarios registrados desde 2024-01-01 hasta 2024-05-01. El paso siguiente consiste en limpiar las variables que vamos a necesitar para generar las visualizaciones. Tambien mediante summary vemos que en el campo edad_usuario hay 3 valores faltantes y al menos un caso con valores ilógicos
table(df$edad_usuario)##
## 5 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29
## 2 1 2 9 3847 4307 3743 3509 3239 3229 2863 2871 2696 2523 2347 2243
## 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45
## 2090 1927 1808 1727 1580 1461 1326 1238 1178 1008 1033 974 900 867 869 821
## 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61
## 736 734 693 598 559 559 487 423 1647 393 301 287 236 210 170 192
## 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77
## 143 132 113 91 90 80 70 56 44 49 49 30 28 23 26 24
## 78 79 80 81 82 83 84 85 86 87 89 91 92 97 113 123
## 18 15 10 4 9 6 2 6 2 3 2 2 3 1 1 1
## 129 131 134 139 149 236 373 829 831 832 939 942 949
## 2 1 1 1 1 1 1 1 2 1 2 1 1Para un futuro análisis podria chequearse aquellos usuarios con edades mayores a 90 en la base de recorridos para si tienen actividad, por lo pronto vamos a quitara quellos casos mayores a 97. El paso siguiente consiste en proceder a la limpieza de los datos para generar las recodificaciones necesarias. Se observa que el campo género_usuario contiene categorías en ingles, con lo cual procedemos a cambiarlas para que estén en nuestro idioma. Tambien se recodifican hora y edad usuario para obtener categorías más útiles para gráficos y tablas.
df <- df %>%
filter(edad_usuario < 98) %>%
mutate("Genero" = case_when( genero_usuario == "MALE" ~ "Masculino",
genero_usuario == "FEMALE" ~ "Femenino",
TRUE ~ "Otro"), #recod género
"Mes" = month(fecha_alta, label = TRUE), #extraigo mes
"Hora" = hour(hora_alta),
"HoraRec" = case_when(Hora >= 0 & Hora < 6 ~ "Madrugada",
Hora >= 6 & Hora < 12 ~ "Mañana",
Hora >= 12 & Hora < 18 ~ "Tarde",
TRUE ~ "Noche" ),
"Dia" = wday(fecha_alta,label = TRUE, abbr = FALSE),#agrego etiqueta para dias
"EdadRec" = case_when(edad_usuario >= 0 & edad_usuario < 15 ~ "1. Menores de 15",
edad_usuario >= 15 & edad_usuario < 20 ~ "2. de 15 hasta 20",
edad_usuario >= 20 & edad_usuario < 25 ~ "3. de 20 hasta 25",
edad_usuario >= 25 & edad_usuario < 30 ~ "4. de 25 hasta 30",
edad_usuario >= 30 & edad_usuario < 35 ~ "5. de 30 hasta 35",
edad_usuario >= 35 & edad_usuario < 40 ~ "6. de 35 hasta 40",
edad_usuario >= 40 & edad_usuario < 45 ~ "7. de 40 hasta 45",
edad_usuario >= 45 & edad_usuario < 50 ~ "8. de 45 hasta 50",
edad_usuario >= 50 & edad_usuario < 55 ~ "9. de 50 hasta 55",
TRUE ~ "Mayores de 55"))#recod edad
mujeres <- df %>%
filter(Genero == "Femenino") %>%
nrow()
varones <- df %>%
filter(Genero == "Masculino") %>%
nrow()
otro <- df %>%
filter(Genero == "Otro") %>%
nrow()Visualizaciones
ggplot(df, aes(x = edad_usuario))+
geom_histogram(bins = 50, fill ="#d1e5f0")+
labs(title = paste0("Distribución de altas ECOBICI ",desde," - ",hasta),
subtitle = "Cantidad de casos según edad",
caption = "Datos Abiertos CABA",
y = "Edad",
x = "Casos")+
scale_y_continuous(labels = comma)+
theme_minimal()+
theme(plot.title = element_text(hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5),
text = element_text(family = "Verdana"))
Un primer histograma ya con el campo edad “limpio” muestra algunas características de la distribución. Veamos ahora cuantos casos tenemos por género y edad.
# recursos:
# https://rpubs.com/xlisouski/Tuneando_Tablas_DT
# https://help.displayr.com/hc/en-us/articles/360003127476-How-to-Create-Customized-Tables-Using-the-DT-R-Package#
# https://stackoverflow.com/questions/43739218/r-datatable-formatting-with-javascript
Tabla1 <- df %>%
group_by(EdadRec) %>%
summarise(Casos = n()) %>%
mutate(Porcentaje = round(Casos/sum(Casos),4)) %>%
mutate(Etiqueta_Porcentaje = paste0(Casos," ( % ", Porcentaje*100, ")")) %>%
rename(Edad = EdadRec)
Tabla1 %>%
select(!c(Etiqueta_Porcentaje)) %>%
datatable(rownames = FALSE,caption = 'Tabla 1: Altas por rango de edad.',
options = list(paging=FALSE,
searching=FALSE,
initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#2c698d', 'color': '#fff','font-family': 'Verdana'});
$(this.api().table().body()).css({'background-color': 'white', 'color': 'black','font-family': 'Verdana'});
}"))) %>%
formatRound(c("Casos"),0) %>%
formatPercentage(c("Porcentaje"),2) %>%
formatStyle("Porcentaje", background = styleColorBar(c(0,max(Tabla1$Porcentaje)), '#e3f6f5'),
backgroundSize = '100% 100%',
backgroundRepeat = 'no-repeat')%>%
formatStyle(columns = c(3),width = '300px')Tabla1a <- df %>%
group_by(Genero) %>%
summarise(total = n()) %>%
mutate(porcentaje = round(total/sum(total)*100,2)) %>%
mutate(etiqueta = paste0(total," ( % ", porcentaje, ")"))
ggplot(Tabla1a,aes(x="",y=total, fill=Genero))+
geom_bar(stat = "identity",color="white",width = 1)+
scale_fill_manual(values = c("#fb7756","#1ac0c6","#facd60"))+
labs(title = paste0("Altas ECOBICI "),
subtitle = "Proporción según Sexo",
caption = "Datos Abiertos CABA",
y = "",
x = "")+
theme_minimal()+
scale_y_continuous(labels = comma)+
theme(plot.title = element_text( hjust = 0.5 , vjust = 0.5),
plot.subtitle = element_text( hjust = 0.5 , vjust = 0.5),
legend.position = "bottom",
legend.title = element_blank(),
text = element_text(family = "Verdana"))+
guides(fill = guide_legend(reverse = TRUE))+
coord_flip()+
geom_text(aes(label = etiqueta),
position=position_stack(vjust=0.5),
color = "white")
En esta figura puede verse que una mayor proporción de varones utiliza el servicio.
#Aca iria tabla de altas por mes y género
Tabla2 <- df %>%
group_by(Mes,Genero) %>%
summarise(total = n()) %>%
pivot_wider(names_from = Genero, values_from = total)
Tabla2 %>%
datatable(rownames = FALSE,caption = paste0('Tabla 2: Altas según género y mes. ',desde," - ",hasta),
options = list(paging=FALSE,
searching=FALSE,
initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#2c698d', 'color': '#fff','font-family': 'Verdana'});
$(this.api().table().body()).css({'background-color': 'white', 'color': 'black','font-family': 'Verdana'});
}"))) Podemos ver la misma info en formato gráfico, pero ahora visualizando lo ocurrido por dia.
#Aca iria evolutivo de altas por mes coloreado por género
Tabla2a <- df %>%
group_by(fecha_alta,Genero) %>%
summarise(total = n())
ggplot(Tabla2a,aes(x = fecha_alta, y = total, color=Genero ))+
geom_line()+
geom_point()+
scale_color_manual(values =c("#fb7756","#1ac0c6","#facd60"))+
labs(title = paste0("Altas según fecha y género ",desde," - ",hasta),
caption = "Datos Abiertos CABA",
y = "Fecha",
x = "Casos")+
theme_minimal()+
theme(plot.title = element_text(hjust = 0.5, family = "Verdana"),
plot.subtitle = element_text(hjust = 0.5),
text = element_text(family = "Verdana"),
legend.position = "bottom",
legend.title = element_blank())
Siguiendo esta lógica, tambien podemos ver la composición de casos mediante un gráfico de proporciones con la info de la tabla 1. Para un posterior análisis sería intersante plantear que ocurre en meses con climas menos favorables para la bicicleta, para ello puede ser util replicar este mismo análisis, pero utilzando datos de 2023 completo.
Por lo pronto puede apreciarse un descenso de casos en abril tal cual se muestra en el grafico siguiente:
Tabla3 <- df %>%
group_by(Mes,Genero) %>%
summarise(total = n()) %>%
mutate(porcentaje = round(total/sum(total)*100,2)) %>%
mutate(etiqueta = paste0(total," ( % ", porcentaje, ")"))
Tablaaux <- Tabla3 %>%
select(Mes) %>%
filter(!duplicated(Mes))
filas <- nrow(Tablaaux)
ggplot(Tabla3,aes(x="",y=total, fill=Genero))+
geom_bar(stat = "identity",color="white",width = 1)+
scale_fill_manual(values = c("#fb7756","#1ac0c6","#facd60"))+
labs(title = paste0("Altas ECOBICI "),
subtitle = "Proporción según Sexo",
caption = "Datos Abiertos CABA",
y = "",
x = "")+
theme_minimal()+
theme(plot.title = element_text( hjust = 0.5 , vjust = 0.5),
plot.subtitle = element_text( hjust = 0.5 , vjust = 0.5),
legend.position = "bottom",
legend.title = element_blank(),
text = element_text(family = "Verdana"))+
guides(fill = guide_legend(reverse = TRUE))+
coord_flip()+
facet_wrap(~Mes, nrow = filas)+#se wrapea por mes
geom_text(aes(label = etiqueta),
position=position_stack(vjust=0.5),
color = "white")
A continuación veremos como se distribuye el género según la edad bajo la lógica de una piramide de edad
#Aca iria piramide de edad
TotalCasos <- nrow(df) #se arma objeto con total
Tabla4 <- df %>%
select(EdadRec, Genero) %>%
group_by(EdadRec, Genero) %>%
summarise(Casos = n()) %>%
mutate(porc = Casos/TotalCasos*100) %>% #se divide sobre el total de los casos
mutate(porc2 =case_when(Genero == "Femenino" ~ porc,
Genero == "Masculino"~ as.double(porc*(-1))))
ggplot(Tabla4, aes(x= EdadRec,
y=porc2,
fill= Genero))+
geom_col(data = Tabla4 %>%
filter(Genero == "Masculino"), width = 0.5 , fill = "#1ac0c6")+ #columnas hombres
geom_col(data = Tabla4 %>%
filter(Genero == "Femenino"), width = 0.5 , fill = "#fb7756")+ #columnas mujeres
labs(title = paste0("Altas según edad "),
caption = "Datos Abiertos CABA",
y = "Hombres Mujeres", #se agrega eje y separado para mostrar referencias
x = "Edad")+
coord_flip()+
theme_minimal()+
# scale_x_discrete(limit = c("Menores de 10","de 10 hasta 20","de 20 hasta 30","de 30 hasta 40","de 40 hasta 50"))+ #se reordena las categorias
# scale_y_continuous(breaks = c(-8,-4,0,4,8), #se especifican los cortes
# labels = c("8%","4%","0","4%","8%"))+ #se especifican los nombres de los cortes
theme(plot.title = element_text( hjust = 0.5 , vjust = 0.5),
plot.subtitle = element_text( hjust = 0.5 , vjust = 0.5),
text = element_text(family = "Verdana"))
Puede apreciarse que el sector que mas altas realiza es el de 20 a 25 años, como ya vimos en la tabla 1.
Tabla5 <- df %>%
group_by(HoraRec,Genero) %>%
summarise(total = n()) %>%
mutate(porcentaje = round(total/sum(total)*100,2)) %>%
mutate(etiqueta = paste0(total," ( % ", porcentaje, ")"))
Tablaaux <- Tabla5 %>%
select(HoraRec) %>%
filter(!duplicated(HoraRec))
filas <- nrow(Tablaaux)
ggplot(Tabla5,aes(x="",y=total, fill=Genero))+
geom_bar(stat = "identity",color="white",width = 1)+
scale_fill_manual(values = c("#fb7756","#1ac0c6","#facd60"))+
labs(title = paste0("Altas ECOBICI "),
subtitle = "Proporción según Sexo y horario",
caption = "Datos Abiertos CABA",
y = "",
x = "")+
theme_minimal()+
scale_y_continuous(labels = comma)+
theme(plot.title = element_text( hjust = 0.5 , vjust = 0.5),
plot.subtitle = element_text( hjust = 0.5 , vjust = 0.5),
legend.position = "bottom",
legend.title = element_blank(),
text = element_text(family = "Verdana"))+
guides(fill = guide_legend(reverse = TRUE))+
coord_flip()+
facet_wrap(~HoraRec, nrow = filas)+
geom_text(aes(label = total),
position=position_stack(vjust=0.5),
color = "white")#se wrapea por periodo
Se aprecia que la tarde es el momento del día con mayor cantidad de altas.
Conclusión
A partir de este pequeño análisis, fue posible carcaterizar la población de usuarios del Programa Ecobici. Las visualizaciones y tablas construidas permitieron comprender mejor este universo a partir de las variables de las cuales se disponía y las herramientas que dispone R para llevar adelante esta tarea dejando ver el potencial para profundizar el análisis. Se pudo ver que el grueso de altas se produce durante la tarde y en la franja etaria 20 a 25 años. Tambien se observó que el volumen de altas decae en abril en relación a meses de mayor temperatura.
Ideas para futuros análisis
- Utilizar bases de usuarios de años anteriores para construir evolutivos históricos (sobre todo el año 2020 y lo ocurrido con la pandemia)
- Conectar con bases de estaciones y recorridos para georreferenciar los usos del programa, ver recorridos por género, edad y momento del día. Tambien se puede obtener la cantidad de usos por usuario.
- Conectar con otros servicios o API de clima para evaluar influyen las condiciones climáticas en el uso del servicio