Actividad Integradora 2

Contexto

Calidad del Suelo: o SPH: pH del Suelo o NC: Contenido de Nutrientes o OM: Materia Orgánica • Calidad del Agua: o CL: Niveles de Contaminantes o DO: Oxígeno Disuelto o WPH: pH del Agua • Salud del Ecosistema o SD: Diversidad de Especies o BM: Biomasa o EP: Productividad del Ecosistema

Fuente Parte 1: “C:\Users\serva\Downloads\hogares.xlsx” Fuente parte 2: “C:\Users\serva\Downloads\population.csv” Fuente Parte 3:“C:\Users\serva\Downloads\ecosistema.csv”

Instalar paquetes y llamar libreriras

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

Tema 1. Datos de panel: Hogares

Importar la base de datos

dfP1 <- read_excel("C:/Users/serva/Downloads/hogares.xlsx")

# 2) Renombrar la columna 'Año' -> 'Anio' sin usar la ñ (soporta A�o / Año / Año)
names(dfP1)[grepl("^A.{1,2}o$", names(dfP1))] <- "Anio"

# (Opcional) Verifica cómo quedaron los nombres
print(names(dfP1))

## [1] "HogarID"      "Anio"         "Miembros"     "Ingreso"      "Gasto"       
## [6] "Ahorro"       "Satisfacción"

# 3) Tipos
dfP1$HogarID <- as.integer(dfP1$HogarID)
dfP1$Anio    <- as.integer(dfP1$Anio)

# 4) Crear el panel
panel1 <- pdata.frame(dfP1, index = c("HogarID", "Anio"))

Revisar Heterogeneidad

plotmeans(Ingreso ~ HogarID, main = "Heterogeneidad entre hogares para el ingreso", data = panel1)

## Modelo 1, Renombrar “Satisfacción” sin Tilde por problemas de tipo de archivo

# (1) Renombrar 'Satisfacción' -> 'Satisfaccion' SIN tilde
col_sat <- grep("^Satisf", names(dfP1), ignore.case = TRUE, value = TRUE)
stopifnot(length(col_sat) == 1)
names(dfP1)[names(dfP1) == col_sat] <- "Satisfaccion"
names(dfP1)  # debe mostrar 'Satisfaccion'

## [1] "HogarID"      "Anio"         "Miembros"     "Ingreso"      "Gasto"       
## [6] "Ahorro"       "Satisfaccion"

Modelo 1. Recrear el panel DESPUÉS del rename

panel1 <- pdata.frame(dfP1, index = c("HogarID","Anio"))

# Comprobación: ¿existe Satisfaccion en panel1?
names(panel1)

## [1] "HogarID"      "Anio"         "Miembros"     "Ingreso"      "Gasto"       
## [6] "Ahorro"       "Satisfaccion"

grep("^Satisf", names(panel1), value = TRUE)

## [1] "Satisfaccion"

stopifnot("Satisfaccion" %in% names(panel1))

Modelo 1, Regresión agrupada

pooled <- plm(Ingreso ~ Satisfaccion, data = panel1, model = "pooling")
summary(pooled)

## Pooling Model
## 
## Call:
## plm(formula = Ingreso ~ Satisfaccion, data = panel1, 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 ***
## Satisfaccion  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 (whitin)

within <- plm(Ingreso ~ Satisfaccion , data = panel1, model = "within")
summary(within)

## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = Ingreso ~ Satisfaccion, data = panel1, 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|)    
## Satisfaccion  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 de efectos fijos

pFtest(within, pooled)

## 
##  F test for individual effects
## 
## data:  Ingreso ~ Satisfaccion
## F = 15.343, df1 = 99, df2 = 899, p-value < 2.2e-16
## alternative hypothesis: significant effects

Modelo 3. Efectos Aleatorios (random) - metodo walhus

walhus <- plm(Ingreso ~ Satisfaccion, data = panel1, model = "random", random.method = "walhus")
summary(walhus)

## Oneway (individual) effect Random Effect Model 
##    (Wallace-Hussain's transformation)
## 
## Call:
## plm(formula = Ingreso ~ Satisfaccion, data = panel1, 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 ***
## Satisfaccion  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) - metodo amemiya

