# Datos de la base de datos de consumo de agua del primer bimestre de 2019 en Ciudad de México.
df.consumo <- read.csv('E:/BEDU/Curso 5/Proyecto/Datos/consumo_agua_historico_2019.csv')Proyecto Consumo de Agua
Consumo de Agua en Ciudad de México.
Objetivo
El consumo general de agua en México se ha convertido en una preocupación de gran magnitud en los últimos años, debido a la creciente escasez que afecta a toda la República. A lo largo del tiempo, se han documentado innumerables casos en los que la demanda de agua potable en los hogares ha superado la capacidad de suministro, ocasionando fugas constantes debido al aumento en la construcción de viviendas, el crecimiento poblacional y la falta de mantenimiento en las redes de tuberías.
En este contexto, nuestro trabajo se centra en el análisis de datos del consumo de agua en las alcaldías de la Ciudad de México, obtenidos de SACMEX, comparando los resultados de los tres primeros bimestres de 2019. Además, evaluamos los registros de reportes de fugas de agua, problemas de calidad y escasez de agua en la Ciudad de México, utilizando datos de SACMEX desde 2018 y aplicando un modelo de series de tiempo.
El objetivo principal de nuestro proyecto es poder evaluar y predecir la cantidad de fallas en el sistema de agua en la Ciudad de México. Esta información nos permitirá desarrollar estrategias más efectivas para la gestión y conservación del recurso hídrico en la ciudad.
Descripción de nuestra Base de Datos.
Datos obtenidos de SACMEX: información del primer bimestre de 2019 por concepto de suministro de agua a nivel manzana considerando la facturación por servicio de consumo medido y promedio. https://datos.cdmx.gob.mx/sv/dataset/consumo-agua
Reportes de agua: información diaria referente a los reportes realizados por ciudadanos con respecto a servicios del Sistema de Aguas de la Ciudad de México en tres ejes: Drenaje, agua potable y agua tratada. https://datos.cdmx.gob.mx/dataset/reportes-de-agua
Lectura de Datos:
- Consumo de agua datos del primer bimestre de 2019 para las alcaldías de la Ciudad de México.
- Reportes de fallas de agua por fugas, mala calidad y falta de agua en Ciudad de México de 2018 a 2022.
# Datos de la base de datos de reporte de fugas en Ciudad de México de 2018 a 2022.
df.fugas <- read.csv('E:/BEDU/Curso 5/Proyecto/Datos/reportes_agua_hist.csv')Consumo de Agua en Ciudad de México
Descripción inicial de los atributos de los datos
# Clase de dataframe
class(df.consumo)[1] "data.frame"# Dimensión del dataframe
dim(df.consumo)[1] 71102 16# Estructura de los dataframe
str(df.consumo)'data.frame': 71102 obs. of 16 variables:
$ fecha_referencia : chr "2019-06-30" "2019-06-30" "2019-06-30" "2019-06-30" ...
$ anio : int 2019 2019 2019 2019 2019 2019 2019 2019 2019 2019 ...
$ bimestre : int 3 3 3 3 3 3 3 3 3 3 ...
$ consumo_total_mixto : num 159.7 0 0 0 56.7 ...
$ consumo_prom_dom : num 42.6 35.9 24.6 0 67.4 ...
$ consumo_total_dom : num 468 108 123 0 539 ...
$ consumo_prom_mixto : num 53.2 0 0 0 56.7 ...
$ consumo_total : num 631 115 198 254 839 ...
$ consumo_prom : num 42.1 28.8 33 84.5 76.3 ...
$ consumo_prom_no_dom : num 3.05 7.32 75.03 84.51 121.57 ...
$ consumo_total_no_dom: num 3.05 7.32 75.03 253.53 243.14 ...
$ indice_des : chr "ALTO" "MEDIO" "POPULAR" "BAJO" ...
$ colonia : chr "7 DE NOVIEMBRE" "7 DE NOVIEMBRE" "7 DE NOVIEMBRE" "GERTRUDIS SANCHEZ 3A SECCION" ...
$ alcaldia : chr "GUSTAVO A. MADERO" "GUSTAVO A. MADERO" "GUSTAVO A. MADERO" "GUSTAVO A. MADERO" ...
$ latitud : num 19.5 19.5 19.5 19.5 19.5 ...
$ longitud : num -99.1 -99.1 -99.1 -99.1 -99.1 ...# Primeras filas.
head(df.consumo) fecha_referencia anio bimestre consumo_total_mixto consumo_prom_dom
1 2019-06-30 2019 3 159.72 42.56636
2 2019-06-30 2019 3 0.00 35.93667
3 2019-06-30 2019 3 0.00 24.58600
4 2019-06-30 2019 3 0.00 0.00000
5 2019-06-30 2019 3 56.72 67.43625
6 2019-06-30 2019 3 439.77 35.67577
consumo_total_dom consumo_prom_mixto consumo_total consumo_prom
1 468.23 53.24000 631.00 42.06667
2 107.81 0.00000 115.13 28.78250
3 122.93 0.00000 197.96 32.99333
4 0.00 0.00000 253.53 84.51000
5 539.49 56.72000 839.35 76.30455
6 927.57 54.97125 1399.67 37.82892
consumo_prom_no_dom consumo_total_no_dom indice_des
1 3.05000 3.05 ALTO
2 7.32000 7.32 MEDIO
3 75.03000 75.03 POPULAR
4 84.51000 253.53 BAJO
5 121.57000 243.14 BAJO
6 10.77667 32.33 BAJO
colonia alcaldia latitud longitud
1 7 DE NOVIEMBRE GUSTAVO A. MADERO 19.45526 -99.11266
2 7 DE NOVIEMBRE GUSTAVO A. MADERO 19.45526 -99.11266
3 7 DE NOVIEMBRE GUSTAVO A. MADERO 19.45572 -99.11358
4 GERTRUDIS SANCHEZ 3A SECCION GUSTAVO A. MADERO 19.45965 -99.10447
5 PRO HOGAR I AZCAPOTZALCO 19.47416 -99.14675
6 TRABAJADORES DEL HIERRO AZCAPOTZALCO 19.47861 -99.15057# Acomodamos las filas
df.consumo <- df.consumo[, c(1, 2, 3, 7, 4, 5, 6, 10, 11, 9, 8, 12, 13, 14, 15, 16)]
# Nombre de las columnas
names(df.consumo) [1] "fecha_referencia" "anio" "bimestre"
[4] "consumo_prom_mixto" "consumo_total_mixto" "consumo_prom_dom"
[7] "consumo_total_dom" "consumo_prom_no_dom" "consumo_total_no_dom"
[10] "consumo_prom" "consumo_total" "indice_des"
[13] "colonia" "alcaldia" "latitud"
[16] "longitud" summary(df.consumo) fecha_referencia anio bimestre consumo_prom_mixto
Length:71102 Min. :2019 Min. :1.000 Min. : 0.00
Class :character 1st Qu.:2019 1st Qu.:1.000 1st Qu.: 0.00
Mode :character Median :2019 Median :2.000 Median : 33.45
Mean :2019 Mean :2.007 Mean : 50.64
3rd Qu.:2019 3rd Qu.:3.000 3rd Qu.: 61.22
Max. :2019 Max. :3.000 Max. :11702.22
NA's :8327
consumo_total_mixto consumo_prom_dom consumo_total_dom consumo_prom_no_dom
Min. : 0.00 Min. : 0.00 Min. : 0.0 Min. : 0.00
1st Qu.: 0.00 1st Qu.: 18.69 1st Qu.: 161.6 1st Qu.: 6.28
Median : 79.94 Median : 26.41 Median : 604.2 Median : 19.28
Mean : 174.36 Mean : 29.13 Mean : 1186.3 Mean : 126.76
3rd Qu.: 233.32 3rd Qu.: 36.25 3rd Qu.: 1261.4 3rd Qu.: 54.19
Max. :23404.44 Max. :7796.41 Max. :95060.7 Max. :89691.77
NA's :8327 NA's :4820 NA's :4820
consumo_total_no_dom consumo_prom consumo_total indice_des
Min. : 0.00 Min. : 0.00 Min. : 0.0 Length:71102
1st Qu.: 10.98 1st Qu.: 23.01 1st Qu.: 340.9 Class :character
Median : 54.06 Median : 31.69 Median : 896.2 Mode :character
Mean : 436.06 Mean : 111.22 Mean : 1695.8
3rd Qu.: 230.43 3rd Qu.: 45.48 3rd Qu.: 1808.9
Max. :119726.94 Max. :89691.77 Max. :119726.9
colonia alcaldia latitud longitud
Length:71102 Length:71102 Min. :19.14 Min. :-99.34
Class :character Class :character 1st Qu.:19.34 1st Qu.:-99.17
Mode :character Mode :character Median :19.39 Median :-99.14
Mean :19.39 Mean :-99.13
3rd Qu.:19.45 3rd Qu.:-99.10
Max. :19.58 Max. :-98.95
Podemos notar que existen 16 columnas con la siguiente información:
fecha de referencia tiene clase de character, la cual cambiamos a tipo fecha.
El único año a analizar de la base es 2019 por lo que no se necesita esa columna.
La columna de bimestre solo tiene tres datos que son cualitativos ordinales, que corresponden al primer, segundo y tercer bimestre del año 2019.
La columan_total_mixto se refiere a: el consumo total en inmuebles de uso Doméstico y no doméstico simultáneamente.
consumo_prom_dom se refiere al consumo promedio en inmuebles de uso Doméstico.
consumo_total_dom se refiere al consumo total en inmuebles de uso Doméstico
consumo_prom_mixto se refiere al consumo de uso Doméstico y no doméstico.
consumo_total se refiere al consumo total Doméstico, No doméstico y mixto.
consumo_prom se refiere al consumo promedio Doméstico, No doméstico y mixto.
consumo_prom_no_dom se refiere al consumo promedio No Doméstico.
consumo_total_no_dom se refiere al consumo total No Doméstico.
indice_des: Construcción estadística mediante variables de tipo socioeconómico derivadas de información oficial, permite diferenciar territorialmente a la población de la Ciudad de México de acuerdo a su nivel de desarrollo económico, agregando la información a nivel manzana. ALTO, MEDIO, BAJO Y POPULAR.
colonia: nos muestra los nombres de las colonias por alcaldía.
alcaldía: 16 alcaldías de la Ciudad de México
latitud
longitud
Índice de Desarrollo
De acuerdo al diccionario de datos y conforme al Código Fiscal de la Ciudad de México, el índice de desarrollo se refiere a cuatro niveles socioeconómicos:
ALTO: Clasificación que engloba a las manzanas que guardan características socioeconómicas similares y que se tipifican por tener niveles los más altos niveles de desarrollo de la Ciudad.
MEDIO: Clasificación que engloba a las manzanas que guardan características socioeconómicas similares y que se tipifican por tener niveles de desarrollo medio de la Ciudad.
BAJO: “Clasificación que engloba a las manzanas que guardan características socioeconómicas similares y que se tipifican por tener niveles de desarrollo bajo de la Ciudad.”
POPULAR: Clasificación que engloba a las manzanas que guardan características socioeconómicas similares y que se tipifican por tener los niveles de desarrollo más bajos de la Ciudad. En esta categoría se agrupa, además, las manzana que se encuentran dentro de la zona rural de la Ciudad de México.
Uso y tipo de emisión
Por otra parte, el tipo de uso de agua se puede categorizar en tres formas:
Uso Doméstico: Inmuebles de uso Habitacional
Uso No Doméstico: Inmuebles de uso no Habitacional
Uso Mixto: Inmuebles de uso Doméstico y No Doméstico simultáneamente
Mientras que el tipo de emisión se refiere al cálculo o medición por el que se obtiene el consumo en metros cúbicos de agua.
Consumo medido: Tratándose de tomas de agua donde se encuentre instalado o autorizado el medidor de consumo por parte del Sistema de Aguas.
Consumo promedio: El consumo promedio se considerará de la siguiente manera:
A falta de aparato medidor, en proceso de instalación o por imposibilidad material para ser instalado, dicho consumo promedio corresponderá a la colonia catastral en el que se encuentra el inmueble en que esté instalada la toma, siempre y cuando dicha colonia catastral el número de tomas con servicio medido sea mayor o igual al 70% del total de las tomas existentes en la colonia. El Sistema de Aguas publicará anualmente en la Gaceta Oficial de la Ciudad de México, la lista de las colonias catastrales que vayan contando con un 70% o más tomas con servicio medido, así como el consumo promedio de cada una de ellas en el ejercicio fiscal inmediato anterior.
Por descompostura del aparato medidor de consumo o cuando exista la imposibilidad de efectuar su lectura, se pagará tomando como base el consumo promedio de los últimos seis bimestres medidos del mismo uso que el actual anteriores al que se factura, sin que exceda de los últimos cinco ejercicios fiscales, quedando fuera de la estadística, el bimestre con facturación más alta.
Preprocesamiento de Datos.
Decidimos cambiar la clase de la columna fecha de character a date para facilitar el análisis.
Análisis de Datos Nulos
Podemos observar que las columnas consumo_prom_mixto, consumo_total_mixto, consumo_prom_dom, consumo_total_dom, colonia y alcaldía contienen valores nulos.
data.frame('NA' = apply(X = is.na(df.consumo), MARGIN = 2, FUN = sum)) NA.
fecha_referencia 0
bimestre 0
consumo_prom_mixto 8327
consumo_total_mixto 8327
consumo_prom_dom 4820
consumo_total_dom 4820
consumo_prom_no_dom 0
consumo_total_no_dom 0
consumo_prom 0
consumo_total 0
indice_des 0
colonia 216
alcaldia 216
latitud 0
longitud 0Los datos nulos de consumo_prom_mixto y consumo_total_mixto corresponden a las mismas alcaldías y colonias. De la misma manera los datos nulos de las columnas consumo_prom_dom y consumo_total_dom, sin embargo, eliminar estos datos nulos generaría pérdida de información en las columnas restantes, por lo que se decidió dejarlos.
df.consumo$índex <- 1: nrow(df.consumo)
df.consumo <- df.consumo[, c(16, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15)]
na_mixto <- data.frame(cbind(index = df.consumo$index, prom_mixto = is.na(df.consumo$consumo_prom_mixto), total_mixto = is.na(df.consumo$consumo_total_mixto), df.consumo$alcaldia, df.consumo$colonia))
condicion <- na_mixto$prom_mixto == TRUE & na_mixto$total_mixto == TRUE
head(na_mixto[condicion,]) prom_mixto total_mixto V3 V4
3397 TRUE TRUE AZCAPOTZALCO SANTA INES
3401 TRUE TRUE AZCAPOTZALCO SANTA LUCIA (BARR)
3404 TRUE TRUE AZCAPOTZALCO TIERRA NUEVA
3408 TRUE TRUE AZCAPOTZALCO SANTA INES
3410 TRUE TRUE VENUSTIANO CARRANZA CENTRO II
3413 TRUE TRUE MILPA ALTA VILLA MILPA ALTA (PBLO)dim(na_mixto[condicion,])[1] 8327 4na_dom <- data.frame(cbind(index = df.consumo$index, prom_dom = is.na(df.consumo$consumo_prom_dom),
total_dom = is.na(df.consumo$consumo_total_dom), df.consumo$alcaldia,
df.consumo$colonia))
condicion.2 <- na_dom$prom_dom == TRUE & na_dom$total_dom == TRUE
head(na_dom[condicion.2,]) prom_dom total_dom V3 V4
3401 TRUE TRUE AZCAPOTZALCO SANTA LUCIA (BARR)
3404 TRUE TRUE AZCAPOTZALCO TIERRA NUEVA
3413 TRUE TRUE MILPA ALTA VILLA MILPA ALTA (PBLO)
3438 TRUE TRUE AZCAPOTZALCO PROVIDENCIA
3443 TRUE TRUE AZCAPOTZALCO EL ROSARIO B (U HAB)
3444 TRUE TRUE AZCAPOTZALCO EL ROSARIO B (U HAB)dim(na_dom[condicion.2,])[1] 4820 4Podemos eliminar los datos nulos de las columnas alcaldía y colonia ya que no aportan información relevante para analizar.
# Eliminando datos nulos de alcaldía
df.consumo.alcaldia <- complete.cases(df.consumo$alcaldia)
df.consumo.clean <- df.consumo[df.consumo.alcaldia,]
data.frame('NA' = apply(X = is.na(df.consumo.clean), MARGIN = 2, FUN = sum)) NA.
índex 0
fecha_referencia 0
bimestre 0
consumo_prom_mixto 8292
consumo_total_mixto 8292
consumo_prom_dom 4801
consumo_total_dom 4801
consumo_prom_no_dom 0
consumo_total_no_dom 0
consumo_prom 0
consumo_total 0
indice_des 0
colonia 0
alcaldia 0
latitud 0
longitud 0Análisis Exploratorio
summary(df.consumo.clean) índex fecha_referencia bimestre consumo_prom_mixto
Min. : 1 Min. :2019-02-28 Min. :1.000 Min. : 0.00
1st Qu.:17788 1st Qu.:2019-02-28 1st Qu.:1.000 1st Qu.: 0.00
Median :35568 Median :2019-04-30 Median :2.000 Median : 33.54
Mean :35558 Mean :2019-04-30 Mean :2.007 Mean : 50.72
3rd Qu.:53325 3rd Qu.:2019-06-30 3rd Qu.:3.000 3rd Qu.: 61.34
Max. :71102 Max. :2019-06-30 Max. :3.000 Max. :11702.22
NA's :8292
consumo_total_mixto consumo_prom_dom consumo_total_dom consumo_prom_no_dom
Min. : 0.00 Min. : 0.00 Min. : 0.0 Min. : 0.00
1st Qu.: 0.00 1st Qu.: 18.75 1st Qu.: 162.7 1st Qu.: 6.27
Median : 80.09 Median : 26.43 Median : 605.1 Median : 19.30
Mean : 174.59 Mean : 29.09 Mean : 1187.2 Mean : 126.96
3rd Qu.: 233.64 3rd Qu.: 36.27 3rd Qu.: 1262.4 3rd Qu.: 54.22
Max. :23404.44 Max. :7796.41 Max. :95060.7 Max. :89691.77
NA's :8292 NA's :4801 NA's :4801
consumo_total_no_dom consumo_prom consumo_total indice_des
Min. : 0.00 Min. : 0.00 Min. : 0.0 Length:70886
1st Qu.: 10.98 1st Qu.: 23.05 1st Qu.: 342.7 Class :character
Median : 54.02 Median : 31.72 Median : 897.2 Mode :character
Mean : 436.97 Mean : 111.41 Mean : 1697.9
3rd Qu.: 230.65 3rd Qu.: 45.49 3rd Qu.: 1810.7
Max. :119726.94 Max. :89691.77 Max. :119726.9
colonia alcaldia latitud longitud
Length:70886 Length:70886 Min. :19.14 Min. :-99.34
Class :character Class :character 1st Qu.:19.34 1st Qu.:-99.17
Mode :character Mode :character Median :19.39 Median :-99.14
Mean :19.39 Mean :-99.13
3rd Qu.:19.45 3rd Qu.:-99.10
Max. :19.58 Max. :-98.95
Analizando la información de la tabla de resumen podemos observar que existen atributos que no se encuentran en una clase apropiada.
Bimestre se considera un tipo de dato cualitativo, donde solo se presentan tres datos, 1 : primer bimestre, 2 : segundo bimestre, 3 : tercer bimestre.
indice_des se considera una categoría, representa cuatro niveles socioeconómicos: ALTO, MEDIO, BAJO y POPULAR.
Alcaldía representa las 16 alcaldías y por tanto es una categoría. Nos puede ayudar a clasificar los datos de consumo por alcaldías.
Se procederá a cambiar el tipo de dato de las columnas bimestre, indice_Des y alcaldia a factor.
# Cambiar tipo de dato character a factor
df.consumo.clean$bimestre <- as.factor(df.consumo.clean$bimestre)
df.consumo.clean$indice_des <- as.factor(df.consumo.clean$indice_des)
df.consumo.clean$alcaldia <- as.factor(df.consumo.clean$alcaldia)
summary(df.consumo.clean) índex fecha_referencia bimestre consumo_prom_mixto
Min. : 1 Min. :2019-02-28 1:23266 Min. : 0.00
1st Qu.:17788 1st Qu.:2019-02-28 2:23870 1st Qu.: 0.00
Median :35568 Median :2019-04-30 3:23750 Median : 33.54
Mean :35558 Mean :2019-04-30 Mean : 50.72
3rd Qu.:53325 3rd Qu.:2019-06-30 3rd Qu.: 61.34
Max. :71102 Max. :2019-06-30 Max. :11702.22
NA's :8292
consumo_total_mixto consumo_prom_dom consumo_total_dom consumo_prom_no_dom
Min. : 0.00 Min. : 0.00 Min. : 0.0 Min. : 0.00
1st Qu.: 0.00 1st Qu.: 18.75 1st Qu.: 162.7 1st Qu.: 6.27
Median : 80.09 Median : 26.43 Median : 605.1 Median : 19.30
Mean : 174.59 Mean : 29.09 Mean : 1187.2 Mean : 126.96
3rd Qu.: 233.64 3rd Qu.: 36.27 3rd Qu.: 1262.4 3rd Qu.: 54.22
Max. :23404.44 Max. :7796.41 Max. :95060.7 Max. :89691.77
NA's :8292 NA's :4801 NA's :4801
consumo_total_no_dom consumo_prom consumo_total indice_des
Min. : 0.00 Min. : 0.00 Min. : 0.0 ALTO :15495
1st Qu.: 10.98 1st Qu.: 23.05 1st Qu.: 342.7 BAJO :29164
Median : 54.02 Median : 31.72 Median : 897.2 MEDIO : 9748
Mean : 436.97 Mean : 111.41 Mean : 1697.9 POPULAR:16479
3rd Qu.: 230.65 3rd Qu.: 45.49 3rd Qu.: 1810.7
Max. :119726.94 Max. :89691.77 Max. :119726.9
colonia alcaldia latitud
Length:70886 IZTAPALAPA :10518 Min. :19.14
Class :character GUSTAVO A. MADERO :10058 1st Qu.:19.34
Mode :character CUAUHTEMOC : 7165 Median :19.39
BENITO JUAREZ : 6049 Mean :19.39
VENUSTIANO CARRANZA: 5207 3rd Qu.:19.45
MIGUEL HIDALGO : 5110 Max. :19.58
(Other) :26779
longitud
Min. :-99.34
1st Qu.:-99.17
Median :-99.14
Mean :-99.13
3rd Qu.:-99.10
Max. :-98.95
Análisis de las categorías.
A continuación presentaremos las tablas de Frecuencias y Gráficos de Barras para las columnas Bimestre, Índice de Desarrollo, Alcaldía.
`summarise()` has grouped output by 'alcaldia', 'bimestre'. You can override
using the `.groups` argument.
`summarise()` has grouped output by 'bimestre', 'indice_des'. You can override
using the `.groups` argument.
`summarise()` has grouped output by 'bimestre', 'indice_des'. You can override
using the `.groups` argument.
`summarise()` has grouped output by 'alcaldia', 'bimestre'. You can override
using the `.groups` argument.
Podemos observar que para los tres bimestres, el sector con índice de desarrollo bajo es el que cuenta con un mayor número de colonias que reportan consumos de agua. Se puede notar que en todos los bimestres, la alcaldía Iztapalapa es la que representa la mayoría de las colonias de consumo de agua, seguida de las alcaldías Gustavo A. Madero, y Azcapotzalco.
Sin embargo, observando las gráficas por cada bimestre e índice de desarrollo por consumo Total, podemos observar que las alcaldías Benito Juárez, y Miguel Hidalgo en los sectores de índice de desarrollo altos representan los consumos de agua total más altos superando los 2 millones de metros cúbicos cada una.
Por otra parte, en los sectores con índice Bajo, se puede observar que la mayoría de las alcaldías tienen consumos totales que superan el resto de los índices, en especial las alcaldías Azcapotzalco, Guatavo A. Madero y Cuauhtemoc.
También es importante notar que en las alcaldías de Tláhuac, Magdalena Contreras y Miguel Hidalgo, el índice de desarrollo Popular muestra que existe un consumo total considerable. En este índice también se agrupan sectores rurales además de sectores con un índice muy bajo de desarrollo.
Por otra parte, analizando las colonias donde más se concentra el consumo total de agua, se puede notar que veinte colonias mantienen un 11.32% del suministro de agua, habiendo 1,494 colonias en la ciudad de México. Mientras que con 180 colonias, ya se supera el 50% del consumo total.
Además, es evidente que las colonias con más consumo total son las que tienen un índice de desarrollo alto, como son la colonia Juárez en Cuauhtemoc, Lomas de Chapultepec y Polanco en Miguel Hidalgo. Esto quiere decir que hubo una gran concentración de habitantes o viviendas en la zona.
# Colonias | Consumo Total (suma) | Proporción
prop.ct <- df.consumo.clean %>%
select(alcaldia, colonia, bimestre, indice_des, consumo_total) %>%
group_by(colonia) %>%
summarise(consumo_mcubicos = sum(consumo_total))%>%
mutate(prop = paste(round(100*prop.table(consumo_mcubicos), 2), "%", sep=""))
# Ordenamos las colonias de forma descendiente por consumo total, para verificar cuáles son las que tienen más consumo total
orden.col <- prop.ct[order(prop.ct$consumo_mcubicos, decreasing = TRUE),]
# Calculamos la proporción del número de colonias que llegan a 50%, 75% y 90% del suministro del agua
# En n = 180, se llega al 50%
# En n = 400, se llega al 75%
# En n = 670, se llega al 90%
proporcion <- function(n) {
n_col <- orden.col[c(1:n), ]
suma_n_ct <- sum(n_col$consumo_mcubicos)
suma_total_ct <- sum(orden.col$consumo_mcubicos)
proporcion_n_total <- suma_n_ct / suma_total_ct
}
proporcion_50 <- proporcion(180)
proporcion_75 <- proporcion(400)
proporcion_90 <- proporcion(670)
veinte_col <- head(orden.col, 20)
graf_veinte <- veinte_col %>%
ggplot(aes(x= fct_reorder(colonia, consumo_mcubicos),
y = consumo_mcubicos,
fill = colonia)) +
geom_col(show.legend = F, alpha = 0.7) +
labs(title = "Colonias con más consumo total",
subtitle = "Primer Semestre. 2019",
x = "Colonias",
y = "Consumo Total") +
coord_flip()+
theme(plot.title = element_text(hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5))+
scale_fill_manual(values = getPalette(20))+
scale_y_continuous(labels = marks_no_sci)+
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank())
graf_veinte
prop.ct.al <- df.consumo.clean %>%
select(alcaldia, colonia, bimestre, indice_des, consumo_total) %>%
group_by(colonia, alcaldia, indice_des) %>%
summarise(consumo_mcubicos = sum(consumo_total)) %>%
arrange(desc(consumo_mcubicos))`summarise()` has grouped output by 'colonia', 'alcaldia'. You can override
using the `.groups` argument.veinte_ct.al <- head(prop.ct.al,20)
graf_ct.al <- veinte_ct.al %>%
ggplot(aes(x= fct_reorder(colonia, consumo_mcubicos), y = consumo_mcubicos,
fill = indice_des)) +
geom_col(alpha = 0.8) +
labs(title = "Colonias con más consumo total.",
subtitle = "Por Índice de Desarrollo",
x = "Colonias",
y = "Consumo Total") +
coord_flip()+
theme(plot.title = element_text(hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5))+
scale_fill_manual(values = c("#fe6a3a","#cd4570", "#78447a", "#313854"))+
scale_y_continuous(labels = marks_no_sci)+
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank())
graf_ct.al
Análisis de la distribución de los datos.
Medidas de Tendencia Central y Dispersión
Para continuar con nuestro análisis de los datos, estudiaremos las medidas de tendencia central y dispersión de los datos por bimestre. Se analizarán las columnas de consumo total y consumo promedio principalmente.
Aunque a raíz de la exploración anterior, podemos inferir que existirá una gran cantidad de datos atípicos por los consumos altos totales del 10% de las colonias mencionadas antes.
Se eliminarán del estudio estas colonias para analizarlas por separado, y tener información general del resto de la población de estudio.
Análisis por Bimestre
library(moments)
# Función para calcular medidas de tendencia central y dispersión.
calcular_medidas <- function(dataframe, columna) {
# Calcular las medidas descriptivas
Max <- max(dataframe[[columna]], na.rm = TRUE)
Min <- min(dataframe[[columna]], na.rm = TRUE)
# Tendencia Central
Media <- mean(dataframe[[columna]], na.rm = TRUE)
Mediana <- median(dataframe[[columna]], na.rm = TRUE)
# Medidas de Dispersión
Varianza <- var(dataframe[[columna]], na.rm = TRUE)
Desv <- sd(dataframe[[columna]], na.rm = TRUE)
RangoIQ <- IQR(dataframe[[columna]], na.rm = TRUE)
cuartiles <- quantile(dataframe[[columna]], probs = c(0.25, 0.50, 0.75), na.rm = TRUE)
deciles <- quantile(dataframe[[columna]], probs = c(0.2, 0.9), na.rm = TRUE)
skw <- skewness(dataframe[[columna]], na.rm = TRUE)
kts <- kurtosis(dataframe[[columna]], na.rm = TRUE)
q.1 <- cuartiles[1]
q.2 <- cuartiles[2]
q.3 <- cuartiles[3]
d.2 <- deciles[1]
d.9 <- deciles [2]
# Crear un vector con las medidas
medidas_vector <- round(c(Max, Min, Media, Mediana, Varianza, Desv, RangoIQ,
q.1, q.2, q.3, d.2, d.9, skw, kts),2)
return(medidas_vector)
}# Seleccionando datos por bimestre, quitando outliers alrededor del 10% de la cola derecha.
out_nivel <- 3000
bim_1 <- df.consumo.clean %>%
filter(bimestre == 1) %>%
filter(consumo_total < out_nivel) %>%
select(alcaldia, consumo_total, indice_des)
bim_2 <- df.consumo.clean %>%
filter(bimestre == 2) %>%
filter(consumo_total < out_nivel) %>%
select(alcaldia, consumo_total, indice_des)
bim_3 <- df.consumo.clean %>%
filter(bimestre == 3) %>%
filter(consumo_total < out_nivel) %>%
select(alcaldia, consumo_total, indice_des)
total_bim <- df.consumo.clean %>%
filter(consumo_total < out_nivel) %>%
select(alcaldia, consumo_total, indice_des)# Se obtiene un dataframe con las medidas de tendencia central y de dispersión por cada bimestre.
df.medidas.ct <- data.frame(totales = calcular_medidas(total_bim, 'consumo_total'),
row.names = c('Máximo', 'Mínimo',
'Media', 'Mediana', 'Varianza',
'Desviación Estándar', 'Rango IQ',
'1q', '2q', '3q', '2d', '9d',
"Skewness", 'Curtosis'))
df.medidas.ct[, 'bimestre 1'] <- calcular_medidas(bim_1, 'consumo_total')
df.medidas.ct[, 'bimestre 2'] <- calcular_medidas(bim_2, 'consumo_total')
df.medidas.ct[, 'bimestre 3'] <- calcular_medidas(bim_3, 'consumo_total')
df.medidas.ct totales bimestre 1 bimestre 2 bimestre 3
Máximo 2999.91 2998.75 2999.70 2999.91
Mínimo 0.00 0.00 0.00 0.00
Media 890.73 875.00 897.65 899.42
Mediana 748.56 732.06 756.78 758.84
Varianza 556182.35 544759.93 559955.50 563425.77
Desviación Estándar 745.78 738.08 748.30 750.62
Rango IQ 1072.30 1045.94 1084.73 1083.61
1q 263.22 258.19 265.70 265.34
2q 748.56 732.06 756.78 758.84
3q 1335.53 1304.13 1350.43 1348.94
2d 156.54 151.69 158.71 158.00
9d 2013.20 1980.02 2022.46 2030.47
Skewness 0.80 0.83 0.78 0.78
Curtosis 2.88 2.96 2.84 2.83Se puede observar en las distribuciones, que por bimestre, los datos de consumo total se muestran muy parecidos en sus medidas de tendencia central. Todos tienen una media cercana a 900 metros cúbicos, con una desviación estándar de 750 metros cúbicos, y valores mínimos de cero, y valores máximos que superan la media por más de tres veces.
Después de eliminar el diez porciento de los valores atípicos, donde los consumos totales eran mayores a los 3,000 metros cúbicos de agua, se puede ver un coeficiente de asimetría positivo, pero cercano a cero en los tres bimestres, y una curtosis positiva, lo que nos indica que las distribuciones están muy concentradas en la media.
Dado que los datos son muy parecidos, es pertinente enfocarnos en los totales y la categoría de índice de desarrollo.
# Seleccionando datos por bimestre, quitando outliers alrededor del 10% de la cola derecha.
out_nivel <- 3000
id_alto <- df.consumo.clean %>%
filter(indice_des == 'ALTO') %>%
filter(consumo_total < out_nivel) %>%
select(alcaldia, consumo_total)
id_medio <- df.consumo.clean %>%
filter(indice_des == 'MEDIO') %>%
filter(consumo_total < out_nivel) %>%
select(alcaldia, consumo_total)
id_bajo <- df.consumo.clean %>%
filter(indice_des == 'BAJO') %>%
filter(consumo_total < out_nivel) %>%
select(alcaldia, consumo_total)
id_popular <- df.consumo.clean %>%
filter(indice_des == 'POPULAR') %>%
filter(consumo_total < out_nivel) %>%
select(alcaldia, consumo_total)# Se obtiene un dataframe con las medidas de tendencia central y de dispersión por cada bimestre.
df.medidas.ct.id <- data.frame(id_alto = calcular_medidas(id_alto, 'consumo_total'),
row.names = c('Máximo', 'Mínimo',
'Media', 'Mediana', 'Varianza',
'Desviación Estándar', 'Rango IQ',
'1q', '2q', '3q', '2d', '9d',
"Skewness", 'Curtosis'))
df.medidas.ct.id[, 'id_medio'] <- calcular_medidas(id_medio, 'consumo_total')
df.medidas.ct.id[, 'id_bajo'] <- calcular_medidas(id_bajo, 'consumo_total')
df.medidas.ct.id[, 'id_popular'] <- calcular_medidas(id_popular, 'consumo_total')
df.medidas.ct.id id_alto id_medio id_bajo id_popular
Máximo 2999.09 2998.75 2998.42 2999.91
Mínimo 0.00 0.00 0.00 0.00
Media 1172.79 864.68 902.40 633.49
Mediana 1034.70 731.72 788.63 379.70
Varianza 559991.58 476766.44 533303.86 508007.52
Desviación Estándar 748.33 690.48 730.28 712.75
Rango IQ 1093.60 943.60 1047.61 893.69
1q 582.93 319.43 293.60 59.78
2q 1034.70 731.72 788.63 379.70
3q 1676.53 1263.03 1341.21 953.47
2d 503.22 229.17 164.06 30.37
9d 2312.17 1870.61 1981.14 1751.22
Skewness 0.55 0.89 0.74 1.33
Curtosis 2.44 3.24 2.86 4.06# Outliers. Se crea un dataframe con los valores atípicos.
out_nivel <- 3000
df.outliers.id <- df.consumo.clean %>%
filter(consumo_total > out_nivel) %>%
group_by(indice_des) %>%
summarise(n = n()) %>%
mutate(prop = paste(round(100*prop.table(n), 2), "%", sep=""))
# Histogramas. Se crean histogramas de los valores de consumo total, por bimestre.
# Aún se puede notar el sesgo a la izquierda.
graf.1 <- df.consumo.clean %>%
filter(consumo_total < out_nivel) %>%
ggplot(aes(consumo_total, fill=indice_des)) +
geom_histogram(bins = 20, position = "identity", alpha = 0.8) +
facet_grid(indice_des~. , scales= 'free') +
labs(title = "Histograma",
x = "Consumo Total",
y = "Frecuencia") +
theme_classic() +
scale_fill_manual(values = c("#fe6a3a","#cd4570", "#78447a", "#313854"))+
scale_y_continuous(labels = marks_no_sci)+
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank())
# Boxplot
graf.2 <- df.consumo.clean %>%
filter(consumo_total < out_nivel) %>%
ggplot(aes(consumo_total, fill=indice_des)) +
geom_boxplot(varwidth = TRUE, alpha=0.8) +
facet_grid(indice_des~. , scales= 'free') +
labs(title = "Boxplot",
x = "Consumo Total",
y = "Frequencuencia") +
theme_classic()+
scale_fill_manual(values = c("#fe6a3a","#cd4570", "#78447a", "#313854"))+
scale_y_continuous(labels = marks_no_sci)+
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank())
graf.3 <- df.consumo.clean %>%
filter(consumo_total < out_nivel) %>%
ggplot(aes(x = consumo_total, fill=indice_des)) +
geom_density(alpha=0.8) +
facet_wrap(indice_des~. , scales= 'free') +
labs(title = "Densidad",
x = "Consumo Total")+
theme_classic()+
theme(axis.text.x = element_text(angle = 90))+
scale_fill_manual(values = c("#fe6a3a","#cd4570", "#78447a", "#313854"))+
scale_y_continuous(labels = marks_no_sci)+
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank())
# Para usar plot_grid se necesita la libreria cowplot
library(cowplot)
graf.1; graf.2; graf.3
Podemos notar a partir de las distribuciones y las medidas de tendencia central y dispersión que los cuatro grupos por índice de desarrollo están sesgadas a la izquierda, con valores mínimos de cero. Sin embargo, se puede notar una diferencia en la distribución del sector alto, donde los consumos están más arriba de los mil metros cúbicos de consumo total y tiene mayor dispersión de los datos, también se puede observar que tiene menor coeficiente de asimetría que los demás, lo que puede asemejarse más a un comportamiento normal.
Análisis por Alcaldía
# Para crear un dataframe con el resumen de las medidas por Alcaldía.
nom.al <- c(levels(df.consumo.clean$alcaldia))
df.medidas.al <- data.frame()
for (i in nom.al){
df.al <- df.consumo.clean %>%
filter(alcaldia == i) %>%
select(consumo_total)
if (length(df.medidas.al) == 0) {
df.medidas.al <- data.frame(calcular_medidas(df.al, 'consumo_total'),
row.names = c('Máximo', 'Mínimo',
'Media', 'Mediana', 'Varianza',
'Desviación Estándar', 'Rango IQ',
'1q', '2q', '3q', '2d', '9d',
"Skewness", 'Curtosis'))
colnames(df.medidas.al)[1] <- nom.al[1]
} else {
df.medidas.al[, i] <- calcular_medidas(df.al, 'consumo_total')
}
}
df.medidas.al ALVARO OBREGON AZCAPOTZALCO BENITO JUAREZ COYOACAN
Máximo 85225.96 72501.90 40728.16 42764.36
Mínimo 0.00 0.00 0.00 0.00
Media 2319.22 2127.51 2278.08 1554.05
Mediana 1135.08 1106.74 1683.36 777.32
Varianza 20090765.37 25127984.18 5664797.83 9736946.72
Desviación Estándar 4482.27 5012.78 2380.08 3120.41
Rango IQ 1716.48 1223.48 1999.04 1215.61
1q 558.36 623.23 905.09 302.40
2q 1135.08 1106.74 1683.36 777.32
3q 2274.85 1846.71 2904.13 1518.01
2d 458.68 520.27 757.95 184.30
9d 4892.00 3654.02 4568.32 3108.58
Skewness 7.87 8.79 4.81 6.17
Curtosis 101.80 99.58 48.94 54.04
CUAJIMALPA DE MORELOS CUAUHTEMOC GUSTAVO A. MADERO
Máximo 66650.92 89691.80 119726.94
Mínimo 0.00 0.00 0.00
Media 3323.94 2568.29 1340.24
Mediana 1270.05 1867.44 840.04
Varianza 52046637.66 11413233.44 17824740.59
Desviación Estándar 7214.34 3378.35 4221.94
Rango IQ 2388.30 2519.04 935.71
1q 442.22 884.72 406.35
2q 1270.05 1867.44 840.04
3q 2830.52 3403.76 1342.06
2d 332.88 711.73 283.84
9d 6791.34 5299.45 1968.36
Skewness 4.81 13.44 15.47
Curtosis 30.07 317.91 304.66
IZTACALCO IZTAPALAPA LA MAGDALENA CONTRERAS MIGUEL HIDALGO
Máximo 31914.18 80856.11 37022.23 65285.12
Mínimo 0.00 0.00 0.00 0.00
Media 1804.74 790.40 1331.39 2835.69
Mediana 1115.37 296.40 464.48 1662.64
Varianza 5388278.15 6002290.20 10614174.07 20835074.43
Desviación Estándar 2321.27 2449.96 3257.94 4564.55
Rango IQ 1479.61 843.25 1165.31 2360.31
1q 618.17 30.68 33.70 843.21
2q 1115.37 296.40 464.48 1662.64
3q 2097.78 873.93 1199.01 3203.52
2d 538.90 17.08 16.81 678.94
9d 3818.06 1485.40 3094.16 5883.37
Skewness 4.67 16.78 6.63 6.98
Curtosis 36.92 431.08 59.18 73.69
MILPA ALTA TLAHUAC TLALPAN VENUSTIANO CARRANZA
Máximo 2493.72 19434.16 56873.96 58236.90
Mínimo 0.00 0.00 0.00 0.00
Media 252.89 436.42 1565.54 1376.84
Mediana 134.94 140.89 442.59 882.40
Varianza 129213.28 1340127.59 15138849.10 5628050.84
Desviación Estándar 359.46 1157.64 3890.87 2372.35
Rango IQ 259.57 358.43 1414.79 921.72
1q 40.65 43.47 20.13 541.85
2q 134.94 140.89 442.59 882.40
3q 300.22 401.90 1434.92 1463.57
2d 26.43 31.72 8.43 467.80
9d 644.35 816.23 3250.10 2519.44
Skewness 2.97 8.82 6.15 12.79
Curtosis 13.99 115.33 54.98 250.02
XOCHIMILCO
Máximo 17846.18
Mínimo 0.00
Media 809.74
Mediana 458.19
Varianza 2141707.97
Desviación Estándar 1463.46
Rango IQ 615.98
1q 209.41
2q 458.19
3q 825.39
2d 168.35
9d 1470.47
Skewness 5.99
Curtosis 50.27# Gráficos: Histograma, Boxplot y de Densidad por Alcaldía
nom.al.1 <- c(levels(df.consumo.clean$alcaldia))
i <- nom.al.1[1]
df.al <- df.consumo.clean %>%
filter(alcaldia == i) %>%
select(consumo_total, indice_des)
nombre.1 <- df.al %>%
filter(consumo_total < out_nivel) %>%
ggplot(aes(consumo_total, fill=indice_des)) +
geom_histogram(show.legend = F, bins = 20,
position = "identity", alpha = 0.8) +
facet_grid(indice_des~. ) +
labs(title = paste("Histograma", i),
x = "Consumo Total",
y = "Frecuencia") +
theme_classic() +
scale_y_continuous(labels = marks_no_sci)+
scale_fill_manual(values = c("#fe6a3a","#cd4570", "#78447a", "#313854"))+
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank())
nombre.2 <- df.al %>%
filter(consumo_total < out_nivel) %>%
ggplot(aes(consumo_total, fill=indice_des)) +
geom_boxplot(show.legend = F, varwidth = TRUE, alpha=0.8) +
facet_grid(indice_des~. ) +
labs(title = paste("Boxplot", i),
x = "Consumo Total",
y = "Frequencuencia") +
theme_classic()+
scale_y_continuous(labels = marks_no_sci)+
scale_fill_manual(values = c("#fe6a3a","#cd4570", "#78447a", "#313854"))+
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank())
nombre.3 <- df.al %>%
filter(consumo_total < out_nivel) %>%
ggplot(aes(x = consumo_total, fill=indice_des)) +
geom_density(alpha=0.8) +
facet_wrap(indice_des~. ) +
labs(title = paste("Densidad", i),
x = "Consumo Total")+
theme_classic()+
scale_y_continuous(labels = marks_no_sci)+
scale_fill_manual(values = c("#fe6a3a","#cd4570", "#78447a", "#313854"))+
theme(axis.text.x = element_text(angle = 90))+
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank())
library(gridExtra)
Attaching package: 'gridExtra'The following object is masked from 'package:dplyr':
combine grid.arrange(nombre.1,nombre.3, nombre.2, ncol = 2)
levels(df.consumo.clean$alcaldia) [1] "ALVARO OBREGON" "AZCAPOTZALCO" "BENITO JUAREZ"
[4] "COYOACAN" "CUAJIMALPA DE MORELOS" "CUAUHTEMOC"
[7] "GUSTAVO A. MADERO" "IZTACALCO" "IZTAPALAPA"
[10] "LA MAGDALENA CONTRERAS" "MIGUEL HIDALGO" "MILPA ALTA"
[13] "TLAHUAC" "TLALPAN" "VENUSTIANO CARRANZA"
[16] "XOCHIMILCO" Se puede observar en la mayoría de las distribuciones de las alcaldías, que los datos de consumo de agua se encuentran en un rango que va desde 0 a 4000 metros cúbicos cuando son consumos totales de aguaen todos los sectores de desarrollo socioeconómico. Mientras que presentan un consumo promedio que se centra en un rango de 0 a 100 metros cúbicos de agua.
Por otra parte, el conjunto de observaciones que tiene más frecuencia en su consumo total de agua se encuentra en el sector con índice de desarrollo bajo y en el popular en la mayoría de las alcaldías, con algunas excepciones como Benito Juárez, Cuajimalpa, y Coyoacán donde el sector con índice de desarrollo alto también contiene la mayoría de los consumos totales. Mientras que en el consumo promedio los sectores con índice de desarrollo bajo y popular representan el conjunto más significativo de los datos.
Todas las distribuciones están sesgadas a la izquierda, tanto de consumo total como promedio en cada alcaldía. Los datos atípicos contienen valores en el último decil con cantidades considerablemente grandes, por lo que se decidió eliminarlos del análisis.
Registro Histórico de Reportes de Fugas 2018 - 2022
Preprocesamiento de Datos
Descripción inicial de los atributos de los datos
Este conjunto de datos muestra información diaria referente a reportes de fallas en el suministro de agua potable realizados por ciudadanos usuarios del servicio de la CDMX.
Datos obtenidos de: https://datos.cdmx.gob.mx/dataset/reportes-de-agua
# Clase de dataframe
class(df.fugas)[1] "data.frame"# Dimensión del dataframe
dim(df.fugas)[1] 254730 10# Primeras filas.
head(df.fugas) folio tipo_de_falla quien_atiende latitud longitud codigo_postal
1 20210405-0030 Falta de agua Poniente 19.37893 -99.19193 1420
2 20210428-0107 Falta de agua Poniente 19.34262 -99.21888 1780
3 20210428-0184 Falta de agua Poniente 19.34289 -99.21800 NA
4 20210429-0075 Falta de agua Poniente 19.34262 -99.21888 1780
5 20210429-0157 Falta de agua Poniente 19.34283 -99.21798 1780
6 20210407-0159 Falta de agua Poniente 19.37642 -99.21027 1410
fecha colonia_registro_sacmex colonia_datos_abiertos
1 2021-04-05 Alfonso XIII SANTA MARIA NONOALCO
2 2021-04-28 Olivar de los Padres LOMAS DE LOS ANGELES TETELPAN
3 2021-04-28 Lomas de los Ángeles Tetelpan LOMAS DE LOS ANGELES TETELPAN
4 2021-04-29 Olivar de los Padres LOMAS DE LOS ANGELES TETELPAN
5 2021-04-29 Lomas de los Ángeles Tetelpan LOMAS DE LOS ANGELES TETELPAN
6 2021-04-07 Ciudad de México BARRIO NORTE
alcaldia
1 ALVARO OBREGON
2 ALVARO OBREGON
3 ALVARO OBREGON
4 ALVARO OBREGON
5 ALVARO OBREGON
6 ALVARO OBREGON# Estructura de los dataframe
(str(df.fugas))'data.frame': 254730 obs. of 10 variables:
$ folio : chr "20210405-0030" "20210428-0107" "20210428-0184" "20210429-0075" ...
$ tipo_de_falla : chr "Falta de agua" "Falta de agua" "Falta de agua" "Falta de agua" ...
$ quien_atiende : chr "Poniente" "Poniente" "Poniente" "Poniente" ...
$ latitud : num 19.4 19.3 19.3 19.3 19.3 ...
$ longitud : num -99.2 -99.2 -99.2 -99.2 -99.2 ...
$ codigo_postal : int 1420 1780 NA 1780 1780 1410 1700 1296 1296 1296 ...
$ fecha : chr "2021-04-05" "2021-04-28" "2021-04-28" "2021-04-29" ...
$ colonia_registro_sacmex: chr "Alfonso XIII" "Olivar de los Padres" "Lomas de los Ángeles Tetelpan" "Olivar de los Padres" ...
$ colonia_datos_abiertos : chr "SANTA MARIA NONOALCO" "LOMAS DE LOS ANGELES TETELPAN" "LOMAS DE LOS ANGELES TETELPAN" "LOMAS DE LOS ANGELES TETELPAN" ...
$ alcaldia : chr "ALVARO OBREGON" "ALVARO OBREGON" "ALVARO OBREGON" "ALVARO OBREGON" ...NULL# Acomodamos las filas
df.fugas <- df.fugas[, c(7, 1, 2, 3, 4, 5, 6, 8, 9, 10)]
# Nombre de las columnas
names(df.fugas) [1] "fecha" "folio"
[3] "tipo_de_falla" "quien_atiende"
[5] "latitud" "longitud"
[7] "codigo_postal" "colonia_registro_sacmex"
[9] "colonia_datos_abiertos" "alcaldia" summary(df.fugas) fecha folio tipo_de_falla quien_atiende
Length:254730 Length:254730 Length:254730 Length:254730
Class :character Class :character Class :character Class :character
Mode :character Mode :character Mode :character Mode :character
latitud longitud codigo_postal colonia_registro_sacmex
Min. :-51.50 Min. :-122.71 Min. : 0 Length:254730
1st Qu.: 19.32 1st Qu.: -99.19 1st Qu.: 3300 Class :character
Median : 19.37 Median : -99.15 Median : 6700 Mode :character
Mean : 19.30 Mean : -98.65 Mean : 7368
3rd Qu.: 19.42 3rd Qu.: -99.12 3rd Qu.: 10900
Max. : 65.42 Max. : 117.12 Max. :209191
NA's :15754
colonia_datos_abiertos alcaldia
Length:254730 Length:254730
Class :character Class :character
Mode :character Mode :character
# Cambio de clase en la columna fecha
df.fugas <- df.fugas %>%
mutate(fecha = as.Date(fecha))
# Cambio de clase en la columna codigo_postal
df.fugas <- df.fugas %>%
mutate(codigo_postal = as.character(codigo_postal))
summary(df.fugas) fecha folio tipo_de_falla quien_atiende
Min. :2018-01-01 Length:254730 Length:254730 Length:254730
1st Qu.:2018-12-03 Class :character Class :character Class :character
Median :2019-10-30 Mode :character Mode :character Mode :character
Mean :2020-01-07
3rd Qu.:2021-03-19
Max. :2021-12-31
latitud longitud codigo_postal colonia_registro_sacmex
Min. :-51.50 Min. :-122.71 Length:254730 Length:254730
1st Qu.: 19.32 1st Qu.: -99.19 Class :character Class :character
Median : 19.37 Median : -99.15 Mode :character Mode :character
Mean : 19.30 Mean : -98.65
3rd Qu.: 19.42 3rd Qu.: -99.12
Max. : 65.42 Max. : 117.12
colonia_datos_abiertos alcaldia
Length:254730 Length:254730
Class :character Class :character
Mode :character Mode :character
# Cambiar tipo de dato character a factor
df.fugas$tipo_de_falla <- as.factor(df.fugas$tipo_de_falla)
df.fugas$quien_atiende <- as.factor(df.fugas$quien_atiende)
df.fugas$alcaldia <- as.factor(df.fugas$alcaldia)
df.fugas$colonia_datos_abiertos <- as.factor(df.fugas$colonia_datos_abiertos)
(str(df.fugas)) 'data.frame': 254730 obs. of 10 variables:
$ fecha : Date, format: "2021-04-05" "2021-04-28" ...
$ folio : chr "20210405-0030" "20210428-0107" "20210428-0184" "20210429-0075" ...
$ tipo_de_falla : Factor w/ 3 levels "Falta de agua",..: 1 1 1 1 1 1 1 1 1 1 ...
$ quien_atiende : Factor w/ 30 levels "Álvaro Obregón",..: 22 22 22 22 22 22 22 22 22 22 ...
$ latitud : num 19.4 19.3 19.3 19.3 19.3 ...
$ longitud : num -99.2 -99.2 -99.2 -99.2 -99.2 ...
$ codigo_postal : chr "1420" "1780" NA "1780" ...
$ colonia_registro_sacmex: chr "Alfonso XIII" "Olivar de los Padres" "Lomas de los Ángeles Tetelpan" "Olivar de los Padres" ...
$ colonia_datos_abiertos : Factor w/ 1698 levels "10 DE ABRIL",..: 1459 830 830 830 830 156 1545 641 641 641 ...
$ alcaldia : Factor w/ 16 levels "ALVARO OBREGON",..: 1 1 1 1 1 1 1 1 1 1 ...NULLPodemos notar que existen 10 columnas con la siguiente información:
- fecha: columna de fecha desde el 01-01-2018 a 31-12-2021, no son únicas, puede haber repeticiones.
- folio: columna que se conforma de la fecha y un código de identificación del reporte. Es de clase tipo character.
- tipo_de_falla: columna que conforma las categorías de fallas en el sistema de agua. FALTA DE AGUA, FUGA Y MALA CALIDAD.
- quien_atiende, corresponde a los centros de atención que tienen los reportes de fallas. Son 30.
- latitud
- longitud
- codigo_postal
- colonia_registro_sacmex
- colonia_datos_abiertos
- alcaldia
Análisis de Datos Nulos
Notamos que datos importantes en los reportes faltan, en particular en las columnas de alcaldía y tipos de falla, que son importantes para nuestro análisis, por lo que decidimos eliminar estas filas.
data.frame('NA' = apply(X = is.na(df.fugas), MARGIN = 2, FUN = sum)) NA.
fecha 0
folio 0
tipo_de_falla 5
quien_atiende 146
latitud 0
longitud 0
codigo_postal 15754
colonia_registro_sacmex 654
colonia_datos_abiertos 4120
alcaldia 4120# Eliminando datos nulos de alcaldía
df.fugas.alcaldia <- complete.cases(df.fugas$alcaldia)
df.fugas.clean <- df.fugas[df.fugas.alcaldia,]
data.frame('NA' = apply(X = is.na(df.fugas.clean), MARGIN = 2, FUN = sum)) NA.
fecha 0
folio 0
tipo_de_falla 5
quien_atiende 145
latitud 0
longitud 0
codigo_postal 14669
colonia_registro_sacmex 0
colonia_datos_abiertos 0
alcaldia 0# Eliminando datos nulos de tipo de falla
df.fugas.tf <- complete.cases(df.fugas.clean$tipo_de_falla)
df.fugas.clean <- df.fugas.clean[df.fugas.tf,]
data.frame('NA' = apply(X = is.na(df.fugas.clean), MARGIN = 2, FUN = sum)) NA.
fecha 0
folio 0
tipo_de_falla 0
quien_atiende 145
latitud 0
longitud 0
codigo_postal 14668
colonia_registro_sacmex 0
colonia_datos_abiertos 0
alcaldia 0# Eliminando las colonias registradas en sacmex, para dejar solo las colonias de dats abiertos. De esta manera se facilitará el cruce de información con la base de consumo.
df.fugas.clean <- df.fugas.clean[,-8]
colnames(df.fugas.clean)[8] <- 'colonia'Análisis Exploratorio
summary(df.fugas.clean) fecha folio tipo_de_falla
Min. :2018-01-01 Length:250605 Falta de agua:217103
1st Qu.:2018-12-04 Class :character Fuga : 32662
Median :2019-10-31 Mode :character Mala calidad : 840
Mean :2020-01-08
3rd Qu.:2021-03-20
Max. :2021-12-31
quien_atiende latitud longitud
Centro Pascua :52963 Min. :19.13 Min. :-99.34
Oriente :33793 1st Qu.:19.32 1st Qu.:-99.19
Sur Xotepingo :31292 Median :19.37 Median :-99.15
Sur San Pedro Mártir:30884 Mean :19.37 Mean :-99.15
Poniente :25588 3rd Qu.:19.42 3rd Qu.:-99.12
(Other) :75940 Max. :19.58 Max. :-98.95
NA's : 145
codigo_postal colonia
Length:250605 JARDINES DEL PEDREGAL : 2699
Class :character PEDREGAL DE STO DOMINGO V : 1576
Mode :character NARVARTE VI : 1484
SAN ANDRES TOTOLTEPEC (PBLO): 1412
CUAUHTEMOC : 1361
LETRAN VALLE : 1321
(Other) :240752
alcaldia
COYOACAN :32868
TLALPAN :31087
BENITO JUAREZ :29886
GUSTAVO A. MADERO:25265
ALVARO OBREGON :22385
IZTAPALAPA :20776
(Other) :88338 Análisis de las categorías de los datos.
Tablas de Frecuencias y Gráficos de Barras para las columnas Tipos de Falla y Alcaldía.
Podemos notar que los tipos de fallas que se reportan con mayor frecuencia son los de falta de agua, y las tres alcaldías que cuentan con más de éstos reportes son Tlalpan, Benito Juárez y Coyoacán. Por lo que se requiere hacer una investigación más profunda acerca del desabasto de agua en estas zonas y sus posibles causas.
Una investigación en la página de la alcaldía de Tlalpan de 2023 (https://www.tlalpan.cdmx.gob.mx/reduccion-de-abasto-de-agua-2023/) nos permite ver que hubo reducciones en el abastecimiento de agua en 40 colonias debido los bajos niveles de agua en las presas Valle de Bravo, Villa Victoria y el Bosque que abastecen al Sistema Cutzamala.
# Tabla de Frecuencias Absolutas, Relativas
# Frecuencias Absolutas y Relativas por alcaldía y tipo de falla.
freq_tf <- df.fugas.clean %>%
group_by(alcaldia, tipo_de_falla) %>%
summarise(fallas = n()) %>%
mutate(prop = paste(round(100*prop.table(fallas), 2), "%", sep="")) `summarise()` has grouped output by 'alcaldia'. You can override using the
`.groups` argument.# Gráfico de Frecuencias absolutas
graf_tf <- freq_tf %>%
ggplot(aes(x = reorder(alcaldia, fallas), y = fallas, fill = tipo_de_falla)) +
geom_bar(stat="identity", position="dodge", alpha = 0.8) +
#facet_wrap(~tipo_de_falla)+
labs(title = "Reportes por Tipo de Falla",
subtitle = "Por alcaldía. 2018-2022",
x = "Alcaldía",
y = "Número de Reportes de Fallas") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5))+
theme(axis.text.x = element_text(angle = 90))+
scale_fill_manual(values = c("#fe6a3a", "#313854", "#a4447c"))+
scale_y_continuous(labels = marks_no_sci)+
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank())
graf_tf
Análisis por Colonia.
Nos interesa saber cuáles son las colonias con mayor cantidad de reportes, y si siguen el mismo patrón cada año, desde el 2018 a 2022.
Podemos observar que las alcaldías pueden tener colonias con reportes de agua de diferente tipo. En particular nos vamos a concentrar en los reportes de falta de agua.
En el gráfico se puede observar que el mayor número de reportes por falta de agua se concentran en 800 colonias de un total de 1,751. Es decir un 89% de los reportes provienen de casi la mitad de las colonias. Mientras que un 11% de los reportes se concentran en solo 20 colonias, que han presentado un total de 2,398 reportes de falta de agua desde el 2018 a finales de 2021.
# Tabla de Frecuencias Absolutas, Relativas
# Frecuencias Absolutas y Relativas por colonia, alcaldía y tipo de falla.
freq_tf.col <- df.fugas.clean %>%
group_by(colonia, alcaldia, tipo_de_falla) %>%
summarise(fallas = n()) %>%
mutate(prop = prop.table(fallas)) #%>%`summarise()` has grouped output by 'colonia', 'alcaldia'. You can override
using the `.groups` argument. # arrange(desc(fallas))
(sum(freq_tf.col$prop))[1] 1767# Frecuencias Absolutas por colonia, alcaldía y tipo de falla = Falta de agua, ordenadas de mayor a menor.
freq_tf.fa <- df.fugas.clean %>%
filter(tipo_de_falla == 'Falta de agua') %>%
group_by(colonia, alcaldia) %>%
summarise(fallas = n()) %>%
#mutate(prop = prop.table(fallas)) #%>%
arrange(desc(fallas))`summarise()` has grouped output by 'colonia'. You can override using the
`.groups` argument.# Creamos una tabla que agrupa las colonias en grupos de 20 con respecto al número de fallas de mayor a menor. El primer grupo tiene los consumos más altos...
freq_tf.fa$orden <- 1: nrow(freq_tf.fa)
(sum(freq_tf.fa$fallas))[1] 217103grupos <- c(seq(from= 0, to = 1760, by = 20))
grupos_veinte_tf.fa <- freq_tf.fa %>%
mutate(fallas_bin = cut(orden,
breaks=grupos)) %>%
mutate(grupo = as.integer(fallas_bin))
# Gráfico de las colonias por grupos de 20.
grupo1_tf.fa <- grupos_veinte_tf.fa |>
filter(grupo <= 40) |>
group_by(grupo) |>
summarise(suma_fallas = sum(fallas))
graf_tf.fa <- grupo1_tf.fa %>%
ggplot(aes(x = grupo, y = suma_fallas)) +
geom_col(fill="tomato") +
labs(title = "Fallas por cada 20 colonias",
x = "Grupos",
y = "Número de Fallas") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5))+
theme(axis.text.x = element_text(angle = 90))+
scale_y_continuous(labels = marks_no_sci)+
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank())
graf_tf.fa
grupo1_rep <- grupos_veinte_tf.fa |>
filter(grupo <= 40) |>
group_by(grupo) |>
summarise(suma_fallas = sum(fallas))
grupo1 <- (sum(grupo1_rep$suma_fallas))
total_reportes <- (sum(grupos_veinte_tf.fa$fallas))
proporcion_rep <- grupo1 / total_reportes
proporcion_rep[1] 0.8913649graf_rep <- grupos_veinte_tf.fa |>
filter(grupo ==1) |>
ggplot(aes(x = fct_reorder(colonia, fallas), y = fallas,
fill=colonia)) +
geom_col(show.legend = F, alpha = 0.7) +
labs(title = "Colonias con más reportes de fallas",
subtitle = "2018-2022",
x = "Colonia",
y = "Reportes") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5))+
coord_flip()+
scale_fill_manual(values = getPalette(20))+
#theme(axis.text.x = element_text(angle = 90))+
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank())
graf_rep
Análisis por Semestres y Años
Podemos observar en la gráfica de serie de tiempo donde se agrupan los reportes totales de fallas, que el año
# Grupos por años
library(tibbletime)
Attaching package: 'tibbletime'The following object is masked from 'package:stats':
filterfechas_fallas <- df.fugas.clean %>% select(fecha) %>% group_by(fecha) %>% summarise(reportes=n())
anio_2018 <- as_tbl_time(fechas_fallas, index = fecha) %>% filter_time('2018' ~ '2018')
anio_2019 <- as_tbl_time(fechas_fallas, index = fecha) %>% filter_time('2019' ~ '2019')
anio_2020 <- as_tbl_time(fechas_fallas, index = fecha) %>% filter_time('2020' ~ '2020')
anio_2021 <- as_tbl_time(fechas_fallas, index = fecha) %>% filter_time('2021' ~ '2021')
# Recuentos
sumas_por_anio <- data.frame("a2018" = sum(anio_2018$reportes),
"a2019" = sum(anio_2019$reportes),
"a2020" = sum(anio_2020$reportes),
"a2021" = sum(anio_2021$reportes))
a18 <- anio_2018 %>%
ggplot(aes(x = fecha, y= reportes)) +
geom_line() +
guides(fill = guide_legend(title = "Reportes de Fallas"))+
labs(title = "Serie de Tiempo - 2018",
x = "Tiempo: días",
y = "Reportes de Fallas")+
theme_classic() +
scale_x_date(date_labels = "%B", date_breaks = "1 month")+
theme(axis.text.x = element_text(angle = 90))
a19 <- anio_2019 %>%
ggplot(aes(x = fecha, y= reportes)) +
geom_line() +
guides(fill = guide_legend(title = "Reportes de Fallas"))+
labs(title = "Serie de Tiempo - 2019",
x = "Tiempo: días",
y = "Reportes de Fallas")+
theme_classic() +
scale_x_date(date_labels = "%B", date_breaks = "1 month")+
theme(axis.text.x = element_text(angle = 90))
a20 <- anio_2020 %>%
ggplot(aes(x = fecha, y= reportes)) +
geom_line() +
guides(fill = guide_legend(title = "Reportes de Fallas"))+
labs(title = "Serie de Tiempo - 2020",
x = "Tiempo: días",
y = "Reportes de Fallas")+
theme_classic() +
scale_x_date(date_labels = "%B", date_breaks = "1 month")+
theme(axis.text.x = element_text(angle = 90))
a21 <- anio_2021 %>%
ggplot(aes(x = fecha, y= reportes)) +
geom_line() +
guides(fill = guide_legend(title = "Reportes de Fallas"))+
labs(title = "Serie de Tiempo - 2021",
x = "Tiempo: días",
y = "Reportes de Fallas")+
theme_classic() +
scale_x_date(date_labels = "%B", date_breaks = "1 month")+
theme(axis.text.x = element_text(angle = 90))
grid.arrange(a18, a19, a20, a21, ncol = 2)
# Grupos por semestres
semestre_1801 <- anio_2018 %>% filter_time('start' ~ '2018-06')
semestre_1802 <- anio_2018 %>% filter_time('2018-06' ~ 'end')
semestre_1901 <- anio_2019 %>% filter_time('2019-01' ~ '2019-06')
semestre_1902 <- anio_2019 %>% filter_time('2019-06' ~ 'end')
semestre_2001 <- anio_2020 %>% filter_time('start' ~ '2020-06')
semestre_2002 <- anio_2020 %>% filter_time('2020-06' ~ 'end')
semestre_2101 <- anio_2021 %>% filter_time('start' ~ '2021-06')
semestre_2102 <- anio_2021 %>% filter_time('2021-06' ~ 'end')
s18 <- semestre_1801 %>%
ggplot(aes(x = fecha, y= reportes)) +
geom_line() +
guides(fill = guide_legend(title = "Reportes de Fallas"))+
labs(title = "Serie de Tiempo - 2018-06",
x = "Tiempo: días",
y = "Reportes de Fallas")+
theme_classic() +
scale_x_date(date_labels = "%B", date_breaks = "1 month")+
theme(axis.text.x = element_text(angle = 90))
s182 <- semestre_1802 %>%
ggplot(aes(x = fecha, y= reportes)) +
geom_line() +
guides(fill = guide_legend(title = "Reportes de Fallas"))+
labs(title = "Serie de Tiempo - 2018-12",
x = "Tiempo: días",
y = "Reportes de Fallas")+
theme_classic() +
scale_x_date(date_labels = "%B", date_breaks = "1 month")+
theme(axis.text.x = element_text(angle = 90))
s19 <- semestre_1901 %>%
ggplot(aes(x = fecha, y= reportes)) +
geom_line() +
guides(fill = guide_legend(title = "Reportes de Fallas"))+
labs(title = "Serie de Tiempo - 2019-06",
x = "Tiempo: días",
y = "Reportes de Fallas")+
theme_classic() +
scale_x_date(date_labels = "%B", date_breaks = "1 month")+
theme(axis.text.x = element_text(angle = 90))
s192 <- semestre_1902 %>%
ggplot(aes(x = fecha, y= reportes)) +
geom_line() +
guides(fill = guide_legend(title = "Reportes de Fallas"))+
labs(title = "Serie de Tiempo - 2019-12",
x = "Tiempo: días",
y = "Reportes de Fallas")+
theme_classic() +
scale_x_date(date_labels = "%B", date_breaks = "1 month")+
theme(axis.text.x = element_text(angle = 90))
s20 <- semestre_2001%>%
ggplot(aes(x = fecha, y= reportes)) +
geom_line() +
guides(fill = guide_legend(title = "Reportes de Fallas"))+
labs(title = "Serie de Tiempo - 2020-06",
x = "Tiempo: días",
y = "Reportes de Fallas")+
theme_classic() +
scale_x_date(date_labels = "%B", date_breaks = "1 month")+
theme(axis.text.x = element_text(angle = 90))
s202 <- semestre_2002%>%
ggplot(aes(x = fecha, y= reportes)) +
geom_line() +
guides(fill = guide_legend(title = "Reportes de Fallas"))+
labs(title = "Serie de Tiempo - 2020-12",
x = "Tiempo: días",
y = "Reportes de Fallas")+
theme_classic() +
scale_x_date(date_labels = "%B", date_breaks = "1 month")+
theme(axis.text.x = element_text(angle = 90))
s21 <- semestre_2101 %>%
ggplot(aes(x = fecha, y= reportes)) +
geom_line() +
guides(fill = guide_legend(title = "Reportes de Fallas"))+
labs(title = "Serie de Tiempo - 2021-06",
x = "Tiempo: días",
y = "Reportes de Fallas")+
theme_classic() +
scale_x_date(date_labels = "%B", date_breaks = "1 month")+
theme(axis.text.x = element_text(angle = 90))
s212 <- semestre_2102 %>%
ggplot(aes(x = fecha, y= reportes)) +
geom_line() +
guides(fill = guide_legend(title = "Reportes de Fallas"))+
labs(title = "Serie de Tiempo - 2021-12",
x = "Tiempo: días",
y = "Reportes de Fallas")+
theme_classic() +
scale_x_date(date_labels = "%B", date_breaks = "1 month")+
theme(axis.text.x = element_text(angle = 90))
grid.arrange(s18, s182, ncol = 1)
grid.arrange(s19, s192, ncol = 1)
grid.arrange(s20, s202, ncol = 1)
grid.arrange(s21, s212, ncol = 1)
Distribuciones
Mostrando los datos convertidos a un dataframe por día, donde se incluye una columna que es el conteo de las fallas de agua por alcaldía.
# Tabla por alcaldía y por día
BENITO_tf <- df.fugas.clean %>%
select(fecha, alcaldia, folio, tipo_de_falla) %>%
filter(alcaldia == 'BENITO JUAREZ') %>%
group_by(fecha) %>%
summarise(count = n(), .groups = 'drop')
# Histogramas
aa1tf <- BENITO_tf %>%
ggplot(aes(count)) +
geom_histogram(bins = 5) +
#facet_wrap(~indice_des) +
labs(title = "Histograma",
x = "Reportes de Fallas",
y = "Frequency") +
theme_minimal()
aa1tf
# Boxplot
aa2tf <- BENITO_tf %>%
ggplot(aes(y=count)) +
geom_boxplot(varwidth = TRUE, alpha=0.2) +
labs(title = "Boxplot",
x = "Reportes de Fallas",
y = "Frequency")+
theme_minimal()
aa2tf
aa3tf <- BENITO_tf %>%
ggplot(aes(x = count)) +
geom_density() +
guides(fill = guide_legend(title = "Reportes de Fallas"))+
labs(title = "Densidad",
x = "Reportes de Fallas",
y = "Frequency")+
theme_classic()
aa3tf
# Gráfica de líneas
aa4tf <- BENITO_tf %>%
ggplot(aes(x = fecha, y= count)) +
geom_line() +
guides(fill = guide_legend(title = "Reportes de Fallas"))+
labs(title = "Serie de Tiempo",
x = "Tiempo: días",
y = "Reportes de Fallas")+
theme_classic()
aa4tf
# Para usar plot_grid se necesita la librería cowplot
library(cowplot)
completo <- plot_grid( aa1tf, aa2tf, aa3tf, aa4tf)Medidas de Tendencia Central y Dispersión
Columnas numéricas: count
df.medidas.tf <- data.frame(Medidas = calcular_medidas(BENITO_tf, 2),
row.names = c('Máximo', 'Mínimo',
'Media', 'Mediana', 'Varianza',
'Desviación Estándar', 'Rango IQ',
'1q', '2q', '3q', '2d', '9d',
"Skewness", 'Curtosis'))
df.medidas.tf Medidas
Máximo 193.00
Mínimo 1.00
Media 21.12
Mediana 13.00
Varianza 599.49
Desviación Estándar 24.48
Rango IQ 22.00
1q 5.00
2q 13.00
3q 27.00
2d 4.00
9d 48.00
Skewness 2.64
Curtosis 12.30# Para crear un dataframe con el resumen de las medidas por Alcaldía.
nom.al <- c(levels(df.consumo.clean$alcaldia))
df.medidas.al <- data.frame()
for (i in nom.al){
df.al <- df.consumo.clean %>%
filter(alcaldia == i) %>%
select(consumo_total)
if (length(df.medidas.al) == 0) {
df.medidas.al <- data.frame(calcular_medidas(df.al, 'consumo_total'),
row.names = c('Máximo', 'Mínimo',
'Media', 'Mediana', 'Varianza',
'Desviación Estándar', 'Rango IQ',
'1q', '2q', '3q', '2d', '9d',
"Skewness", 'Curtosis'))
colnames(df.medidas.al)[1] <- nom.al[1]
} else {
df.medidas.al[, i] <- calcular_medidas(df.al, 'consumo_total')
}
}
df.medidas.al ALVARO OBREGON AZCAPOTZALCO BENITO JUAREZ COYOACAN
Máximo 85225.96 72501.90 40728.16 42764.36
Mínimo 0.00 0.00 0.00 0.00
Media 2319.22 2127.51 2278.08 1554.05
Mediana 1135.08 1106.74 1683.36 777.32
Varianza 20090765.37 25127984.18 5664797.83 9736946.72
Desviación Estándar 4482.27 5012.78 2380.08 3120.41
Rango IQ 1716.48 1223.48 1999.04 1215.61
1q 558.36 623.23 905.09 302.40
2q 1135.08 1106.74 1683.36 777.32
3q 2274.85 1846.71 2904.13 1518.01
2d 458.68 520.27 757.95 184.30
9d 4892.00 3654.02 4568.32 3108.58
Skewness 7.87 8.79 4.81 6.17
Curtosis 101.80 99.58 48.94 54.04
CUAJIMALPA DE MORELOS CUAUHTEMOC GUSTAVO A. MADERO
Máximo 66650.92 89691.80 119726.94
Mínimo 0.00 0.00 0.00
Media 3323.94 2568.29 1340.24
Mediana 1270.05 1867.44 840.04
Varianza 52046637.66 11413233.44 17824740.59
Desviación Estándar 7214.34 3378.35 4221.94
Rango IQ 2388.30 2519.04 935.71
1q 442.22 884.72 406.35
2q 1270.05 1867.44 840.04
3q 2830.52 3403.76 1342.06
2d 332.88 711.73 283.84
9d 6791.34 5299.45 1968.36
Skewness 4.81 13.44 15.47
Curtosis 30.07 317.91 304.66
IZTACALCO IZTAPALAPA LA MAGDALENA CONTRERAS MIGUEL HIDALGO
Máximo 31914.18 80856.11 37022.23 65285.12
Mínimo 0.00 0.00 0.00 0.00
Media 1804.74 790.40 1331.39 2835.69
Mediana 1115.37 296.40 464.48 1662.64
Varianza 5388278.15 6002290.20 10614174.07 20835074.43
Desviación Estándar 2321.27 2449.96 3257.94 4564.55
Rango IQ 1479.61 843.25 1165.31 2360.31
1q 618.17 30.68 33.70 843.21
2q 1115.37 296.40 464.48 1662.64
3q 2097.78 873.93 1199.01 3203.52
2d 538.90 17.08 16.81 678.94
9d 3818.06 1485.40 3094.16 5883.37
Skewness 4.67 16.78 6.63 6.98
Curtosis 36.92 431.08 59.18 73.69
MILPA ALTA TLAHUAC TLALPAN VENUSTIANO CARRANZA
Máximo 2493.72 19434.16 56873.96 58236.90
Mínimo 0.00 0.00 0.00 0.00
Media 252.89 436.42 1565.54 1376.84
Mediana 134.94 140.89 442.59 882.40
Varianza 129213.28 1340127.59 15138849.10 5628050.84
Desviación Estándar 359.46 1157.64 3890.87 2372.35
Rango IQ 259.57 358.43 1414.79 921.72
1q 40.65 43.47 20.13 541.85
2q 134.94 140.89 442.59 882.40
3q 300.22 401.90 1434.92 1463.57
2d 26.43 31.72 8.43 467.80
9d 644.35 816.23 3250.10 2519.44
Skewness 2.97 8.82 6.15 12.79
Curtosis 13.99 115.33 54.98 250.02
XOCHIMILCO
Máximo 17846.18
Mínimo 0.00
Media 809.74
Mediana 458.19
Varianza 2141707.97
Desviación Estándar 1463.46
Rango IQ 615.98
1q 209.41
2q 458.19
3q 825.39
2d 168.35
9d 1470.47
Skewness 5.99
Curtosis 50.27Metodología del Modelo
Librerías
library(dplyr)
library(ggplot2)
library(tseries)Registered S3 method overwritten by 'quantmod':
method from
as.zoo.data.frame zoo library(forcats)
library(forecast)
library(stats)
#list.files()
options(scipen=999)Lectura de la base, y agrupación por fecha.
Se decidió utilizar los datos hasta el 01-12-2021, y dejar el mes de diciembre de 2021 para probar el modelo.
#Lectura de archivo
agua_cdmx<- df.fugas.clean
agua_serie<- agua_cdmx %>% select(fecha) %>% group_by(fecha ) %>% summarise(reportes=n())
#esta base nos ayudara a comprobar una vez validado el modelo
serie_comprobadora<-agua_serie %>% filter(fecha>="2021-12-01")
#Filtramos la fecha y graficamos
agua_serie<-agua_serie %>% filter(fecha<"2021-12-01")
ggplot(agua_serie, aes(x=fecha,y = reportes)) +
geom_line()
Serie de tiempo
#Creamos la serie de tiempo
serie_agua<-ts(agua_serie,frequency=365, start=c(2018, 1))
decompose(serie_agua[,2]) %>% plot()
adf.test(serie_agua[,2], alternative = "stationary")Warning in adf.test(serie_agua[, 2], alternative = "stationary"): p-value
smaller than printed p-value
Augmented Dickey-Fuller Test
data: serie_agua[, 2]
Dickey-Fuller = -4.5737, Lag order = 11, p-value = 0.01
alternative hypothesis: stationaryContraste de hipótesis:
H0: No estacionaria
H1: Estacionaria
Tras realizar la prueba aumentada de Dickey-Fuller (ADF), obtenemos un p-valor = 0.01.
Como el p-valor < 0.05, rechazamos H0, la serie es estacionaria.
Realizando la prueba de autocorrelación podemos ver que la serie no tiene una caída exponencial
autoplot(acf(serie_agua[,2])) 
Aunque la serie presenta de origen estacionariedad, probamos corriendo la función ndiffs(), para verificar si es necesario aplicar alguna diferencia al momento de correr el modelo.
La función ndiffs nos muestra que la serie debería tener 1 diferencia.
ndiffs(serie_agua[,2]) [1] 1A partir de este gráfico podemos ver que ya se crea un cambio exponencial en la autocorrelación.
autoplot(acf(diff(serie_agua[,2]))) 
Por ello aplicaremos “Una diferencia” para trabajar el modelo y observamos gráficamente como se comporta la serie.
d1_agua<-diff(serie_agua[,2])
autoplot(d1_agua) 
Corroboramos estacionaridad.
adf.test(d1_agua,alternative="stationary") Warning in adf.test(d1_agua, alternative = "stationary"): p-value smaller than
printed p-value
Augmented Dickey-Fuller Test
data: d1_agua
Dickey-Fuller = -17.104, Lag order = 11, p-value = 0.01
alternative hypothesis: stationaryComo podemos ver en el gráfico ahora la distribución se ajusta a una media cero, con un comportamiento aleatorio. Esto se corrobora de nuevo con la prueba Dicky-Fuller Aumentada donde el P-value = 0.01, por ende P-value < 0.05, se afirma la estacionariedad para trabajar en la serie.
EL valor a usar de “d” sera igual a 1.
MA
Para encontrar los valores que ocuparan los parámetros para p y q del Modelo, aplicaremos las pruebas de autocorrelación y autocorrelación parcial, esta prueba la aplicaremos a la serie generada con una diferencia.
autoplot(acf(d1_agua))
Como vemos en el gráfico el lag 2 es el que sobre sale, así como el lag 3 # q = 2 , 3
AR
Aplicaremos la prueba de correlación parcial para obtener en número de AR(Auto regresivos) a usar en el modelo.
autoplot(pacf(d1_agua))
En el gráfico obtenido observamos que los lags posibles son para p:
p=2,3,4,5
ARIMA(p,d,q)
De acuerdo a los valores obtenidos previamente se plantean los siguientes modelos:
# Modelo 1 (2,1,2)
m1<-arima(serie_agua[,2],order = c(2,1,2))
m1
Call:
arima(x = serie_agua[, 2], order = c(2, 1, 2))
Coefficients:
ar1 ar2 ma1 ma2
1.0377 -0.5985 -1.3664 0.5300
s.e. 0.0429 0.0377 0.0417 0.0477
sigma^2 estimated as 6278: log likelihood = -8276.39, aic = 16562.77bx_m1<-Box.test(residuals(m1),type="Ljung-Box")
#Modelo 2 (3,1,2)
m2<-arima(serie_agua[,2],order = c(3,1,2))
m2
Call:
arima(x = serie_agua[, 2], order = c(3, 1, 2))
Coefficients:Warning in sqrt(diag(x$var.coef)): Se han producido NaNs ar1 ar2 ar3 ma1 ma2
0.1291 -0.024 -0.1363 -0.4371 -0.4019
s.e. NaN NaN NaN NaN NaN
sigma^2 estimated as 6396: log likelihood = -8289.75, aic = 16591.5bx_m2<-Box.test(residuals(m2),type="Ljung-Box")
#Modelo 3 (4,1,2)
m3<-arima(serie_agua[,2],order = c(4,1,2))
m3
Call:
arima(x = serie_agua[, 2], order = c(4, 1, 2))
Coefficients:
ar1 ar2 ar3 ar4 ma1 ma2
0.7707 -0.8978 0.1440 -0.4846 -1.1176 0.8437
s.e. 0.0285 0.0325 0.0312 0.0255 0.0216 0.0223
sigma^2 estimated as 5158: log likelihood = -8137.12, aic = 16288.23bx_m3<-Box.test(residuals(m3),type="Ljung-Box")
#Modelo 4 (5,1,2)
m4<-arima(serie_agua[,2],order = c(5,1,2))
m4
Call:
arima(x = serie_agua[, 2], order = c(5, 1, 2))
Coefficients:
ar1 ar2 ar3 ar4 ar5 ma1 ma2
0.1719 -0.7158 -0.2652 -0.2931 -0.5082 -0.5605 0.4993
s.e. 0.0469 0.0280 0.0335 0.0229 0.0306 0.0548 0.0363
sigma^2 estimated as 4677: log likelihood = -8067.02, aic = 16150.04bx_m4<-Box.test(residuals(m4),type="Ljung-Box")
#Modelo 5 (2,1,3)
m5<-arima(serie_agua[,2],order = c(2,1,3))
m5
Call:
arima(x = serie_agua[, 2], order = c(2, 1, 3))
Coefficients:
ar1 ar2 ma1 ma2 ma3
-0.3639 -0.4065 0.0429 -0.1820 -0.5783
s.e. 0.0446 0.0611 0.0396 0.0583 0.0348
sigma^2 estimated as 6268: log likelihood = -8275.45, aic = 16562.9bx_m5<-Box.test(residuals(m5),type="Ljung-Box")
#Modelo 6 (3,1,3)
m6<-arima(serie_agua[,2],order = c(3,1,3))
m6
Call:
arima(x = serie_agua[, 2], order = c(3, 1, 3))
Coefficients:
ar1 ar2 ar3 ma1 ma2 ma3
0.1421 -0.7316 0.5837 -0.4716 0.4981 -0.9024
s.e. 0.0273 0.0121 0.0273 0.0222 0.0282 0.0154
sigma^2 estimated as 5534: log likelihood = -8187.65, aic = 16389.3bx_m6<-Box.test(residuals(m6),type="Ljung-Box")
#Modelo 7 (4,1,3)
m7<-arima(serie_agua[,2],order = c(4,1,3))
m7
Call:
arima(x = serie_agua[, 2], order = c(4, 1, 3))
Coefficients:
ar1 ar2 ar3 ar4 ma1 ma2 ma3
0.9462 -1.1325 0.3531 -0.4811 -1.3573 1.1626 -0.3492
s.e. 0.0425 0.0436 0.0410 0.0302 0.0475 0.0525 0.0442
sigma^2 estimated as 4964: log likelihood = -8109.45, aic = 16234.9bx_m7<-Box.test(residuals(m7),type="Ljung-Box")
#Modelo 8 (5,1,3)
m8<-arima(serie_agua[,2],order = c(5,1,3))
m8
Call:
arima(x = serie_agua[, 2], order = c(5, 1, 3))
Coefficients:
ar1 ar2 ar3 ar4 ar5 ma1 ma2 ma3
0.0207 -0.8220 -0.0403 -0.2413 -0.4713 -0.2933 0.5864 -0.5858
s.e. 0.0308 0.0257 0.0443 0.0242 0.0285 0.0301 0.0191 0.0395
sigma^2 estimated as 4522: log likelihood = -8043.49, aic = 16104.97bx_m8<-Box.test(residuals(m8),type="Ljung-Box")
#Tabla Modelos
modelos_p<-data.frame("ARIMA" = c("Modelo 1 (2,1,2)","Modelo 2 (3,1,2)",
"Modelo 3 (4,1,2)","Modelo 4 (5,1,2)","Modelo 5 (2,1,3)",
"Modelo 6 (3,1,3)","Modelo 7 (4,1,3)","Modelo 8 (5,1,3)"),
"AIC" = c(m1$aic,m2$aic,m3$aic,m4$aic,m5$aic,m6$aic,m7$aic,m8$aic),
"p_value_Ljunk_Box"=c(bx_m1$p.value, bx_m2$p.value, bx_m3$p.value,
bx_m4$p.value, bx_m5$p.value, bx_m6$p.value,
bx_m7$p.value, bx_m8$p.value)
)
modelos_p<- modelos_p %>%
mutate("p_value>0.05" = ifelse(p_value_Ljunk_Box >0.05,"VERDADERO" ,"FALSO"))
modelos_p ARIMA AIC p_value_Ljunk_Box p_value>0.05
1 Modelo 1 (2,1,2) 16562.77 0.655840561625 VERDADERO
2 Modelo 2 (3,1,2) 16591.50 0.758420065642 VERDADERO
3 Modelo 3 (4,1,2) 16288.23 0.000799554305 FALSO
4 Modelo 4 (5,1,2) 16150.04 0.770772947757 VERDADERO
5 Modelo 5 (2,1,3) 16562.90 0.098905103963 VERDADERO
6 Modelo 6 (3,1,3) 16389.30 0.000007269016 FALSO
7 Modelo 7 (4,1,3) 16234.90 0.486180945257 VERDADERO
8 Modelo 8 (5,1,3) 16104.97 0.038518105793 FALSOLa tabla nos muestra los valores AIC y el p_value de la prueba Ljung-Box.
Donde el modelo 4 y 8 presental los valores mas pequeños para el AIC, pero si revisamos los residuales de donde nace el P_value de la prueba Ljunk Box, vemos que en el modelo 8, el p-value es menor a 0.05 por lo que se muestra que existe autocorrelación en los residuos.
Para validar si los residuos se distribuyen de forma normal, se aplica el test de normalidad Shapiro-Wilk, que es una prueba estadística utilizada para evaluar si una muestra de datos sigue una distribución normal.
Las hipótesis nula y alternativa del test de Shapiro-Wilk son las siguientes:
H0: Los residuos siguen una distribución normal.
H1: Los residuos NO siguen una distribución normal.
El valor p es menor que un nivel de significancia de 0.05, se puede rechazar la hipótesis nula y concluir que la muestra no sigue una distribución normal.
shapiro.test(m4$residuals)
Shapiro-Wilk normality test
data: m4$residuals
W = 0.93546, p-value < 0.00000000000000022Los errores se mueven alrededor de una media = 0
autoplot(residuals(m4))
Los valores son normales ya que descansan en una línea y no están dispersos.
errores<-residuals(m4)
qqnorm(errores)
qqline(errores,col="red",lwd=2) 
Una vez elegido el mejor modelo procedemos a crear nuestro pronóstico
pronostico<-forecast(m4, h=31, level = 95)
autoplot(pronostico)
autoplot(pronostico$mean, col="blue")+
geom_line(aes(y=pronostico$upper),col="green")+ geom_point(aes(y=pronostico$upper))+
geom_line(aes(y=pronostico$lower),col="green")+ geom_point(aes(y=pronostico$lower))+
geom_line(aes(y=serie_comprobadora$reportes),col="red")+ geom_point(aes(y=serie_comprobadora$reportes))
Conclusiones
Podemos observar que en el mes de prueba de Diciembre 2021, la línea roja representa los datos reales de la base de datos de SACMEX, mientras que el modelo sigue la línea azul del modelo ARIMA(5,1,2), y las líneas verdes representan una banda de ajuste del pronóstico.
Creemos que el resultado es bastante bueno para predecir fallas en el sistema de agua de la Ciudad de México y para saber cuándo podemos esperar un aumento en el número de reportes.
Consideramos de suma importancia seguir analizando estos temas, debido a la crisis hídrica que sufre actualmente la CDMX y que al discutir sobre este, se pone realce a la importancia de llevar a cabo acciones necesarias en el mantenimiento de la red de agua potable, y de esta forma garantizar el adecuado suministro para toda la población del Valle de México.
APP Shiny
Link al Cloud para ver la aplicación Shiny. https://alemora24.shinyapps.io/agua/
Referencias
Limache Sandoval, E. M. (2021). Modelo ARIMA sobre el consumo de agua de uso poblacional en la ciudad de Tacna. REVISTA VERITAS ET SCIENTIA - UPT, 10(1), 69–82. https://doi.org/10.47796/ves.v10i1.461
Datos Abiertos: Consumo de agua. SACMEX https://datos.cdmx.gob.mx/sv/dataset/consumo-agua
Datos Abiertos: Reportes de agua. SACMEX https://datos.cdmx.gob.mx/dataset/reportes-de-agua
Integrantes:
Diego Rosales
Carlos Guerra
Jorge Limas
Pedro García
Alexis Leal
Taryn Galindo