Análisis de la Contribución a la Contaminación Ambiental en Bucaramanga según los Estratos Sociales: Un Estudio Económico
2023-11-22
Proyecto integrador
A pesar de no ser un pensamiento en conjunto, tenemos presente que la contaminación y cómo nuestras acciones influyen en ella es algo que nos concierne y afecta constantemente, desde el desarrollo de las demás personas hasta incluso cómo evolucionarán y verán nuestros hijos en el futuro.
Para esto, se ha decidido evaluar mediante este microproyecto cómo nuestros hábitos tienen una relación con la huella de carbono que tenemos a lo largo de nuestra vida. O al menos una pequeña aproximación.
Volar, para algunos uno de sus mayores anhelos y para otros de sus mayores miedos, no hay punto medio y aunque el ser humano por sí solo no lo pueda hacer, los hermanos Wright lo consiguieron con su maravilloso invento, la aeronave. Pieza de ingeniería clave para el mundo que conocemos hoy en día; sin embargo, a su vez, podría ser pieza clave del fin del mismo, o al menos un gran aporte.
¿Cómo es esto? Sí, aunque no seamos conscientes de esto, sobre nuestros bien portados cuerpos tenemos cientos, incluso miles de aeronaves sobrevolándonos, pero… ¿cómo es esto relevante con la contaminación y aún más importante, con este estudio? Pues se estima que un avión comercial tiene una huella de carbono de 234 kg de CO₂ por pasajero en un vuelo de 2,5 horas, lo cual lo convierte en una máquina de contaminación.
Con esto en mente, se ha decidido implementar este microproyecto por medio de una encuesta en Google Forms, con una muestra tomada de manera aleatoria teniendo en cuenta el ingreso promedio de las personas, clasificándolo por estratos y las horas promedio de vuelo al año. Esto nos acercaría a nuestra meta, que es evaluar la relación existente entre el ingreso de las personas y cuánto contaminan.
Al aplicar la encuesta, la cual posee los siguientes resultados hasta la fecha.
Horas de vuelo
Seguido de esto, se aplicará el modelo designado con la base de datos. Las variables elegidas a criterio experto son ocupación, medio de transporte y cantidad de carros o motos poseídos en casa.
# omitir datos nulos y eliminar columna 1
gus <- gus[ , -c(1)]
# Restricciones
names(gus)## [1] "X.A.que.estrato.social.pertenece."
## [2] "Sexo"
## [3] "X.En.cuál.rango.de.edad.se.encuentra."
## [4] "X.cuál.es.su.ocupación..actual."
## [5] "Indica.el.rango.de.ingresos.de.tu.hogar"
## [6] "X.Cuál.suele.ser.su.medio.de.transporte.del.día.a.día."
## [7] "X.Cuántas.horas.de.vuelo.realiza.en.promedio.al.año."
## [8] "X.Cuántos.carros.hay.en.su.hogar."
## [9] "X.Cuántas.motos.hay.en.su.hogar."
## [10] "X.Apoyas.iniciativas.locales.que.promuevan.una.movilidad.más.sostenible..como.infraestructuras.para.bicicletas..transporte.público.eficiente..etc.."
## [11] "X.Realiza.separación.de.los.disntintos.tipos.de.residuos."
## [12] "X.Tratas.de.reducir.el.uso.de.plásticos.de.un.solo.uso.en.tu.vida.diaria."
## [13] "X.Ha.realizado.alguna.estrategia.para.el.ahorro.energetico.en.su.casa..."
## [14] "X.Ha.realizado.alguna.estrategia.para.el.ahorro.de.agua.en.su.casa..."
## [15] "X.Ha.realizado.alguna.estrategia.para.el.ahorro.de.gas.en.su.casa..."
## [16] "A.la.hora.de.consumir.productos..tiene.en.cuenta.el.sello.ambiental.Colombiano."
## [17] "A.la.hora.de.comprar.productos.electronicos.electrodomesticos..tiene.en.cuenta.las.etiquetas.de.consumo.energético."attach(gus)
colnames(gus)=c("estrato","sexo","edad","t1","t2","t3","t4","t5","t6","t7","t8","t9","t10","t11","t12","t13","t14")
###
attach(gus)
sat=lm(t4~edad+sexo+estrato+t1+t3+t5+t6, data=gus)
summary(sat)##
## Call:
## lm(formula = t4 ~ edad + sexo + estrato + t1 + t3 + t5 + t6,
## data = gus)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6.270 -2.799 -1.242 2.610 16.210
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -9.4024 4.9271 -1.908 0.0613 .
## edad25 - 35 años 0.3988 2.4900 0.160 0.8733
## edad35 - 45 años 1.1033 2.5410 0.434 0.6658
## edadMás de 45 años 2.6997 3.1200 0.865 0.3904
## sexoMasculino 0.6453 1.4056 0.459 0.6479
## estrato 3.0506 0.6499 4.694 1.68e-05 ***
## t1Empleado 4.9801 3.5337 1.409 0.1641
## t1Estudiante 3.7840 4.2822 0.884 0.3805
## t1Independiente 5.8990 3.5663 1.654 0.1035
## t3Carro -1.9237 2.7863 -0.690 0.4927
## t3Moto -3.5609 2.5013 -1.424 0.1599
## t3Otro -0.9789 3.0120 -0.325 0.7464
## t3Transporte público -3.1430 2.5088 -1.253 0.2153
## t5 1.7968 0.9027 1.991 0.0512 .
## t6 1.1015 0.8923 1.234 0.2220
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.873 on 58 degrees of freedom
## Multiple R-squared: 0.4814, Adjusted R-squared: 0.3562
## F-statistic: 3.845 on 14 and 58 DF, p-value: 0.0001368Limpieza de residuos
Para este proceso, fueron utilizados los métodos representativos y gráficos para mayor facilidad y comprensión. Se obtuvieron los siguientes resultados.
######### codigo residuales
residuals(sat)## 1 2 3 4 5 6 7
## -2.4562622 -1.9316557 -1.9043710 -2.3512819 3.5341122 -4.0188262 0.7863212
## 8 9 10 11 12 13 14
## -2.2834980 1.8088444 -3.4411806 4.3381637 -2.3341564 5.3119346 -0.5581690
## 15 16 17 18 19 20 21
## -5.2034217 0.8886320 1.5343894 -2.1027503 -2.3341564 -2.2968856 -4.4182450
## 22 23 24 25 26 27 28
## 3.0273155 2.6094667 -1.8330894 -4.1788313 0.8749973 -3.4658878 1.9352167
## 29 30 31 32 33 34 35
## 4.2805409 3.9107512 -0.2381676 0.9133393 4.2601940 -0.9681790 -4.7874307
## 36 37 38 39 40 41 42
## 0.7785956 3.2803527 -3.6561529 -3.9841309 -0.8834595 -3.6661250 9.7362663
## 43 44 45 46 47 48 49
## -2.5167233 7.2350223 -4.4653748 -6.2700267 8.6595385 -2.7991548 -4.7701063
## 50 51 52 53 54 55 56
## -1.2418028 -2.2296668 -2.2243500 -1.0741672 1.6854308 3.6487181 16.2100478
## 57 58 59 60 61 62 63
## 3.4322054 -2.7698705 0.2297054 -4.6165879 2.0667522 -2.4158637 -3.9472021
## 64 65 66 67 68 69 70
## 2.7277602 7.1510982 -4.2334738 13.1985872 -0.6815826 -5.2803140 -1.5646423
## 71 72 73
## -1.9633083 -4.5617765 4.8680089gus$error=residuals(sat)
sat$fitted.values## 1 2 3 4 5 6 7
## 8.4562622 4.9316557 2.9043710 6.3512819 4.4658878 4.0188262 -0.7863212
## 8 9 10 11 12 13 14
## 6.2834980 -1.8088444 3.4411806 13.6618363 2.3341564 -5.3119346 0.5581690
## 15 16 17 18 19 20 21
## 5.2034217 0.1113680 0.4656106 2.1027503 2.3341564 2.2968856 6.4182450
## 22 23 24 25 26 27 28
## -0.0273155 0.3905333 1.8330894 4.1788313 -0.8749973 4.4658878 18.0647833
## 29 30 31 32 33 34 35
## 1.7194591 6.0892488 0.2381676 -0.9133393 -4.2601940 0.9681790 4.7874307
## 36 37 38 39 40 41 42
## -0.7785956 -3.2803527 3.6561529 3.9841309 0.8834595 3.6661250 0.2637337
## 43 44 45 46 47 48 49
## 2.5167233 2.7649777 4.4653748 6.2700267 -0.6595385 4.7991548 4.7701063
## 50 51 52 53 54 55 56
## 1.2418028 2.2296668 5.2243500 1.0741672 -1.6854308 6.3512819 19.7899522
## 57 58 59 60 61 62 63
## -3.4322054 8.7698705 -0.2297054 4.6165879 4.9332478 4.4158637 3.9472021
## 64 65 66 67 68 69 70
## -2.7277602 0.8489018 6.2334738 6.8014128 0.6815826 5.2803140 2.5646423
## 71 72 73
## 1.9633083 4.5617765 5.1319911gus$t4## [1] 6 3 1 4 8 0 0 4 0 0 18 0 0 0 0 1 2 0 0 0 2 3 3 0 0
## [26] 0 1 20 6 10 0 0 0 0 0 0 0 0 0 0 0 10 0 10 0 0 8 2 0 0
## [51] 0 3 0 0 10 36 0 6 0 0 7 2 0 0 8 2 20 0 0 1 0 0 10res=data.frame(gus$t4,sat$fitted.values)
##
#valores atipicos
at=boxplot(gus$error)
at$out## [1] 16.21005 13.19859##autocorrelacion
gus$tiempo=seq(1:73)
plot(gus$tiempo,gus$error)
###Prueba de Durbin Whatson
library(lmtest)## Warning: package 'lmtest' was built under R version 4.2.3## Loading required package: zoo## Warning: package 'zoo' was built under R version 4.2.3##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
dwtest(sat)##
## Durbin-Watson test
##
## data: sat
## DW = 2.1843, p-value = 0.7909
## alternative hypothesis: true autocorrelation is greater than 0### si el pvalue es menor a 0.05 se podra decir
## que si existe autocorrelacion de primer orden
#para este caso el p valor es de 0.79, por lo tanto no existeEn el anterior apartado se representaron los valores atipicos y a su vez se realizo la prueba del estadistico durbin whatson, en esta prueba Imagínate que estás en una cocina y estás tratando de averiguar si la cantidad de ingredientes que usas en una receta afecta el tiempo de cocción de tu plato favorito. Ahora, la prueba de Durbin-Watson es como ese amigo observador que está mirando tu proceso desde la esquina.
El se centra en examinar si hay algún patrón en los errores que cometes al medir tus ingredientes. Si, por ejemplo, tiendes a cometer errores similares en la cantidad de sal cada vez que cocinas, la prueba lo detectaría. Lo que realmente está haciendo es ver si hay alguna relación o correlación en esos errores.
Entonces, en el mundo de la cocina estadística, la prueba de Durbin-Watson te ayuda a descubrir si hay algún patrón sistemático en los errores que cometes al medir tus ingredientes, lo que podría afectar la calidad final de tu plato.
Heterocedasticidad
Posteriormente fue usada la prueba de bresuch pagan para realizar la medicion de la heterocedasticidad del modelo, como es representado
###Heteroscedasticidad
#
plot(gus$error,gus$t4)
###Heteroscedasticidad
plot(gus$error,gus$t5)
###Heteroscedasticidad
plot(gus$error,gus$t6)
###Heteroscedasticidad
plot(gus$error,gus$t9)
###Heteroscedasticidad
plot(gus$error,gus$t10)
###Heteroscedasticidad
plot(gus$error,gus$t11)
###Heteroscedasticidad
plot(gus$error,gus$t12)
### test de BRESUH- PAGAN
library(lmtest)
bptest(sat)##
## studentized Breusch-Pagan test
##
## data: sat
## BP = 20.458, df = 14, p-value = 0.1164#p-value = 0.004789< 0.05 --- heterocedasticidad
## obtenemos un pvalue de 0.116 (no existe heterocedasticidad)para esta prueba Imagina que estás grabando una canción y estás interesado en saber si la variabilidad en el volumen de la guitarra afecta la calidad general de la grabación.
Entra en escena la prueba de Breusch-Pagan, tu “ingeniero de sonido” estadístico. Lo que hace esta prueba es evaluar si la variabilidad en el volumen de la guitarra (o en términos más técnicos, los errores) sigue algún patrón o si es completamente aleatoria.
Entonces, si descubre que hay un patrón en cómo la variabilidad cambia a lo largo de la grabación, te alertará sobre la heterocedasticidad. En términos sencillos, está tratando de ver si la variabilidad en el volumen de la guitarra sigue una especie de ritmo o si es caótica.
Esta prueba ayuda a identificar si hay algún tipo de patrón en la variabilidad de los errores en tu regresión lineal. Así, al igual que en la música, asegura que la “armonía” entre tus variables sea lo más suave posible.
Multicolinealidad
Para la multicolinealidad se examino la correlacion entre las variables predictoras de la siguiete manera
##multicolinealidad
car::vif (sat)## GVIF Df GVIF^(1/(2*Df))
## edad 6.489495 3 1.365741
## sexo 1.504601 1 1.226622
## estrato 1.283760 1 1.133031
## t1 6.074514 3 1.350782
## t3 2.887875 4 1.141753
## t5 1.476134 1 1.214963
## t6 1.877894 1 1.370363### se deben buscar variables con valores entre 5-10
## en el resultado vemos que la variable "edad" tiene un valor de 6
#presentando un posible problema de multicolinealidad en cuyo casso deberia ser eliminada
#######Para su mejor esxplicacion regresemos a
la cocina, pero esta vez estás preparando un plato especial con varios ingredientes. Supongamos que estás usando harina, levadura y agua para hacer la masa de tu receta. Ahora, imagina que alguien te dice que estos ingredientes están tan interconectados que es difícil saber cuál está contribuyendo más al sabor final del plato. Esto es llamado multicolinealidad. Es como tener ingredientes en tu receta que están tan fuertemente relacionados entre sí que se vuelven difíciles de distinguir individualmente.
Digamos que en tu regresión lineal estás utilizando dos variables, como la cantidad de harina y la cantidad de levadura. Si estas dos variables están tan estrechamente relacionadas que es difícil decir cuál está afectando más al resultado final (digamos, la textura de tu plato), entonces estás enfrentando multicolinealidad.
Mejoras del modelo
Como ultimo se decidio realizar un proceso de mejora del modelo por medio del STEP AIC como se mostrara posteriormente
#mejorar modelo
##
library(MASS)## Warning: package 'MASS' was built under R version 4.2.3stepAIC(sat,scale = 0,
direction = c("both"),
trace = 1, keep = NULL, steps = 1000, use.start = FALSE,
k = 2,)## Start: AIC=244.42
## t4 ~ edad + sexo + estrato + t1 + t3 + t5 + t6
##
## Df Sum of Sq RSS AIC
## - edad 3 23.63 1400.7 239.66
## - t3 4 62.74 1439.8 239.67
## - t1 3 80.05 1457.1 242.54
## - sexo 1 5.00 1382.1 242.68
## - t6 1 36.18 1413.2 244.31
## <none> 1377.1 244.42
## - t5 1 94.08 1471.1 247.24
## - estrato 1 523.15 1900.2 265.93
##
## Step: AIC=239.66
## t4 ~ sexo + estrato + t1 + t3 + t5 + t6
##
## Df Sum of Sq RSS AIC
## - t3 4 60.28 1461.0 234.74
## - sexo 1 12.79 1413.5 238.32
## - t6 1 26.94 1427.6 239.05
## - t1 3 113.48 1514.2 239.35
## <none> 1400.7 239.66
## - t5 1 97.97 1498.7 242.60
## + edad 3 23.63 1377.1 244.42
## - estrato 1 588.09 1988.8 263.25
##
## Step: AIC=234.74
## t4 ~ sexo + estrato + t1 + t5 + t6
##
## Df Sum of Sq RSS AIC
## - t1 3 91.59 1552.5 233.18
## - t6 1 10.20 1471.2 233.25
## <none> 1461.0 234.74
## - sexo 1 53.81 1514.8 235.38
## - t5 1 143.81 1604.8 239.59
## + t3 4 60.28 1400.7 239.66
## + edad 3 21.17 1439.8 239.67
## - estrato 1 658.91 2119.9 259.91
##
## Step: AIC=233.18
## t4 ~ sexo + estrato + t5 + t6
##
## Df Sum of Sq RSS AIC
## - t6 1 2.33 1554.9 231.28
## <none> 1552.5 233.18
## - sexo 1 53.29 1605.8 233.64
## + t1 3 91.59 1461.0 234.74
## + edad 3 50.70 1501.8 236.75
## - t5 1 155.15 1707.7 238.13
## + t3 4 38.39 1514.2 239.35
## - estrato 1 663.84 2216.4 257.16
##
## Step: AIC=231.28
## t4 ~ sexo + estrato + t5
##
## Df Sum of Sq RSS AIC
## <none> 1554.9 231.28
## - sexo 1 62.09 1617.0 232.14
## + t6 1 2.33 1552.5 233.18
## + t1 3 83.72 1471.2 233.25
## + edad 3 42.92 1512.0 235.24
## - t5 1 166.89 1721.8 236.73
## + t3 4 35.03 1519.8 237.62
## - estrato 1 698.19 2253.1 256.36##
## Call:
## lm(formula = t4 ~ sexo + estrato + t5, data = gus)
##
## Coefficients:
## (Intercept) sexoMasculino estrato t5
## -7.099 1.863 3.209 2.022regp= lm(formula = t4~edad+sexo+estrato+t1+t3+t4+t5+t6, data=gus)## Warning in model.matrix.default(mt, mf, contrasts): the response appeared on
## the right-hand side and was dropped## Warning in model.matrix.default(mt, mf, contrasts): problem with term 6 in
## model.matrix: no columns are assignedsummary(regp) ##
## Call:
## lm(formula = t4 ~ edad + sexo + estrato + t1 + t3 + t4 + t5 +
## t6, data = gus)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6.270 -2.799 -1.242 2.610 16.210
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -9.4024 4.9271 -1.908 0.0613 .
## edad25 - 35 años 0.3988 2.4900 0.160 0.8733
## edad35 - 45 años 1.1033 2.5410 0.434 0.6658
## edadMás de 45 años 2.6997 3.1200 0.865 0.3904
## sexoMasculino 0.6453 1.4056 0.459 0.6479
## estrato 3.0506 0.6499 4.694 1.68e-05 ***
## t1Empleado 4.9801 3.5337 1.409 0.1641
## t1Estudiante 3.7840 4.2822 0.884 0.3805
## t1Independiente 5.8990 3.5663 1.654 0.1035
## t3Carro -1.9237 2.7863 -0.690 0.4927
## t3Moto -3.5609 2.5013 -1.424 0.1599
## t3Otro -0.9789 3.0120 -0.325 0.7464
## t3Transporte público -3.1430 2.5088 -1.253 0.2153
## t5 1.7968 0.9027 1.991 0.0512 .
## t6 1.1015 0.8923 1.234 0.2220
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.873 on 58 degrees of freedom
## Multiple R-squared: 0.4814, Adjusted R-squared: 0.3562
## F-statistic: 3.845 on 14 and 58 DF, p-value: 0.0001368obteniendo que el mejor modelo tiene en cuenta solo el sexo, el estrato y la cantidad de automoviles en su posesion.
imagina que estás organizando una fiesta y tienes varias opciones para invitar a tus amigos. Sin embargo, no quieres invitar a todos porque tienes espacio limitado en tu casa y quieres asegurarte de que sea una buena fiesta.
El paso AIC en R es como tu asistente de fiesta que te ayuda a tomar decisiones inteligentes sobre a quién invitar. AIC significa “Criterio de Información de Akaike”, pero no te preocupes por el nombre. Lo importante es que el paso AIC te ayuda a seleccionar las “variables invitadas” más importantes para tu fiesta.
En lugar de invitar a todas las variables posibles (amigos), el paso AIC sugiere invitar solo a las que realmente aportan algo especial a tu modelo estadístico. En términos sencillos, trata de encontrar el equilibrio perfecto entre un buen modelo predictivo y no invitar a demasiadas variables innecesarias.
Así que, al igual que eliges cuidadosamente a quién invitar a tu fiesta para que sea un éxito, el paso AIC en R te ayuda a elegir las variables adecuadas para que tu modelo estadístico sea más eficiente y preciso.
Conclusiones
Por ultimo, fueron seleccionadas las variables que influían sobre otras, que como mencionamos anteriormente fueron:
cantidad de automoviles presentes en la vivienda, estrato y sexo.
Aplicando estadística y ajustes econométricos se obtuvieron resultados interesantes. Cifras tales como que en promedio la gente tiene -9 horas de vuelo anuales, ya que es imposible regalar horas de vuelo, nos permite concluir que en promedio los encuestados no tienen una numerosa cantidad de horas de vuelo y por tanto no presentan una gran contaminación al ambiente, a su vez, al comparar las variables obtenemos que la que más relevancia posee es la de el estrato, afectando directamente los horarios de vuelo promedio de las personas teniendo en promedio 3 vuelos anuales. A su vez se observa que en comparación con el individuo desempleado el empleado, estudiante e independiente tienen más posibilidades de tener horas de vuelo anuales, siendo el independiente el que en promedio se predice que tendría más, con un total de 5.8 horas anuales más que un desempleado. Seguido de esto se obtuvo que, en promedio las personas con medio de transporte propio comparado con el medio de transporte bicicleta tienen menos horas de vuelo, siendo el poseedor de moto, el que menos horas de vuelo posee en promedio según el modelo con un valor de -3,5. A su vez podemos observar que, a mayor número de carros o motos presentes en casa, mayor número de horas de vuelo y por lo tanto contaminación, se espera.
Sin embargo, el modelo no es perfecto y se observó que, a la hora de evaluar las variables, las que más convendrían serian el sexo, estrato y cuantos carros posee en su propiedad.