Estoy emocionado de compartir un proyecto reciente donde utilicé el poder del lenguaje R y la metodología de Machine Learning no supervisado para extraer insights críticos de los datos históricos de consumo de agua de la Ciudad de México, disponibles en el portal de datos abiertos de la CDMX.
El objetivo principal fue ir más allá de la estadística descriptiva tradicional, utilizando K-Means Clustering para identificar patrones de consumo y cruzar estos resultados con la Detección de Outliers mediante el método del Rango Intercuartílico (IQR).
Accede al conjunto de datos haciendo del consumo de agua haciendo clic aqui
Accede al mapa de la ciudad de México haciendo clicaqui
La primera fase es preparar el entorno, cargar los datos y aplicar el método del Rango Intercuartílico (IQR) para identificar consumos atípicos que podrían sesgar el análisis de clustering.
# 1. CARGA DE LIBRERÍAS
# Cargamos el paquete principal para manipulación y visualización
library(tidyverse)
# Librerías específicas para análisis geoespacial y clustering
library(sf)
library(cluster)
library(factoextra)
library(knitr) # Para tablas
library(dplyr) # Para manipulación de datos
# Carga del mapa de alcaldías (requiere el archivo .shp en el directorio de trabajo)
mapa <- read_sf("poligos_alcaldias_cdmx.shp file")
# 2. CARGA DEL CONJUNTO DE DATOS
# ¡Asegúrate de que el archivo CSV esté en tu directorio de trabajo!
df <- read_csv("consumo_agua_historico_2019.csv")
# Definir la columna de interés
COLUMNA_ANALIZAR <- "consumo_total"
# 3. CÁLCULO DE LÍMITES IQR
Q1 <- quantile(df[[COLUMNA_ANALIZAR]], 0.25, na.rm = TRUE)
Q3 <- quantile(df[[COLUMNA_ANALIZAR]], 0.75, na.rm = TRUE)
IQR_val <- Q3 - Q1
LIMITE_INFERIOR <- Q1 - 1.5 * IQR_val
LIMITE_SUPERIOR <- Q3 + 1.5 * IQR_val
# 4. CLASIFICACIÓN DE REGISTROS
df_outliers <- df %>%
mutate(
clasificacion = case_when(
!!sym(COLUMNA_ANALIZAR) > LIMITE_SUPERIOR ~ "Outlier Superior",
!!sym(COLUMNA_ANALIZAR) < LIMITE_INFERIOR ~ "Outlier Inferior",
TRUE ~ "Normal"
)
)
El método IQR nos permite clasificar los registros de consumo total. Los límites encontrados son: Inferior = r round(LIMITE_INFERIOR, 2) y Superior = r round(LIMITE_SUPERIOR, 2).
Estadísticas por Clase La siguiente tabla resume el tamaño y el consumo promedio de cada grupo:
# Generación de la tabla de estadísticas
tabla_estadisticas <- df_outliers %>%
group_by(clasificacion) %>%
summarise(
n_registros = n(),
min_consumo = min(!!sym(COLUMNA_ANALIZAR), na.rm = TRUE),
media_consumo = mean(!!sym(COLUMNA_ANALIZAR), na.rm = TRUE),
mediana_consumo = median(!!sym(COLUMNA_ANALIZAR), na.rm = TRUE),
max_consumo = max(!!sym(COLUMNA_ANALIZAR), na.rm = TRUE)
) %>%
mutate(
porcentaje_total = round((n_registros / sum(n_registros)) * 100, 2)
) %>%
ungroup()
# Usamos knitr::kable para una presentación limpia
kable(tabla_estadisticas, caption = "Resumen de Registros Clasificados por IQR",
format = "html", digits = 2)
| clasificacion | n_registros | min_consumo | media_consumo | mediana_consumo | max_consumo | porcentaje_total |
|---|---|---|---|---|---|---|
| Normal | 65022 | 0.00 | 1019.95 | 797.53 | 4010.06 | 91.45 |
| Outlier Superior | 6080 | 4011.06 | 8924.15 | 6091.36 | 119726.94 | 8.55 |
El boxplot nos ofrece una vista rápida de la distribución del consumo y la posición de los outliers.
## Gráfica 1: Boxplot para Detección de Outliers
grafico_boxplot <- ggplot(df_outliers, aes(y = !!sym(COLUMNA_ANALIZAR))) +
geom_boxplot(fill = "lightblue",
color = "darkblue",
outlier.colour = "red", # Puntos rojos son los outliers
outlier.shape = 8) +
labs(
title = "1. Detección de Valores Atípicos (Outliers) en Consumo Total",
subtitle = paste("Método IQR. Límites: [", round(LIMITE_INFERIOR, 2), ",", round(LIMITE_SUPERIOR, 2), "]"),
y = "Consumo Total"
) +
theme_minimal()
print(grafico_boxplot)
Ahora aplicamos K-Means en las variables de consumo (consumo_total y consumo_prom) para identificar patrones recurrentes en el comportamiento de los usuarios
# 2. PREPARACIÓN DE DATOS PARA K-MEANS
df_cluster <- df %>%
select(consumo_total, consumo_prom, latitud, longitud, alcaldia) %>%
drop_na(consumo_total, consumo_prom) # Eliminar filas con NA
# **Escalado de Datos (Normalización):** Paso esencial para K-Means
df_scaled <- scale(df_cluster %>% select(consumo_total, consumo_prom))
# 3. DETERMINACIÓN DEL NÚMERO ÓPTIMO DE GRUPOS (K) - MÉTODO DEL CODO
# Se usa una muestra por eficiencia computacional
df_muestra <- df_scaled %>%
as.data.frame() %>%
sample_n(size = round(nrow(.) * 0.10), replace = FALSE)
# Cálculo del WSS
wss <- fviz_nbclust(df_muestra, kmeans, method = "wss")
print(wss) # Esto muestra la gráfica del método del codo
K_OPT = 3 # Asumimos K=3 por la visualización típica del codo
# 4. APLICACIÓN DEL ALGORITMO K-MEANS
set.seed(42) # Para reproducibilidad
kmeans_resultado <- kmeans(df_scaled, centers = K_OPT, nstart = 25)
# 5. INTEGRACIÓN DE RESULTADOS
# Integramos el cluster al dataframe original con coordenadas
df_cluster_final <- df_cluster %>%
mutate(Cluster = as.factor(kmeans_resultado$cluster))
# 6. ANÁLISIS DE PATRONES (Estadísticas por Cluster)
patrones_resumen <- df_cluster_final %>%
group_by(Cluster) %>%
summarise(
N_Registros = n(),
Porcentaje = round((n() / nrow(.) * 100), 2),
Media_Consumo_Total = mean(consumo_total),
Media_Consumo_Promedio = mean(consumo_prom),
.groups = 'drop'
)
Basado en la media de consumo, recodificamos los clusters en etiquetas más descriptivas
# **¡IMPORTANTE!** Ajusta esta asignación según 'patrones_resumen'
ETIQUETAS_CLUSTER <- c(
"1" = "Bajo Consumo",
"2" = "Consumo Medio",
"3" = "Alto Consumo"
)
# Generamos el dataframe 'clasificaciones' con todos los datos necesarios
clasificaciones <- df_cluster_final %>%
rename(Latitud_Geografica = latitud, Longitud_Geografica = longitud) %>%
mutate(
Cluster_Etiqueta = recode_factor(Cluster, !!!ETIQUETAS_CLUSTER),
consumo_total = df_cluster$consumo_total # Aseguramos que la columna no esté escalada
)
kable(patrones_resumen, caption = "Caracterización de Patrones (Media de Consumo por Cluster)", format = "html", digits = 2)
| Cluster | N_Registros | Porcentaje | Media_Consumo_Total | Media_Consumo_Promedio |
|---|---|---|---|---|
| 1 | 70093 | 98.58 | 1395.50 | 71.14 |
| 2 | 986 | 1.39 | 21502.63 | 1855.72 |
| 3 | 23 | 0.03 | 67896.24 | 47455.29 |
El paso final es visualizar la distribución espacial de los patrones de consumo, añadiendo la capa de polígonos de las Alcaldías (mapa) para contexto.
## 🗺️ Gráfica 1: Mapa Único de Clusters (MODIFICADA con geom_sf)
grafico_mapa_clusters <- ggplot() +
# Capa Base: Polígonos de las Alcaldías
geom_sf(data = mapa,
color = "blue",
linewidth = 0.3,
fill = "lightblue",
alpha = 0.4) +
# Capa de Puntos: Registros de Consumo
geom_point(data = clasificaciones,
aes(x = Longitud_Geografica,
y = Latitud_Geografica,
color = Cluster_Etiqueta),
alpha = 0.7,
size = 0.7) +
labs(
title = "Distribución Geográfica de Patrones de Consumo por Cluster (Base Alcaldías)",
subtitle = "Coloreado por la Etiqueta de Consumo (Bajo, Medio, Alto)",
x = "Longitud Geográfica",
y = "Latitud Geográfica",
color = "Patrón de Consumo"
) +
theme_minimal() +
scale_color_manual(values = c("Bajo Consumo" = "#4CAF50",
"Consumo Medio" = "#FFC107",
"Alto Consumo" = "#F44336")) +
coord_sf(datum = NA) # Coord_sf es necesario para geom_sf
print(grafico_mapa_clusters)
## 🗺️ Gráfica 2: Mapas Separados por Patrón (Facet) (MODIFICADA con geom_sf)
grafico_mapas_clusters_facet <- ggplot() +
# Capa Base: Polígonos de las Alcaldías (Fondo)
geom_sf(data = mapa,
color = "gray70",
linewidth = 0.2,
fill = "gray90",
alpha = 0.6) +
# Capa de Puntos: Registros de Consumo
geom_point(data = clasificaciones,
aes(x = Longitud_Geografica,
y = Latitud_Geografica,
color = Cluster_Etiqueta),
alpha = 0.6,
size = 1) +
# Facet para crear un mapa por cada nivel de 'Cluster_Etiqueta'
facet_wrap(~ Cluster_Etiqueta,
ncol = 3) +
labs(
title = "Concentración Geográfica Individual de Patrones de Consumo",
subtitle = "Visualización separada de Consumo Bajo, Medio y Alto sobre el mapa de la CDMX",
x = "Longitud Geográfica",
y = "Latitud Geográfica",
color = "Patrón de Consumo"
) +
theme_minimal() +
scale_color_manual(values = c("Bajo Consumo" = "#4CAF50",
"Consumo Medio" = "#FFC107",
"Alto Consumo" = "#F44336")) +
coord_sf(datum = NA) +
theme(
legend.position = "none",
strip.background = element_rect(fill = "lightblue", color = "blue"),
strip.text = element_text(face = "bold", size = 12),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank()
)
print(grafico_mapas_clusters_facet)
#4. Estadísticos Descriptivos Detallados y Visualizaciones Adicionales
En esta sección, profundizamos en el análisis de los patrones de consumo
(clusters) generados, examinando la distribución de los registros por
Alcaldía y visualizando las proporciones generales.
Generamos una tabla detallada de los estadísticos descriptivos para el consumo total (consumo_total), segmentada por las etiquetas de cluster, para confirmar las diferencias clave.
# Generar estadísticos descriptivos detallados por Cluster
estadisticos_descriptivos <- clasificaciones %>%
group_by(Cluster_Etiqueta) %>%
summarise(
N = n(),
Media = mean(consumo_total, na.rm = TRUE),
Mediana = median(consumo_total, na.rm = TRUE),
Desviacion_Estandar = sd(consumo_total, na.rm = TRUE),
Minimo = min(consumo_total, na.rm = TRUE),
Maximo = max(consumo_total, na.rm = TRUE),
Q1 = quantile(consumo_total, 0.25, na.rm = TRUE),
Q3 = quantile(consumo_total, 0.75, na.rm = TRUE)
) %>%
ungroup()
# Usamos kableExtra para una tabla visualmente atractiva
library(knitr)
library(kableExtra)
kable(estadisticos_descriptivos,
caption = "Estadísticos Descriptivos del Consumo Total por Patrón (Cluster)",
digits = 2) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"),
full_width = F) %>%
row_spec(0, background = "#D9EDF7", color = "black") # Color de encabezado
| Cluster_Etiqueta | N | Media | Mediana | Desviacion_Estandar | Minimo | Maximo | Q1 | Q3 |
|---|---|---|---|---|---|---|---|---|
| Bajo Consumo | 70093 | 1395.50 | 879.11 | 1698.76 | 0.00 | 12346.47 | 332.12 | 1746.35 |
| Consumo Medio | 986 | 21502.63 | 16556.18 | 13754.03 | 6268.75 | 95117.77 | 13476.93 | 23210.95 |
| Alto Consumo | 23 | 67896.24 | 71454.50 | 27291.62 | 28548.00 | 119726.94 | 49663.12 | 86919.43 |
Este análisis demuestra que la combinación de la Detección de Outliers (IQR) con el Clustering (K-Means) y la Visualización Geoespacial permite obtener una comprensión profunda de los datos de consumo de agua. Los mapas facetados son particularmente útiles para identificar si los patrones de Alto Consumo se concentran en áreas específicas, proporcionando una base sólida para la toma de decisiones enfocadas en la gestión de recursos.