Calidad_Ecosistema

Desgloce de variables

Calidad del Suelo:

• SPH: pH del Suelo
• NC: Contenido de Nutrientes
• OM: Materia Orgánica

Calidad del Agua:

• CL: Niveles de Contaminantes
• DO: Oxígeno Disuelto
• WPH: pH del Agua

Salud del Ecosistema

• SD: Diversidad de Especies
• BM: Biomasa
• EP: Productividad del Ecosistema

Herramientas para la creación de Modelos

Llamar librerías

library(tidyverse)
library(gplots)
library(plm)
library(forecast)
library(lavaan)
library(lavaanPlot)
library(DataExplorer)
library(readxl)
#install.packages("devtools")
#devtools::install_github("diegovalle/mxmaps")
#1
library(mxmaps)
library(remotes)
#install.packages("sf")
library(sf)

Carga bases de datos

dfeco <- read.csv("C:\\Users\\aleja\\Documents\\00_Carrera_y_formación\\00_TEC_Por semestre_LIT\\SEMESTRE_8\\Bases_de_Datos\\ecosistema.csv")
head(dfeco)

##         SD       BM       EP      SPH        NC       OM      WPH       DO
## 1 39.14369 228.1324 376.7045 7.070328  97.57666 4.251173 7.333511 8.987428
## 2 59.97345 176.0758 273.5043 6.105917  59.82829 5.567595 7.054287 8.277449
## 3 52.82978 288.0281 275.4514 6.632617  81.58707 5.718151 7.399840 8.761089
## 4 34.93705 227.5319 234.5417 6.313864 103.36469 4.000619 7.296678 8.443330
## 5 44.21400 199.7477 299.5670 7.087300  73.60217 5.474898 6.814909 8.645304
## 6 66.51437 191.7335 348.8406 6.650423 125.32859 3.131500 6.643934 7.957347
##         CL
## 1 1.725791
## 2 2.532691
## 3 1.738039
## 4 2.272994
## 5 1.717060
## 6 2.171582

dfhog <- read_excel("C:\\Users\\aleja\\Documents\\00_Carrera_y_formación\\00_TEC_Por semestre_LIT\\SEMESTRE_8\\Bases_de_Datos\\hogares.xlsx")
head(dfhog)

## # A tibble: 6 × 7
##   HogarID   Año Miembros Ingreso  Gasto Ahorro Satisfacción
##     <dbl> <dbl>    <dbl>   <dbl>  <dbl>  <dbl>        <dbl>
## 1       1  2010        2  41373. 23949. 17424.         5.54
## 2       1  2011        2  49362. 25511. 23851.         6.46
## 3       1  2012        2  34228. 24558.  9669.         5.48
## 4       1  2013        2  39475. 26494. 12981.         6.42
## 5       1  2014        2  45966. 30411. 15555.         4.12
## 6       1  2015        2  41671. 25042. 16629.         6.50

dfpop <- read.csv("C:\\Users\\aleja\\Documents\\00_Carrera_y_formación\\00_TEC_Por semestre_LIT\\SEMESTRE_8\\Bases_de_Datos\\population.csv")
head(dfpop)

##   state year population
## 1    AK 1950     135000
## 2    AK 1951     158000
## 3    AK 1952     189000
## 4    AK 1953     205000
## 5    AK 1954     215000
## 6    AK 1955     222000

dfmaps <- df_mxstate_2020

df_mxstate_2020$value <-dfmaps$pop #Reemplazar aquí con tus valores 

mxstate_choropleth(df_mxstate_2020)

Tema 1. Datos Panel: Nivel de felicidad por ingresos

Generar conjunto de Datos de Panel

panel_1 <- pdata.frame(dfhog, index = c("HogarID", "Año"))
plotmeans(Ingreso ~ HogarID, main= "Prueba de Heterogeneidad entre hogares para el Ingreso", data = panel_1)

Modelo 1. Regresión Agrupada (pooled)

pooled <- plm(Ingreso ~ Satisfacción, data= panel_1, model = "pooling")
summary(pooled)

## Pooling Model
## 
## Call:
## plm(formula = Ingreso ~ Satisfacción, data = panel_1, model = "pooling")
## 
## Balanced Panel: n = 100, T = 10, N = 1000
## 
## Residuals:
##      Min.   1st Qu.    Median   3rd Qu.      Max. 
## -20196.53  -5106.46   -575.98   5095.02  23468.66 
## 
## Coefficients:
##              Estimate Std. Error t-value  Pr(>|t|)    
## (Intercept)  10597.75     976.80  10.850 < 2.2e-16 ***
## Satisfacción  2890.77     166.68  17.343 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    6.8145e+10
## Residual Sum of Squares: 5.2364e+10
## R-Squared:      0.23158
## Adj. R-Squared: 0.23081
## F-statistic: 300.772 on 1 and 998 DF, p-value: < 2.22e-16

Modelo 2. Efectos Fijos (Within)

within <- plm(Ingreso ~ Satisfacción, data=panel_1, model = "within")
summary(within)

## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = Ingreso ~ Satisfacción, data = panel_1, model = "within")
## 
## Balanced Panel: n = 100, T = 10, N = 1000
## 
## Residuals:
##       Min.    1st Qu.     Median    3rd Qu.       Max. 
## -15591.951  -3123.123    -74.284   3010.168  13134.979 
## 
## Coefficients:
##              Estimate Std. Error t-value  Pr(>|t|)    
## Satisfacción  1698.14     132.73  12.794 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    2.3013e+10
## Residual Sum of Squares: 1.9469e+10
## R-Squared:      0.15403
## Adj. R-Squared: 0.05993
## F-statistic: 163.687 on 1 and 899 DF, p-value: < 2.22e-16

Modelo Pooled vs Modelo Within Efectos fijos

{r}+ pFtest(within, pooled)

Modelo 3. Efectos Aleatorios(random)- Walhus

walhus <- plm(Ingreso ~ Satisfacción, data=panel_1, model = "random", random.method = "walhus")
summary(walhus)

## Oneway (individual) effect Random Effect Model 
##    (Wallace-Hussain's transformation)
## 
## Call:
## plm(formula = Ingreso ~ Satisfacción, data = panel_1, model = "random", 
##     random.method = "walhus")
## 
## Balanced Panel: n = 100, T = 10, N = 1000
## 
## Effects:
##                    var  std.dev share
## idiosyncratic 23574420     4855  0.45
## individual    28789336     5366  0.55
## theta: 0.7249
## 
## Residuals:
##      Min.   1st Qu.    Median   3rd Qu.      Max. 
## -16507.33  -3220.23   -147.96   3184.91  15215.46 
## 
## Coefficients:
##              Estimate Std. Error z-value  Pr(>|z|)    
## (Intercept)  16632.69     925.15  17.978 < 2.2e-16 ***
## Satisfacción  1831.41     131.69  13.907 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    2.6429e+10
## Residual Sum of Squares: 2.2139e+10
## R-Squared:      0.16233
## Adj. R-Squared: 0.16149
## Chisq: 193.404 on 1 DF, p-value: < 2.22e-16

Modelo 3. Efectos Aleatorios(random)- Amemiya

amemiya <- plm(Ingreso ~ Satisfacción, data=panel_1, model = "random", random.method = "amemiya")
summary(amemiya)

## Oneway (individual) effect Random Effect Model 
##    (Amemiya's transformation)
## 
## Call:
## plm(formula = Ingreso ~ Satisfacción, data = panel_1, model = "random", 
##     random.method = "amemiya")
## 
## Balanced Panel: n = 100, T = 10, N = 1000
## 
## Effects:
##                    var  std.dev share
## idiosyncratic 21631698     4651 0.393
## individual    33418160     5781 0.607
## theta: 0.7534
## 
## Residuals:
##      Min.   1st Qu.    Median   3rd Qu.      Max. 
## -16370.54  -3188.47   -210.78   3188.52  14905.18 
## 
## Coefficients:
##              Estimate Std. Error z-value  Pr(>|z|)    
## (Intercept)  16777.35     953.98  17.587 < 2.2e-16 ***
## Satisfacción  1806.01     130.63  13.825 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    2.5757e+10
## Residual Sum of Squares: 2.1617e+10
## R-Squared:      0.16074
## Adj. R-Squared: 0.1599
## Chisq: 191.14 on 1 DF, p-value: < 2.22e-16

Modelo 3. Efectos Aleatorios(random)- Nerlove

nerlove <- plm(Ingreso ~ Satisfacción, data=panel_1, model = "random", random.method = "nerlove")
summary(nerlove)

## Oneway (individual) effect Random Effect Model 
##    (Nerlove's transformation)
## 
## Call:
## plm(formula = Ingreso ~ Satisfacción, data = panel_1, model = "random", 
##     random.method = "nerlove")
## 
## Balanced Panel: n = 100, T = 10, N = 1000
## 
## Effects:
##                    var  std.dev share
## idiosyncratic 19468528     4412 0.351
## individual    35940737     5995 0.649
## theta: 0.7733
## 
## Residuals:
##      Min.   1st Qu.    Median   3rd Qu.      Max. 
## -16275.51  -3113.76   -212.49   3188.29  14690.19 
## 
## Coefficients:
##              Estimate Std. Error z-value  Pr(>|z|)    
## (Intercept)  16869.92     981.37  17.190 < 2.2e-16 ***
## Satisfacción  1789.76     129.95  13.773 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    2.5332e+10
## Residual Sum of Squares: 2.1286e+10
## R-Squared:      0.15972
## Adj. R-Squared: 0.15888
## Chisq: 189.701 on 1 DF, p-value: < 2.22e-16

Modelo de Efectos Fijos vs. Modelo de Efectos Aleatorios

phtest(walhus,within)

## 
##  Hausman Test
## 
## data:  Ingreso ~ Satisfacción
## chisq = 64.632, df = 1, p-value = 9.03e-16
## alternative hypothesis: one model is inconsistent

# Si el p-value es < 0.05, usamos Efectos Fijos (Within)

#Por lo tanto, nos quedamos con el Modelo de Efectos Fijos