amemiya <- plm(Ingreso ~ Satisfaccion, data = panel1, model = "random", random.method = "amemiya")
summary(amemiya)

## Oneway (individual) effect Random Effect Model 
##    (Amemiya's transformation)
## 
## Call:
## plm(formula = Ingreso ~ Satisfaccion, data = panel1, 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 ***
## Satisfaccion  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) - metodo nerlove

nerlove <- plm(Ingreso ~ Satisfaccion, data = panel1, model = "random", random.method = "nerlove")
summary(nerlove)

## Oneway (individual) effect Random Effect Model 
##    (Nerlove's transformation)
## 
## Call:
## plm(formula = Ingreso ~ Satisfaccion, data = panel1, 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 ***
## Satisfaccion  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 ~ Satisfaccion
## chisq = 64.632, df = 1, p-value = 9.03e-16
## alternative hypothesis: one model is inconsistent

Si es pvalue es <0.05 usamos efecctos fijos.

Por lo tanto nos quedamos con el modelo de efectos fijos

Tema 2. Series de Tiempo: Mapas

Generar Serie de Tiempo y mapa

dfP2 <- df_mxstate_2020

df_mxstate_2020$value <- dfP2$pop
mxstate_choropleth(df_mxstate_2020)

Importar base de datos

dfP3 <- read.csv("C:\\Users\\serva\\Downloads\\population.csv")

Generar serie de tiempo: TX

dfP3_1 <- dfP3 %>% filter(state == "TX")
ts <- ts (dfP3_1$population, start= 1900, frequency = 1)

Generar el modelo ARIMA

arima <- auto.arima(ts)
summary(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
## 
## Training set error measures:
##                    ME     RMSE      MAE       MPE      MAPE      MASE
## Training set 12147.62 99818.31 59257.39 0.1046163 0.5686743 0.2672197
##                     ACF1
## Training set -0.02136734

Generar el Pronostico

pronostico <- forecast(arima, level= 95, h = 5)
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

plot(pronostico, main = "Poblacion Texas")

Tema 3, Modelos de ecuaciones estructurales

Importar la base de datos

dfP3 <- read.csv("C:\\Users\\serva\\Downloads\\ecosistema.csv")

Generar el Modelo

modelo <- ' #Regresiones
              EcoSalud ~ SueloCalidad + AguaCalidad
              # Variables latentes
              SueloCalidad =~ SPH + NC + OM
              AguaCalidad =~ CL + DO + WPH
              EcoSalud =~ SD + BM + EP
              # Varianzas y covarianzas
              #Intercepto
              '

Generar el Diagrama

dfE <- scale(dfP3)
dfEE <- cfa(modelo, dfE)

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

summary(dfEE)

## lavaan 0.6-19 ended normally after 145 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|)
##   SueloCalidad =~                                     
##     SPH               1.000                           
##     NC                2.217    1.332    1.664    0.096
##     OM                0.167    0.402    0.414    0.679
##   AguaCalidad =~                                      
##     CL                1.000                           
##     DO               -0.827    0.427   -1.936    0.053
##     WPH               0.404    0.359    1.124    0.261
##   EcoSalud =~                                         
##     SD                1.000                           
##     BM               -1.899    3.995   -0.475    0.634
##     EP               -4.224    8.093   -0.522    0.602
## 
## Regressions:
##                    Estimate  Std.Err  z-value  P(>|z|)
##   EcoSalud ~                                          
##     SueloCalidad      0.530    1.499    0.353    0.724
##     AguaCalidad       0.583    1.507    0.387    0.699
## 
## Covariances:
##                    Estimate  Std.Err  z-value  P(>|z|)
##   SueloCalidad ~~                                     
##     AguaCalidad      -0.079    0.051   -1.558    0.119
## 
## 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
##     SueloCalidad      0.069    0.057    1.197    0.231
##     AguaCalidad       0.042    0.075    0.558    0.577
##    .EcoSalud          0.018    0.073    0.246    0.806

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