Instalar Paquetes
library(readxl)
library(tidyverse)
library(lmtest)
library(plm)
library(gplots)
library(lavaan)
library(lavaanPlot)
Paso 1.Generar Conjunto de datos de panel
df1 <- read_excel("C:\\Users\\Chema\\Downloads\\hogares.xlsx")
panel1 <- 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 = panel1)
Paso 3. Pruebas de Efectos Fijos y
Aleatorios
# Modelo 1. Regresion Agrupada (pooled)
pooled <- plm(Ingreso ~ Satisfacción, data=panel1, model='pooling')
summary(pooled)
## Pooling Model
##
## Call:
## plm(formula = Ingreso ~ Satisfacción, 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 ***
## 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=panel1, model='within')
summary(within)
## Oneway (individual) effect Within Model
##
## Call:
## plm(formula = Ingreso ~ Satisfacción, 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|)
## 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
# Modelo 3. Efectos Aleatorios
# Metodo Walhus
walhus <- plm(Ingreso ~ Satisfacción, data=panel1, model='random', random.method = "walhus")
summary(walhus)
## Oneway (individual) effect Random Effect Model
## (Wallace-Hussain's transformation)
##
## Call:
## plm(formula = Ingreso ~ Satisfacción, 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 ***
## 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
# Metodo Amemiya
amemiya <- plm(Ingreso ~ Satisfacción, data=panel1, model='random', random.method = "amemiya")
summary(amemiya)
## Oneway (individual) effect Random Effect Model
## (Amemiya's transformation)
##
## Call:
## plm(formula = Ingreso ~ Satisfacción, 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 ***
## 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
# Metodo Nerlove
nerlove <- plm(Ingreso ~ Satisfacción, data=panel1, model='random', random.method = "nerlove")
summary(nerlove)
## Oneway (individual) effect Random Effect Model
## (Nerlove's transformation)
##
## Call:
## plm(formula = Ingreso ~ Satisfacción, 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 ***
## 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 r2 ajustada de los 3 metodos 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
# Por lo tanto nos quedamos con el Modelo de Efectos Fijos
Tema 2. Series de Tiempo: Mapas
Paquetes
#install.packages("devtools")
#devtools::install_github("diegovalle/mxmaps")
library(mxmaps)
#install.packages("sf")
library(sf)
## Linking to GEOS 3.13.1, GDAL 3.11.0, PROJ 9.6.0; sf_use_s2() is TRUE
library(forecast)
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
df2 <- df_mxstate_2020
df_mxstate_2020$value <- df2$pop
mxstate_choropleth(df_mxstate_2020)
1. Importar base de datos Population
df3 <- read.csv("C:\\Users\\Chema\\Downloads\\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="Poblacion TX")
Tema 3. Modelo de Ecuaciones Estructurales
df_ecosistema <- read.csv("C:\\Users\\Chema\\Downloads\\ecosistema.csv")
modelo_ecosistema <- ' # Regresiones
# Variables Latentes
suelo =~ SPH + NC + OM
agua =~ WPH + DO + CL
ecosistema =~ SD + BM + EP
# Varianzas y covarianzas
# Intercepto
'
sem <- sem(modelo_ecosistema, data=df_ecosistema)
## 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)