Tema 2. Series de Tiempo: Mapas

Serie de Tiempo

df4 <- dfpop %>% filter(state == "TX")
ts <- ts(df4$population, start = 1900, frequency = 1) #Serie de Tiempo Anual
arima <- auto.arima(ts)
arima

## Series: ts 
## ARIMA(0,2,2) 
## 
## Coefficients:
##           ma1      ma2
##       -0.5950  -0.1798
## s.e.   0.0913   0.0951
## 
## sigma^2 = 1.031e+10:  log likelihood = -1527.14
## AIC=3060.28   AICc=3060.5   BIC=3068.6

pronostico <- forecast(arima, level = c(95), h=31)
pronostico

##      Point Forecast    Lo 95    Hi 95
## 2020       29398472 29199487 29597457
## 2021       29806827 29463665 30149990
## 2022       30215183 29742956 30687410
## 2023       30623538 30024100 31222977
## 2024       31031894 30303359 31760429
## 2025       31440249 30579246 32301253
## 2026       31848605 30851090 32846119
## 2027       32256960 31118581 33395339
## 2028       32665316 31381587 33949044
## 2029       33073671 31640070 34507272
## 2030       33482027 31894047 35070007
## 2031       33890382 32143561 35637204
## 2032       34298738 32388674 36208801
## 2033       34707093 32629456 36784730
## 2034       35115449 32865983 37364914
## 2035       35523804 33098330 37949278
## 2036       35932160 33326573 38537746
## 2037       36340515 33550788 39130242
## 2038       36748871 33771046 39726695
## 2039       37157226 33987418 40327034
## 2040       37565581 34199972 40931191
## 2041       37973937 34408774 41539100
## 2042       38382292 34613887 42150698
## 2043       38790648 34815371 42765925
## 2044       39199003 35013284 43384723
## 2045       39607359 35207682 44007036
## 2046       40015714 35398618 44632810
## 2047       40424070 35586145 45261995
## 2048       40832425 35770311 45894540
## 2049       41240781 35951163 46530399
## 2050       41649136 36128748 47169524

plot(pronostico, main= "Población en Texas desde 1900 a 2050")

Tema 3. Modelos de Ecuaciones Estructurales: Ecosistemas

Generar Modelo

modelo <- ' # Regresiones
            #Variables Latentes
            Suelo =~ SPH + NC + OM
            Agua =~ CL + DO + WPH
            Eco =~ SD + BM + EP
            #Varianzas y covarianzas
            #Intercepto
            '

Generación de Grafico

dfeco1 <- scale(dfeco)
dfeco2 <- cfa(modelo, dfeco1)

## Warning: lavaan->lav_object_post_check():  
##    covariance matrix of latent variables is not positive definite ; use 
##    lavInspect(fit, "cov.lv") to investigate.

summary(dfeco2)

## lavaan 0.6-19 ended normally after 97 iterations
## 
##   Estimator                                         ML
##   Optimization method                           NLMINB
##   Number of model parameters                        21
## 
##   Number of observations                           200
## 
## Model Test User Model:
##                                                       
##   Test statistic                                17.149
##   Degrees of freedom                                24
##   P-value (Chi-square)                           0.842
## 
## Parameter Estimates:
## 
##   Standard errors                             Standard
##   Information                                 Expected
##   Information saturated (h1) model          Structured
## 
## Latent Variables:
##                    Estimate  Std.Err  z-value  P(>|z|)
##   Suelo =~                                            
##     SPH               1.000                           
##     NC                2.217    1.332    1.664    0.096
##     OM                0.167    0.402    0.414    0.679
##   Agua =~                                             
##     CL                1.000                           
##     DO               -0.827    0.427   -1.936    0.053
##     WPH               0.404    0.359    1.124    0.261
##   Eco =~                                              
##     SD                1.000                           
##     BM               -1.899    3.995   -0.475    0.634
##     EP               -4.224    8.093   -0.522    0.602
## 
## Covariances:
##                    Estimate  Std.Err  z-value  P(>|z|)
##   Suelo ~~                                            
##     Agua             -0.079    0.051   -1.558    0.119
##     Eco              -0.010    0.020   -0.497    0.619
##   Agua ~~                                             
##     Eco              -0.018    0.034   -0.513    0.608
## 
## Variances:
##                    Estimate  Std.Err  z-value  P(>|z|)
##    .SPH               0.926    0.103    9.016    0.000
##    .NC                0.657    0.226    2.906    0.004
##    .OM                0.993    0.100    9.978    0.000
##    .CL                0.953    0.118    8.086    0.000
##    .DO                0.966    0.108    8.977    0.000
##    .WPH               0.988    0.099    9.938    0.000
##    .SD                0.992    0.100    9.954    0.000
##    .BM                0.985    0.102    9.618    0.000
##    .EP                0.948    0.166    5.720    0.000
##     Suelo             0.069    0.057    1.197    0.231
##     Agua              0.042    0.075    0.558    0.577
##     Eco               0.003    0.012    0.221    0.825

lavaanPlot(dfeco2, coef=TRUE, cov=TRUE)