MiniActividad_1_Modulo_2

Instalar paquetes y llamar librerìas

#install.packages("WDI")
library(WDI)
#install.packages("wbstats")
library(wbstats)
#install.packages("tidyverse")
library(tidyverse)

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.2     ✔ tibble    3.3.0
## ✔ lubridate 1.9.4     ✔ tidyr     1.3.1
## ✔ purrr     1.1.0     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

#install.packages("plm") #Paquete para realizar nodelos lineales para datos de panel
library(plm)

## 
## Adjuntando el paquete: 'plm'
## 
## The following objects are masked from 'package:dplyr':
## 
##     between, lag, lead

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

## 
## Adjuntando el paquete: 'gplots'
## 
## The following object is masked from 'package:stats':
## 
##     lowess

Paso 1 - Generar conjunto de Datos de Panel

# Obtener informaciòn de varios paises
gdp <- wb_data(country = c("FR","SE","GB"), indicator=c("EG.USE.ELEC.KH.PC",
                          "SP.POP.GROW"), start_date = 1950, end_date = 2025)

#Generar conjunto de datos de panel
panel_2 <-select(gdp, country, date,EG.USE.ELEC.KH.PC,SP.POP.GROW )

panel_2 <-subset(panel_2, date==1960|date==1970|date==1980|date==1990|date==2000|date==2010|date==2020)

panel_2 <- pdata.frame(panel_2, index=c("country","date"))
panel_2

##                            country date EG.USE.ELEC.KH.PC SP.POP.GROW
## France-1960                 France 1960          1438.299          NA
## France-1970                 France 1970          2624.427   0.9100710
## France-1980                 France 1980          4412.964   0.5339191
## France-1990                 France 1990          5966.426   0.5472283
## France-2000                 France 2000          7223.796   0.6863357
## France-2010                 France 2010          7737.803   0.4929764
## France-2020                 France 2020          6676.207   0.3245578
## Sweden-1960                 Sweden 1960          4002.322          NA
## Sweden-1970                 Sweden 1970          7315.984   0.9334849
## Sweden-1980                 Sweden 1980         10703.408   0.2029968
## Sweden-1990                 Sweden 1990         15836.034   0.7726027
## Sweden-2000                 Sweden 2000         15681.615   0.1605755
## Sweden-2010                 Sweden 2010         14935.287   0.8525246
## Sweden-2020                 Sweden 2020         12607.498   0.7227039
## United Kingdom-1960 United Kingdom 1960          2412.137          NA
## United Kingdom-1970 United Kingdom 1970          4166.932   0.3987225
## United Kingdom-1980 United Kingdom 1980          4683.933   0.1195173
## United Kingdom-1990 United Kingdom 1990          5356.575   0.2989306
## United Kingdom-2000 United Kingdom 2000          6114.529   0.3573009
## United Kingdom-2010 United Kingdom 2010          5712.741   0.7838886
## United Kingdom-2020 United Kingdom 2020          4522.953   0.1694471

Paso 2 - Prueba de Heterogeneidad

plotmeans(EG.USE.ELEC.KH.PC ~ country, main="Prueba de Heterogeneidad entre paises para el consumo de electricidad ", data=panel_2)

# Si la línea sale casi horizontal, hay poca o nula heterogeneidad por lo que no hay diferencias sistemáticas que ajustar.
#Si la línea sale quebrada, sube y baja, hay mucha Heterogeneidad por lo que hay que ajustar.

plotmeans(SP.POP.GROW ~ country, main="Prueba de Heterogeneidad entre paises según el crecimiento de la población", data=panel_2)

# Modelo 1- Regresión agrupada (pooled) Solo se toma si la linea de la prueba de heterogeneidad sale horizontal 
pooled_2 <- plm(SP.POP.GROW ~ EG.USE.ELEC.KH.PC, data= panel_2, model="pooling")
summary(pooled_2)

## Pooling Model
## 
## Call:
## plm(formula = SP.POP.GROW ~ EG.USE.ELEC.KH.PC, data = panel_2, 
##     model = "pooling")
## 
## Balanced Panel: n = 3, T = 6, N = 18
## 
## Residuals:
##     Min.  1st Qu.   Median  3rd Qu.     Max. 
## -0.42042 -0.19068  0.01412  0.18703  0.44008 
## 
## Coefficients:
##                     Estimate Std. Error t-value Pr(>|t|)   
## (Intercept)       4.4768e-01 1.4409e-01  3.1068 0.006782 **
## EG.USE.ELEC.KH.PC 8.5013e-06 1.6201e-05  0.5247 0.606966   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    1.2783
## Residual Sum of Squares: 1.2567
## R-Squared:      0.016918
## Adj. R-Squared: -0.044525
## F-statistic: 0.275341 on 1 and 16 DF, p-value: 0.60697

#Modelo 2 _ Efectos Fijos (within)
#Cuando las diferencias no observadas son constantes en el tiempo
within_2 <- plm(SP.POP.GROW ~ EG.USE.ELEC.KH.PC, data= panel_2, model="within")
summary(within_2)

## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = SP.POP.GROW ~ EG.USE.ELEC.KH.PC, data = panel_2, 
##     model = "within")
## 
## Balanced Panel: n = 3, T = 6, N = 18
## 
## Residuals:
##       Min.    1st Qu.     Median    3rd Qu.       Max. 
## -0.4605519 -0.1711214 -0.0051894  0.1714300  0.4454682 
## 
## Coefficients:
##                      Estimate  Std. Error t-value Pr(>|t|)
## EG.USE.ELEC.KH.PC -2.6160e-05  3.0139e-05  -0.868      0.4
## 
## Total Sum of Squares:    1.0453
## Residual Sum of Squares: 0.99194
## R-Squared:      0.051068
## Adj. R-Squared: -0.15228
## F-statistic: 0.753421 on 1 and 14 DF, p-value: 0.40003

