Actividad Integradora 2

Tema 1. Datos de Panel: Hogares

Instalar paquetes y llamar librerías

# install.packages("tidyverse")
library(tidyverse)
# install.packages("plm") 
library(plm)
# install.packages("gplots")
library(gplots)
# install.packages("readxl")
library(readxl)
# install.packages("lmtest")
library(lmtest)

Paso 1. Generar Conjunto de Datos de Panel

df1 <- read_excel("C:\\Users\\raulc\\OneDrive\\Escritorio\\hogares.xlsx")
panel_1 <- pdata.frame(df1, index = c("HogarID","Año"))

Paso 2. Prueba de Heterogeneidad

plotmeans(Ingreso ~ HogarID, main="Prueba de Heterogeneidad entre hogares para el Ingreso", data=panel_1)

Paso 3. Pruebas de Efectos Fijos y Aleatorios

# Modelo 1. Regresión agrupada (pooled) 
# Asume que no hay heteogeneidad observada
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)
# Cuando las diferencias no observadas son constantes en el tiempo
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

# Prueba F
pFtest(within, pooled)

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

# Si p-value < 0.05 se prefiere el modelo de efectos fijos

# Modelo 3. Efectos Aleatorios 
# Cuando las diferencias no observadas son aleatorias

# Método 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

# Método 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

# Método 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

# Comparar la r2 ajustada de los 3 métodos y elegir el que tenga el mayor.

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

Instalar paquetes y llamar librerías

# install.packages("sf")
# library(sf)
# install.packages("remotes")
# library(remotes)
# install.packages("devtools")
# devtools::install_github("diegovalle/mxmaps")
# 1
library(mxmaps)
# install.packages("forecast")
library(forecast)

## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo

Generar el mapa

df2 <- df_mxstate_2020

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

mxstate_choropleth(df_mxstate_2020)

1. Importar la base de datos

df3 <- read.csv("C:\\Users\\raulc\\OneDrive\\Escritorio\\population.csv")

2. Serie de Tiempo: TX

df4 <- df3 %>% 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")

Tema 3. Modelo de Ecuaciones Estructurales: Ecosistema

Contexto

Para evaluar la salud del ecosistema, consideramos las siguientes 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

Fuente

Instalar paquetes y llamar librerías

# install.packages("lavaan")
library(lavaan)

## This is lavaan 0.6-19
## lavaan is FREE software! Please report any bugs.

# install.packages("lavaanPlot")
library(lavaanPlot)

Importar la base de datos

df5 <- read.csv("C:\\Users\\raulc\\OneDrive\\Escritorio\\ecosistema.csv")

Entender la base de datos

summary(df5)

##        SD              BM              EP             SPH       
##  Min.   :17.69   Min.   :109.9   Min.   :160.6   Min.   :5.103  
##  1st Qu.:42.92   1st Qu.:169.4   1st Qu.:270.8   1st Qu.:6.151  
##  Median :50.12   Median :194.2   Median :305.9   Median :6.470  
##  Mean   :50.04   Mean   :195.4   Mean   :303.4   Mean   :6.479  
##  3rd Qu.:57.19   3rd Qu.:223.2   3rd Qu.:343.0   3rd Qu.:6.877  
##  Max.   :75.98   Max.   :318.3   Max.   :428.0   Max.   :8.286  
##        NC               OM             WPH              DO        
##  Min.   : 36.66   Min.   :2.219   Min.   :6.352   Min.   : 5.070  
##  1st Qu.: 86.06   1st Qu.:4.337   1st Qu.:6.809   1st Qu.: 7.477  
##  Median : 97.62   Median :5.138   Median :7.016   Median : 8.153  
##  Mean   : 97.74   Mean   :5.015   Mean   :7.003   Mean   : 8.083  
##  3rd Qu.:110.49   3rd Qu.:5.626   3rd Qu.:7.162   3rd Qu.: 8.742  
##  Max.   :155.33   Max.   :7.556   Max.   :7.681   Max.   :10.371  
##        CL         
##  Min.   :0.09931  
##  1st Qu.:1.62021  
##  Median :1.92120  
##  Mean   :1.93267  
##  3rd Qu.:2.30458  
##  Max.   :3.42535

str(df5)

## 'data.frame':    200 obs. of  9 variables:
##  $ SD : num  39.1 60 52.8 34.9 44.2 ...
##  $ BM : num  228 176 288 228 200 ...
##  $ EP : num  377 274 275 235 300 ...
##  $ SPH: num  7.07 6.11 6.63 6.31 7.09 ...
##  $ NC : num  97.6 59.8 81.6 103.4 73.6 ...
##  $ OM : num  4.25 5.57 5.72 4 5.47 ...
##  $ WPH: num  7.33 7.05 7.4 7.3 6.81 ...
##  $ DO : num  8.99 8.28 8.76 8.44 8.65 ...
##  $ CL : num  1.73 2.53 1.74 2.27 1.72 ...

Importar la base de datos

modelo  <- ' # Regresiones
            # Variables Latentes
            suelo =~ SPH + NC + OM
            agua =~ WPH + DO + CL
            ecosistema =~ SD + BM + EP
            # Varianzas y Covarianzas
            # Intercepto
            '
sem <- sem(modelo, data=df5)

## Warning: lavaan->lav_data_full():  
##    some observed variances are (at least) a factor 1000 times larger than 
##    others; use varTable(fit) to investigate

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

summary(sem)

## lavaan 0.6-19 ended normally after 271 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               82.643   49.671    1.664    0.096
##     OM                0.315    0.759    0.414    0.679
##   agua =~                                             
##     WPH               1.000                           
##     DO               -7.567    6.951   -1.089    0.276
##     CL                5.031    4.477    1.124    0.261
##   ecosistema =~                                       
##     SD                1.000                           
##     BM               -6.684   14.058   -0.475    0.634
##     EP              -20.398   39.077   -0.522    0.602
## 
## Covariances:
##                    Estimate  Std.Err  z-value  P(>|z|)
##   suelo ~~                                            
##     agua             -0.004    0.004   -1.006    0.315
##     ecosistema       -0.053    0.107   -0.497    0.619
##   agua ~~                                             
##     ecosistema       -0.019    0.040   -0.478    0.633
## 
## Variances:
##                    Estimate  Std.Err  z-value  P(>|z|)
##    .SPH               0.247    0.027    9.016    0.000
##    .NC              243.864   83.908    2.906    0.004
##    .OM                0.946    0.095    9.978    0.000
##    .WPH               0.066    0.007    9.938    0.000
##    .DO                0.876    0.098    8.977    0.000
##    .CL                0.261    0.032    8.086    0.000
##    .SD              110.456   11.097    9.954    0.000
##    .BM             1358.345  141.231    9.618    0.000
##    .EP             2459.363  429.999    5.719    0.000
##     suelo             0.018    0.015    1.197    0.231
##     agua              0.000    0.001    0.425    0.671
##     ecosistema        0.295    1.337    0.221    0.825

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