Actividad Clase 1

##Actividad Clase 1: Datos de Panel

Factores de gasto mensual en la alimentación de un hogar

Variables:

Ingreso familiar ($) — monto mensual total de ingresos del hogar.

Número de integrantes (# personas) — cantidad de personas que conforman el hogar.

Nivel de precios de alimentos — índice de precios de la canasta básica según la región.

Modelo económico:

Gasto_Alimentos

𝐹 ( Ingreso , Tama n ˜ o_Hogar , Precio_Comida ) Gasto Alimentos=F(Ingreso,Tama n ˜ o_Hogar,Precio_Comida)

Ecuación lineal propuesta:

Gasto

𝛽 0 + 𝛽 1 ( Ingreso ) + 𝛽 2 ( Tama n ˜ oHogar ) + 𝛽 3 ( PrecioComida ) + 𝜇 Gasto=β 0 ​

+β 1 ​

(Ingreso)+β 2 ​

(Tama n ˜ oHogar)+β 3 ​

(PrecioComida)+μ Reflexión de negocios

Una empresa que ya lo hace bien, ¿debe buscar ser sobresaliente?

Creo que una empresa debe esforzarse constantemente en obtener mejores resultados. La excelencia debe ser un objetivo permanente, sin importar la industria. No buscar ser sobresaliente o conformarse con el rendimiento actual puede generar que un competidor más ambicioso o incluso los propios clientes dejen atrás a la empresa. La mejora continua no solo es una ventaja competitiva, sino también un seguro frente a cambios en el mercado.

library(WDI)
library(tidyverse)
library(wbstats)
library(plm)
library(gplots)
library(lmtest)

# Obtener información de varios países
gdp <- wb_data(
  country=c("MX","US","CA"),
  indicator=c("NY.GDP.PCAP.CD","SM.POP.NETM"),
  start_date=1950,
  end_date=2025
)

# Generar conjunto de datos de panel
panel_1 <- select(gdp, country, date, NY.GDP.PCAP.CD, SM.POP.NETM)
panel_1 <- subset(panel_1, date %in% c(1960,1970,1980,1990,2000,2010,2020))
panel_1 <- pdata.frame(panel_1, index = c("country","date"))

summary(panel_1)

##           country    date   NY.GDP.PCAP.CD     SM.POP.NETM     
##  Canada       :7   1960:3   Min.   :  355.1   Min.   :-356433  
##  Mexico       :7   1970:3   1st Qu.: 3154.5   1st Qu.: -85591  
##  United States:7   1980:3   Median : 9728.8   Median : 201727  
##                    1990:3   Mean   :18187.4   Mean   : 285462  
##                    2000:3   3rd Qu.:24271.0   3rd Qu.: 422708  
##                    2010:3   Max.   :64401.5   Max.   :1594453  
##                    2020:3

#Prueba de heterogenidad (PIB y Migración)

plotmeans(NY.GDP.PCAP.CD ~ country, main="Prueba de Heterogeneidad entre países para el PIB", data=panel_1)

plotmeans(SM.POP.NETM ~ country, main="Prueba de Heterogeneidad entre países para la Migración Neta", data=panel_1)

#Pruebas de efectos fijos y aleatorios(PIB)

#Modelo 1. Regresión agrupada (pooled)
#Asume que no hay heterogenidad observada
pooled <- plm(NY.GDP.PCAP.CD ~ SM.POP.NETM, data = panel_1, model="pooling")
summary(pooled)

## Pooling Model
## 
## Call:
## plm(formula = NY.GDP.PCAP.CD ~ SM.POP.NETM, data = panel_1, model = "pooling")
## 
## Balanced Panel: n = 3, T = 7, N = 21
## 
## Residuals:
##     Min.  1st Qu.   Median  3rd Qu.     Max. 
## -21506.0 -10924.8  -3728.9   5274.5  45389.3 
## 
## Coefficients:
##               Estimate Std. Error t-value Pr(>|t|)   
## (Intercept) 1.2873e+04 4.2134e+03  3.0553 0.006511 **
## SM.POP.NETM 1.8616e-02 7.2324e-03  2.5740 0.018588 * 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    7259500000
## Residual Sum of Squares: 5382600000
## R-Squared:      0.25855
## Adj. R-Squared: 0.21952
## F-statistic: 6.62533 on 1 and 19 DF, p-value: 0.018588

#Modelo 2. Efectos Fijos (within)
# Cuando las diferencias no observadas son constantes en el tiempo
within <- plm(NY.GDP.PCAP.CD ~ SM.POP.NETM, data = panel_1, model="within")
summary(within)

## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = NY.GDP.PCAP.CD ~ SM.POP.NETM, data = panel_1, model = "within")
## 
## Balanced Panel: n = 3, T = 7, N = 21
## 
## Residuals:
##      Min.   1st Qu.    Median   3rd Qu.      Max. 
## -20886.56  -9903.27   -403.03   3407.39  44059.72 
## 
## Coefficients:
##             Estimate Std. Error t-value Pr(>|t|)
## SM.POP.NETM 0.013921   0.014345  0.9705   0.3454
## 
## Total Sum of Squares:    5256100000
## Residual Sum of Squares: 4980200000
## R-Squared:      0.052492
## Adj. R-Squared: -0.11471
## F-statistic: 0.94181 on 1 and 17 DF, p-value: 0.34542

#Prueba F:
pFtest(within, pooled)

## 
##  F test for individual effects
## 
## data:  NY.GDP.PCAP.CD ~ SM.POP.NETM
## F = 0.68685, df1 = 2, df2 = 17, p-value = 0.5166
## alternative hypothesis: significant effects

#Si P value < 0,05 se prefiere el modelo de efectos fijos

#Modelo 3. Efectos Aleatorios - Método walhus
walhus <- plm(NY.GDP.PCAP.CD ~ SM.POP.NETM, data = panel_1, model="random", random.method="walhus")
summary(walhus)

## Oneway (individual) effect Random Effect Model 
##    (Wallace-Hussain's transformation)
## 
## Call:
## plm(formula = NY.GDP.PCAP.CD ~ SM.POP.NETM, data = panel_1, model = "random", 
##     random.method = "walhus")
## 
## Balanced Panel: n = 3, T = 7, N = 21
## 
## Effects:
##                     var   std.dev share
## idiosyncratic 278418900     16686     1
## individual            0         0     0
## theta: 0
## 
## Residuals:
##     Min.  1st Qu.   Median  3rd Qu.     Max. 
## -21506.0 -10924.8  -3728.9   5274.5  45389.3 
## 
## Coefficients:
##               Estimate Std. Error z-value Pr(>|z|)   
## (Intercept) 1.2873e+04 4.2134e+03  3.0553 0.002248 **
## SM.POP.NETM 1.8616e-02 7.2324e-03  2.5740 0.010054 * 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    7259500000
## Residual Sum of Squares: 5382600000
## R-Squared:      0.25855
## Adj. R-Squared: 0.21952
## Chisq: 6.62533 on 1 DF, p-value: 0.010054

#Método amemiya 
amemiya <- plm(NY.GDP.PCAP.CD ~ SM.POP.NETM, data = panel_1, model="random",random.method="amemiya")
summary(amemiya)

## Oneway (individual) effect Random Effect Model 
##    (Amemiya's transformation)
## 
## Call:
## plm(formula = NY.GDP.PCAP.CD ~ SM.POP.NETM, data = panel_1, model = "random", 
##     random.method = "amemiya")
## 
## Balanced Panel: n = 3, T = 7, N = 21
## 
## Effects:
##                     var   std.dev share
## idiosyncratic 276675480     16634     1
## individual            0         0     0
## theta: 0
## 
## Residuals:
##     Min.  1st Qu.   Median  3rd Qu.     Max. 
## -21506.0 -10924.8  -3728.9   5274.5  45389.3 
## 
## Coefficients:
##               Estimate Std. Error z-value Pr(>|z|)   
## (Intercept) 1.2873e+04 4.2134e+03  3.0553 0.002248 **
## SM.POP.NETM 1.8616e-02 7.2324e-03  2.5740 0.010054 * 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    7259500000
## Residual Sum of Squares: 5382600000
## R-Squared:      0.25855
## Adj. R-Squared: 0.21952
## Chisq: 6.62533 on 1 DF, p-value: 0.010054

#Método nerlove
nerlove <- plm(NY.GDP.PCAP.CD ~ SM.POP.NETM, data = panel_1, model="random", random.method="nerlove")
summary(nerlove)

## Oneway (individual) effect Random Effect Model 
##    (Nerlove's transformation)
## 
## Call:
## plm(formula = NY.GDP.PCAP.CD ~ SM.POP.NETM, data = panel_1, model = "random", 
##     random.method = "nerlove")
## 
## Balanced Panel: n = 3, T = 7, N = 21
## 
## Effects:
##                     var   std.dev share
## idiosyncratic 237150411     15400 0.864
## individual     37271843      6105 0.136
## theta: 0.31
## 
## Residuals:
##     Min.  1st Qu.   Median  3rd Qu.     Max. 
## -20850.0  -9773.4  -2826.2   3450.7  45608.0 
## 
## Coefficients:
##               Estimate Std. Error z-value Pr(>|z|)  
## (Intercept) 1.3174e+04 5.8290e+03  2.2601  0.02382 *
## SM.POP.NETM 1.7563e-02 9.0595e-03  1.9386  0.05255 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    6.21e+09
## Residual Sum of Squares: 5184500000
## R-Squared:      0.16513
## Adj. R-Squared: 0.12119
## Chisq: 3.75814 on 1 DF, p-value: 0.052551

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

phtest(walhus, within)

## 
##  Hausman Test
## 
## data:  NY.GDP.PCAP.CD ~ SM.POP.NETM
## chisq = 0.14364, df = 1, p-value = 0.7047
## alternative hypothesis: one model is inconsistent

#Por lo tanto nos quedamos con el modelo agrupado

#Actividad Esperanza de vida

# Descargar datos del Banco Mundial
gdp2 <- wb_data(
  country = c("JP", "DE", "BR"),
  indicator = c("SE.ADT.LITR.ZS", "SP.DYN.LE00.IN"),
  start_date = 1960,
  end_date = 2025
)

# Generar conjunto de datos panel 2

# Descargar datos del Banco Mundial
gdp2 <- wb_data(
  country = c("JP", "DE", "BR"),
  indicator = c("SE.ADT.LITR.ZS", "SP.DYN.LE00.IN"),
  start_date = 1960,
  end_date = 2025
)

# Generar conjunto de datos panel 2
panel_2 <- select(gdp2, country, date, SE.ADT.LITR.ZS, SP.DYN.LE00.IN)
panel_2 <- subset(panel_2, date %in% c(1960,1970,1980,1990,2000,2010,2020))
panel_2 <- pdata.frame(panel_2, index = c("country", "date"))

#Prueba de heterogenidad (Esperanza de vida)

plotmeans(SP.DYN.LE00.IN ~ country, main= "Prueba de Heterogeneidad entre paises para la Esperanza de vida", data = panel_2)

#Pruebas de eventos Fijos (Esperanza de Vida)

#Modelo 1. Regresión agrupada (pooled)
#Asume que no hay heterogenidad observada
pooled <- plm(SP.DYN.LE00.IN ~ SE.ADT.LITR.ZS, data = panel_2, model="pooling")
summary(pooled)

## Pooling Model
## 
## Call:
## plm(formula = SP.DYN.LE00.IN ~ SE.ADT.LITR.ZS, data = panel_2, 
##     model = "pooling")
## 
## Balanced Panel: n = 1, T = 3, N = 3
## 
## Residuals:
## Brazil-1980 Brazil-2000 Brazil-2010 
##     0.16669    -0.62507     0.45838 
## 
## Coefficients:
##                Estimate Std. Error t-value Pr(>|t|)  
## (Intercept)    3.310809   6.056113  0.5467   0.6815  
## SE.ADT.LITR.ZS 0.777887   0.072177 10.7775   0.0589 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    73.645
## Residual Sum of Squares: 0.62861
## R-Squared:      0.99146
## Adj. R-Squared: 0.98293
## F-statistic: 116.155 on 1 and 1 DF, p-value: 0.058901

#Modelo 2. Efectos Fijos (within)
# Cuando las diferencias no observadas son constantes en el tiempo
within <- plm(SP.DYN.LE00.IN ~ SE.ADT.LITR.ZS, data = panel_2, model="within")
summary(within)

## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = SP.DYN.LE00.IN ~ SE.ADT.LITR.ZS, data = panel_2, 
##     model = "within")
## 
## Balanced Panel: n = 1, T = 3, N = 3
## 
## Residuals:
## Brazil-1980 Brazil-2000 Brazil-2010 
##     0.16669    -0.62507     0.45838 
## 
## Coefficients:
##                Estimate Std. Error t-value Pr(>|t|)  
## SE.ADT.LITR.ZS 0.777887   0.072177  10.777   0.0589 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    73.645
## Residual Sum of Squares: 0.62861
## R-Squared:      0.99146
## Adj. R-Squared: 0.98293
## F-statistic: 116.155 on 1 and 1 DF, p-value: 0.058901

#Prueba F:
pFtest(within, pooled)

## Warning in pf(stat, df1, df2, lower.tail = FALSE): Se han producido NaNs

## 
##  F test for individual effects
## 
## data:  SP.DYN.LE00.IN ~ SE.ADT.LITR.ZS
## F = -Inf, df1 = 0, df2 = 1, p-value = NA
## alternative hypothesis: significant effects

#Si P value < 0,05 se prefiere el modelo de efectos fijos

#Modelo 3. Efectos Aleatorios - Método walhus
walhus <- plm(SP.DYN.LE00.IN ~ SE.ADT.LITR.ZS, data = panel_2, model="random", random.method="walhus")
summary(walhus)

## Oneway (individual) effect Random Effect Model 
##    (Wallace-Hussain's transformation)
## 
## Call:
## plm(formula = SP.DYN.LE00.IN ~ SE.ADT.LITR.ZS, data = panel_2, 
##     model = "random", random.method = "walhus")
## 
## Balanced Panel: n = 1, T = 3, N = 3
## 
## Effects:
##                  var std.dev share
## idiosyncratic 0.3143  0.5606     1
## individual    0.0000  0.0000     0
## theta: 0
## 
## Residuals:
## Brazil-1980 Brazil-2000 Brazil-2010 
##     0.16669    -0.62507     0.45838 
## 
## Coefficients:
##                Estimate Std. Error z-value Pr(>|z|)    
## (Intercept)    3.310809   6.056113  0.5467   0.5846    
## SE.ADT.LITR.ZS 0.777887   0.072177 10.7775   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    73.645
## Residual Sum of Squares: 0.62861
## R-Squared:      0.99146
## Adj. R-Squared: 0.98293
## Chisq: 116.155 on 1 DF, p-value: < 2.22e-16

#Método amemiya 
amemiya <- plm(SP.DYN.LE00.IN ~ SE.ADT.LITR.ZS, data = panel_2, model="random",random.method="amemiya")
summary(amemiya)

## Oneway (individual) effect Random Effect Model 
##    (Amemiya's transformation)
## 
## Call:
## plm(formula = SP.DYN.LE00.IN ~ SE.ADT.LITR.ZS, data = panel_2, 
##     model = "random", random.method = "amemiya")
## 
## Balanced Panel: n = 1, T = 3, N = 3
## 
## Effects:
##                  var std.dev share
## idiosyncratic 0.3143  0.5606     1
## individual    0.0000  0.0000     0
## theta: 0
## 
## Residuals:
## Brazil-1980 Brazil-2000 Brazil-2010 
##     0.16669    -0.62507     0.45838 
## 
## Coefficients:
##                Estimate Std. Error z-value Pr(>|z|)    
## (Intercept)    3.310809   6.056113  0.5467   0.5846    
## SE.ADT.LITR.ZS 0.777887   0.072177 10.7775   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    73.645
## Residual Sum of Squares: 0.62861
## R-Squared:      0.99146
## Adj. R-Squared: 0.98293
## Chisq: 116.155 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:  SP.DYN.LE00.IN ~ SE.ADT.LITR.ZS
## chisq = 7.5791e-14, df = 1, p-value = 1
## alternative hypothesis: one model is inconsistent

#Por lo tanto nos quedamos con el modelo agrupado

#No se pudo hacer la prueba de nerlove debido a que tenia valores NA

##Actividad 1: Patentes

Importar base de datos:

library(readxl)
patentes <- read_excel("PATENT 3.xls")

Entender la base de datos

summary(patentes)

##      cusip            merger           employ            return       
##  Min.   :   800   Min.   :0.0000   Min.   :  0.085   Min.   :-73.022  
##  1st Qu.:368514   1st Qu.:0.0000   1st Qu.:  1.227   1st Qu.:  5.128  
##  Median :501116   Median :0.0000   Median :  3.842   Median :  7.585  
##  Mean   :514536   Mean   :0.0177   Mean   : 18.826   Mean   :  8.003  
##  3rd Qu.:754688   3rd Qu.:0.0000   3rd Qu.: 15.442   3rd Qu.: 10.501  
##  Max.   :878555   Max.   :1.0000   Max.   :506.531   Max.   : 48.675  
##                                    NA's   :21        NA's   :8        
##     patents         patentsg           stckpr              rnd           
##  Min.   :  0.0   Min.   :   0.00   Min.   :  0.1875   Min.   :   0.0000  
##  1st Qu.:  1.0   1st Qu.:   1.00   1st Qu.:  7.6250   1st Qu.:   0.6847  
##  Median :  3.0   Median :   4.00   Median : 16.5000   Median :   2.1456  
##  Mean   : 22.9   Mean   :  27.14   Mean   : 22.6270   Mean   :  29.3398  
##  3rd Qu.: 15.0   3rd Qu.:  19.00   3rd Qu.: 29.2500   3rd Qu.:  11.9168  
##  Max.   :906.0   Max.   :1063.00   Max.   :402.0000   Max.   :1719.3535  
##                                    NA's   :2                             
##     rndeflt             rndstck              sales                sic      
##  Min.   :   0.0000   Min.   :   0.1253   Min.   :    1.222   Min.   :2000  
##  1st Qu.:   0.4788   1st Qu.:   5.1520   1st Qu.:   52.995   1st Qu.:2890  
##  Median :   1.4764   Median :  13.3532   Median :  174.065   Median :3531  
##  Mean   :  19.7238   Mean   : 163.8234   Mean   : 1219.601   Mean   :3333  
##  3rd Qu.:   8.7527   3rd Qu.:  74.5625   3rd Qu.:  728.964   3rd Qu.:3661  
##  Max.   :1000.7876   Max.   :9755.3516   Max.   :44224.000   Max.   :9997  
##                      NA's   :157         NA's   :3                         
##       year     
##  Min.   :2012  
##  1st Qu.:2014  
##  Median :2016  
##  Mean   :2016  
##  3rd Qu.:2019  
##  Max.   :2021  
## 

str(patentes)

## tibble [2,260 × 13] (S3: tbl_df/tbl/data.frame)
##  $ cusip   : num [1:2260] 800 800 800 800 800 800 800 800 800 800 ...
##  $ merger  : num [1:2260] 0 0 0 0 0 0 0 0 0 0 ...
##  $ employ  : num [1:2260] 9.85 12.32 12.2 11.84 12.99 ...
##  $ return  : num [1:2260] 5.82 5.69 4.42 5.28 4.91 ...
##  $ patents : num [1:2260] 22 34 31 32 40 60 57 77 38 5 ...
##  $ patentsg: num [1:2260] 24 32 30 34 28 33 53 47 64 70 ...
##  $ stckpr  : num [1:2260] 47.6 57.9 33 38.5 35.1 ...
##  $ rnd     : num [1:2260] 2.56 3.1 3.27 3.24 3.78 ...
##  $ rndeflt : num [1:2260] 2.56 2.91 2.8 2.52 2.78 ...
##  $ rndstck : num [1:2260] 16.2 17.4 19.6 21.9 23.1 ...
##  $ sales   : num [1:2260] 344 436 535 567 631 ...
##  $ sic     : num [1:2260] 3740 3740 3740 3740 3740 3740 3740 3740 3740 3740 ...
##  $ year    : num [1:2260] 2012 2013 2014 2015 2016 ...

# NA's en la Base de Datos
sum(is.na(patentes)) # NA's totales

## [1] 191

sapply(patentes, function(x) sum(is.na(x))) # NA's por variable

##    cusip   merger   employ   return  patents patentsg   stckpr      rnd 
##        0        0       21        8        0        0        2        0 
##  rndeflt  rndstck    sales      sic     year 
##        0      157        3        0        0

# Reemplazar NA's por la media de cada variable
patentes$employ[is.na(patentes$employ)]   <- mean(patentes$employ, na.rm=TRUE)
patentes$return[is.na(patentes$return)]   <- mean(patentes$return, na.rm=TRUE)
patentes$stckpr[is.na(patentes$stckpr)]     <- mean(patentes$stckpr, na.rm=TRUE)
patentes$rndstck[is.na(patentes$rndstck)] <- mean(patentes$rndstck, na.rm=TRUE)
patentes$sales[is.na(patentes$sales)]     <- mean(patentes$sales, na.rm=TRUE)

# Revisar nuevamente NA's y resumen
sum(is.na(patentes)) # NA's en la Base de Datos

## [1] 0

summary(patentes)

##      cusip            merger           employ            return       
##  Min.   :   800   Min.   :0.0000   Min.   :  0.085   Min.   :-73.022  
##  1st Qu.:368514   1st Qu.:0.0000   1st Qu.:  1.242   1st Qu.:  5.139  
##  Median :501116   Median :0.0000   Median :  3.893   Median :  7.601  
##  Mean   :514536   Mean   :0.0177   Mean   : 18.826   Mean   :  8.003  
##  3rd Qu.:754688   3rd Qu.:0.0000   3rd Qu.: 16.034   3rd Qu.: 10.473  
##  Max.   :878555   Max.   :1.0000   Max.   :506.531   Max.   : 48.675  
##     patents         patentsg           stckpr              rnd           
##  Min.   :  0.0   Min.   :   0.00   Min.   :  0.1875   Min.   :   0.0000  
##  1st Qu.:  1.0   1st Qu.:   1.00   1st Qu.:  7.6250   1st Qu.:   0.6847  
##  Median :  3.0   Median :   4.00   Median : 16.5000   Median :   2.1456  
##  Mean   : 22.9   Mean   :  27.14   Mean   : 22.6270   Mean   :  29.3398  
##  3rd Qu.: 15.0   3rd Qu.:  19.00   3rd Qu.: 29.2500   3rd Qu.:  11.9168  
##  Max.   :906.0   Max.   :1063.00   Max.   :402.0000   Max.   :1719.3535  
##     rndeflt             rndstck              sales                sic      
##  Min.   :   0.0000   Min.   :   0.1253   Min.   :    1.222   Min.   :2000  
##  1st Qu.:   0.4788   1st Qu.:   5.5882   1st Qu.:   53.204   1st Qu.:2890  
##  Median :   1.4764   Median :  16.2341   Median :  174.283   Median :3531  
##  Mean   :  19.7238   Mean   : 163.8234   Mean   : 1219.601   Mean   :3333  
##  3rd Qu.:   8.7527   3rd Qu.: 119.1048   3rd Qu.:  743.422   3rd Qu.:3661  
##  Max.   :1000.7876   Max.   :9755.3516   Max.   :44224.000   Max.   :9997  
##       year     
##  Min.   :2012  
##  1st Qu.:2014  
##  Median :2016  
##  Mean   :2016  
##  3rd Qu.:2019  
##  Max.   :2021

# Boxplots por variable
boxplot(patentes$cusip,    horizontal=TRUE)

boxplot(patentes$merger,   horizontal=TRUE)

boxplot(patentes$employ,   horizontal=TRUE)

boxplot(patentes$return,   horizontal=TRUE)

boxplot(patentes$patents,  horizontal=TRUE)

boxplot(patentes$patentsg, horizontal=TRUE)

boxplot(patentes$stckpr,    horizontal=TRUE)

boxplot(patentes$rnd,      horizontal=TRUE)

boxplot(patentes$rndeflt,  horizontal=TRUE)

boxplot(patentes$rndstck,  horizontal=TRUE)

boxplot(patentes$sales,    horizontal=TRUE)

boxplot(patentes$sic,      horizontal=TRUE)

boxplot(patentes$year,     horizontal=TRUE)

# Mantener variable year
patentes$year <- patentes$year

Paso 2:

Generar conjunto de datos de panel

panel_patentes <- pdata.frame(patentes, index = c("cusip","year"))

Paso 2. Prueba de Heterogeneidad

plotmeans(patents ~ cusip, main="Prueba de Heterogeneidad entre empresas para sus patentes", data=panel_patentes)

## Paso 3. Pruebas de Efectos Fijos y Aleatorios

# Modelo 1. Regresión agrupada (pooled)
# Asume que no hay heterogeneidad observada
pooled_patentes <- plm(patents ~ merger + employ + return + stckpr + rnd + sales + sic,
                       data = panel_patentes, model = "pooling")
summary(pooled)

## Pooling Model
## 
## Call:
## plm(formula = SP.DYN.LE00.IN ~ SE.ADT.LITR.ZS, data = panel_2, 
##     model = "pooling")
## 
## Balanced Panel: n = 1, T = 3, N = 3
## 
## Residuals:
## Brazil-1980 Brazil-2000 Brazil-2010 
##     0.16669    -0.62507     0.45838 
## 
## Coefficients:
##                Estimate Std. Error t-value Pr(>|t|)  
## (Intercept)    3.310809   6.056113  0.5467   0.6815  
## SE.ADT.LITR.ZS 0.777887   0.072177 10.7775   0.0589 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    73.645
## Residual Sum of Squares: 0.62861
## R-Squared:      0.99146
## Adj. R-Squared: 0.98293
## F-statistic: 116.155 on 1 and 1 DF, p-value: 0.058901

# Modelo 2. Efectos Fijos (within)
# Cuando las diferencias no observadas son constantes en el tiempo

within_patentes <- plm(patents ~ merger + employ + return + stckpr + rnd + sales + sic,
                       data = panel_patentes, model = "within")
#Prueba F:
pFtest(within_patentes, pooled_patentes)

## 
##  F test for individual effects
## 
## data:  patents ~ merger + employ + return + stckpr + rnd + sales + sic
## F = 41.782, df1 = 224, df2 = 2028, 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 - Método walhus
walhus_patentes <- plm(patents ~ merger + employ + return + stckpr + rnd + sales + sic,
                       data = panel_patentes, model="random", random.method="walhus")
summary(walhus_patentes)

## Oneway (individual) effect Random Effect Model 
##    (Wallace-Hussain's transformation)
## 
## Call:
## plm(formula = patents ~ merger + employ + return + stckpr + rnd + 
##     sales + sic, data = panel_patentes, model = "random", random.method = "walhus")
## 
## Balanced Panel: n = 226, T = 10, N = 2260
## 
## Effects:
##                   var std.dev share
## idiosyncratic  555.26   23.56 0.273
## individual    1480.26   38.47 0.727
## theta: 0.8099
## 
## Residuals:
##       Min.    1st Qu.     Median    3rd Qu.       Max. 
## -433.72438   -3.89667   -1.76198    0.78484  211.91016 
## 
## Coefficients:
##                Estimate  Std. Error z-value  Pr(>|z|)    
## (Intercept) 11.84397257 12.78087032  0.9267    0.3541    
## merger       4.47647107  4.51685216  0.9911    0.3217    
## employ       1.10525428  0.04853786 22.7710 < 2.2e-16 ***
## return      -0.12920955  0.11762230 -1.0985    0.2720    
## stckpr       0.17097726  0.03355374  5.0956 3.476e-07 ***
## rnd         -0.14575073  0.01469317 -9.9196 < 2.2e-16 ***
## sales       -0.00393738  0.00042854 -9.1880 < 2.2e-16 ***
## sic         -0.00107515  0.00376075 -0.2859    0.7750    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    1449600
## Residual Sum of Squares: 1098300
## R-Squared:      0.24236
## Adj. R-Squared: 0.24
## Chisq: 720.388 on 7 DF, p-value: < 2.22e-16

#Método amemiya 
amemiya_patentes <- plm(patents ~ merger + employ + return + stckpr + rnd + sales + sic,
                         data = panel_patentes, model="random", random.method="amemiya")
summary(amemiya_patentes)

## Oneway (individual) effect Random Effect Model 
##    (Amemiya's transformation)
## 
## Call:
## plm(formula = patents ~ merger + employ + return + stckpr + rnd + 
##     sales + sic, data = panel_patentes, model = "random", random.method = "amemiya")
## 
## Balanced Panel: n = 226, T = 10, N = 2260
## 
## Effects:
##                   var std.dev share
## idiosyncratic  402.79   20.07 0.051
## individual    7483.44   86.51 0.949
## theta: 0.9268
## 
## Residuals:
##       Min.    1st Qu.     Median    3rd Qu.       Max. 
## -454.59697   -2.99704   -1.65272    0.59741  193.17353 
## 
## Coefficients:
##                Estimate  Std. Error  z-value  Pr(>|z|)    
## (Intercept)  8.58107091 29.77947247   0.2882    0.7732    
## merger       3.91351453  4.11354681   0.9514    0.3414    
## employ       0.49060426  0.06153621   7.9726 1.554e-15 ***
## return      -0.09427795  0.10733800  -0.8783    0.3798    
## stckpr       0.04660332  0.03163610   1.4731    0.1407    
## rnd         -0.17995961  0.01406835 -12.7918 < 2.2e-16 ***
## sales       -0.00342554  0.00040647  -8.4275 < 2.2e-16 ***
## sic          0.00425278  0.00877425   0.4847    0.6279    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    1144500
## Residual Sum of Squares: 891720
## R-Squared:      0.22085
## Adj. R-Squared: 0.21842
## Chisq: 638.312 on 7 DF, p-value: < 2.22e-16

#Método nerlove
nerlove_patentes <- plm(patents ~ merger + employ + return + stckpr + rnd + sales + sic,
                        data = panel_patentes, model="random", random.method="nerlove")
summary(nerlove_patentes)

## Oneway (individual) effect Random Effect Model 
##    (Nerlove's transformation)
## 
## Call:
## plm(formula = patents ~ merger + employ + return + stckpr + rnd + 
##     sales + sic, data = panel_patentes, model = "random", random.method = "nerlove")
## 
## Balanced Panel: n = 226, T = 10, N = 2260
## 
## Effects:
##                   var std.dev share
## idiosyncratic  362.51   19.04 0.046
## individual    7557.16   86.93 0.954
## theta: 0.9309
## 
## Residuals:
##       Min.    1st Qu.     Median    3rd Qu.       Max. 
## -455.94828   -2.93752   -1.60035    0.62863  192.36375 
## 
## Coefficients:
##                Estimate  Std. Error  z-value  Pr(>|z|)    
## (Intercept)  8.38498937 31.41700295   0.2669    0.7896    
## merger       3.86675065  4.09938561   0.9433    0.3456    
## employ       0.46018862  0.06203371   7.4184 1.186e-13 ***
## return      -0.09236163  0.10697310  -0.8634    0.3879    
## stckpr       0.04167663  0.03156299   1.3204    0.1867    
## rnd         -0.18153379  0.01403810 -12.9315 < 2.2e-16 ***
## sales       -0.00339833  0.00040545  -8.3816 < 2.2e-16 ***
## sic          0.00451640  0.00925634   0.4879    0.6256    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    1138700
## Residual Sum of Squares: 885220
## R-Squared:      0.22262
## Adj. R-Squared: 0.22021
## Chisq: 644.925 on 7 DF, p-value: < 2.22e-16

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

phtest(walhus_patentes, within_patentes)

## 
##  Hausman Test
## 
## data:  patents ~ merger + employ + return + stckpr + rnd + sales + sic
## chisq = 352.48, df = 6, p-value < 2.2e-16
## alternative hypothesis: one model is inconsistent

Paso 4. Pruebas de Heroterosticidad

# Prueba de Heterocedasticidad
bptest(within_patentes)

## 
##  studentized Breusch-Pagan test
## 
## data:  within_patentes
## BP = 1447.6, df = 7, p-value < 2.2e-16

# Si el p-value < 0.05, hay heterocedasticidad en los residuos (problema detectado)

# Prueba de Autocorrelación serial
pwartest(within_patentes)

## 
##  Wooldridge's test for serial correlation in FE panels
## 
## data:  within_patentes
## F = 104.29, df1 = 1, df2 = 2032, p-value < 2.2e-16
## alternative hypothesis: serial correlation

# Si el p-value < 0.05, hay autocorrelación serial en los errores (problema detectado)

# Modelo de corrección con Errores Estándar Robustos
coeficientes_corregidos <- coeftest(within_patentes, vcov=vcovHC(within_patentes, type="HC0"))
solo_coeficientes <- coeficientes_corregidos[,1]

`` ## Paso 5. Generar pronósticos

# Modelo de efectos fijos con todas las variables
within_patentes <- plm(
  patents ~ merger + employ + return + stckpr + rnd + sales + sic,
  data = panel_patentes,
  model = "within"
)

# Coeficientes corregidos con errores estándar robustos
coeficientes_corregidos <- coeftest(
  within_patentes,
  vcov = vcovHC(within_patentes, type = "HC0")
)

# Extraer solo los coeficientes de las variables de interés, en orden correcto
solo_coeficientes <- coeficientes_corregidos[, 1]
solo_coeficientes <- solo_coeficientes[c("merger", "employ", "return", "stckpr", "rnd", "sales")]

# Datos de prueba (los valores que quieres usar para la predicción)
datos_de_prueba <- data.frame(
  merger = 0,
  employ = 10,
  return = 6,
  stckpr = 48,
  rnd = 3,
  sales = 344
)

# Predicción
prediccion <- sum(solo_coeficientes * datos_de_prueba)
prediccion

## [1] -1.418735

Conclusiones

En conclusión, este ejercicio nos permite generar pronósticos en bases de datos con panel, tomando en cuenta los tratamientos para distintos efectos en los datos y sus errores.

Página de la app de Shiny:http://francord.shinyapps.io/clasestabs