#Prueba de los modelos 
pFtest(within_2,pooled_2)

## 
##  F test for individual effects
## 
## data:  SP.POP.GROW ~ EG.USE.ELEC.KH.PC
## F = 1.8681, df1 = 2, df2 = 14, p-value = 0.1909
## alternative hypothesis: significant effects

Interpretación Si el P-valuer es menor a 0.05 de prefiere el modelo de efectos fijos

#Modelo 3. Efectos Aleatorios - (Cuando las diferencias no observadas son Aleatorias)

#3.1-Método Walhus 
walhus_2 <- plm(SP.POP.GROW ~ EG.USE.ELEC.KH.PC, data= panel_2, model="random", random.method = "walhus")
summary(walhus_2)

## Oneway (individual) effect Random Effect Model 
##    (Wallace-Hussain's transformation)
## 
## Call:
## plm(formula = SP.POP.GROW ~ EG.USE.ELEC.KH.PC, data = panel_2, 
##     model = "random", random.method = "walhus")
## 
## Balanced Panel: n = 3, T = 6, N = 18
## 
## Effects:
##                   var std.dev share
## idiosyncratic 0.07238 0.26903     1
## individual    0.00000 0.00000     0
## theta: 0
## 
## Residuals:
##     Min.  1st Qu.   Median  3rd Qu.     Max. 
## -0.42042 -0.19068  0.01412  0.18703  0.44008 
## 
## Coefficients:
##                     Estimate Std. Error z-value Pr(>|z|)   
## (Intercept)       4.4768e-01 1.4409e-01  3.1068 0.001891 **
## EG.USE.ELEC.KH.PC 8.5013e-06 1.6201e-05  0.5247 0.599771   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    1.2783
## Residual Sum of Squares: 1.2567
## R-Squared:      0.016918
## Adj. R-Squared: -0.044525
## Chisq: 0.275341 on 1 DF, p-value: 0.59977

#3.2-Método Amemiya
amemiya_2 <- plm(SP.POP.GROW ~ EG.USE.ELEC.KH.PC, data= panel_2, model="random", random.method = "amemiya")
summary(amemiya_2)

## Oneway (individual) effect Random Effect Model 
##    (Amemiya's transformation)
## 
## Call:
## plm(formula = SP.POP.GROW ~ EG.USE.ELEC.KH.PC, data = panel_2, 
##     model = "random", random.method = "amemiya")
## 
## Balanced Panel: n = 3, T = 6, N = 18
## 
## Effects:
##                   var std.dev share
## idiosyncratic 0.06613 0.25716 0.737
## individual    0.02366 0.15381 0.263
## theta: 0.4362
## 
## Residuals:
##      Min.   1st Qu.    Median   3rd Qu.      Max. 
## -0.372581 -0.203561 -0.034475  0.224403  0.367411 
## 
## Coefficients:
##                      Estimate  Std. Error z-value Pr(>|z|)   
## (Intercept)        5.4598e-01  2.0400e-01  2.6764 0.007442 **
## EG.USE.ELEC.KH.PC -3.9348e-06  2.1697e-05 -0.1814 0.856087   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    1.1194
## Residual Sum of Squares: 1.1171
## R-Squared:      0.0020514
## Adj. R-Squared: -0.06032
## Chisq: 0.0328905 on 1 DF, p-value: 0.85609

#3.3-Método Amemiya
nerlove_2 <- plm(SP.POP.GROW ~ EG.USE.ELEC.KH.PC, data= panel_2, model="random", random.method = "nerlove")
summary(nerlove_2)

## Oneway (individual) effect Random Effect Model 
##    (Nerlove's transformation)
## 
## Call:
## plm(formula = SP.POP.GROW ~ EG.USE.ELEC.KH.PC, data = panel_2, 
##     model = "random", random.method = "nerlove")
## 
## Balanced Panel: n = 3, T = 6, N = 18
## 
## Effects:
##                   var std.dev share
## idiosyncratic 0.05511 0.23475 0.514
## individual    0.05202 0.22808 0.486
## theta: 0.6126
## 
## Residuals:
##      Min.   1st Qu.    Median   3rd Qu.      Max. 
## -0.371392 -0.205067 -0.045742  0.238352  0.361470 
## 
## Coefficients:
##                      Estimate  Std. Error z-value Pr(>|z|)  
## (Intercept)        6.1102e-01  2.4894e-01  2.4545  0.01411 *
## EG.USE.ELEC.KH.PC -1.2164e-05  2.4452e-05 -0.4974  0.61888  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    1.0803
## Residual Sum of Squares: 1.0638
## R-Squared:      0.01523
## Adj. R-Squared: -0.046318
## Chisq: 0.247446 on 1 DF, p-value: 0.61888

phtest(walhus_2,within_2)

## 
##  Hausman Test
## 
## data:  SP.POP.GROW ~ EG.USE.ELEC.KH.PC
## chisq = 1.8602, df = 1, p-value = 0.1726
## alternative hypothesis: one model is inconsistent

# Si el P-Value es <0.05, usampos efectos fijos (within)

En conclusion despúes de ralizar todos los modelos para analizar la poblacion en base al consumo de electricidad, concluimos que le mejor modelo es POOLED.