Actividad 1

Ejercicio 1. Modelo econometrico.

Ejercicio 2. Good to great.

¿Debe una empresa que lo hace bien, busca ser sobresaliente? Creo que genuinamente una empresa que lo hace bien debe de buscar ser sobresaliente porque es la única manera de asegurar su vigencia e impacto en nuestra sociedad. No creo que sirva de nada que una empresa que hoy es muy buena, se quede estancada por no buscar sobresalir o mejorar.

Instalar paquetes y librerias.

# Paquetes necesarios
# install.packages("WDI")
# install.packages("wbstats")
# install.packages("gplots")
# install.packages("plm")
library(WDI)
library(wbstats)
library(dplyr)
library(tidyverse)
library(plm)
library(gplots)
library(readxl)
library(lmtest)

Paso 1.Generar conjunto de datos panel.

gdp <- wb_data(
  country   = c("MX", "US", "CA"),
  indicator = c("NY.GDP.PCAP.CD", "SM.POP.NETM"),
  start_date = 1960,
  end_date   = 2025
)
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"))

Paso 2. Prueba de heterogeneidad.

plotmeans(NY.GDP.PCAP.CD ~ country, main= "Heterogeneidad PIB", data = panel_1)

plotmeans(SM.POP.NETM ~ country, main= "Heterogeneidad Migración Neta", data = panel_1)

Paso 3. Prueba de efectos fijos y aleatorios.

# Modelo 1: Pooled
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 <- 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

# F-test: fijos vs pooled
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

# Modelo 3: Efectos aleatorios
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

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

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

# Hausman test: fijos vs aleatorios
phtest(within, walhus)

## 
##  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

Ejercicio 3. Panel en Equipos

Paso 1.Generar conjunto de datos panel en equipo.

gdp2 <- wb_data(
  country   = c("JP", "DE", "BR"),
  indicator = c("SP.POP.TOTL", "SP.DYN.LE00.IN"),
  start_date = 1960,
  end_date   = 2025
)
panel_2 <- select(gdp2, country, date, SP.POP.TOTL, 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"))

Paso 2. Prueba de heterogeneidad.

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

Paso 3. Prueba de efectos fijos y aleatorios.

# Modelo 1: Pooled
pooled <- plm(SP.POP.TOTL ~ SP.DYN.LE00.IN, data=panel_2, model="pooling")
summary(pooled)

## Pooling Model
## 
## Call:
## plm(formula = SP.POP.TOTL ~ SP.DYN.LE00.IN, data = panel_2, model = "pooling")
## 
## Balanced Panel: n = 3, T = 7, N = 21
## 
## Residuals:
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -38524606 -35073577  -8097420         0   7487116  93670620 
## 
## Coefficients:
##                Estimate Std. Error t-value Pr(>|t|)
## (Intercept)    65007880   80431595  0.8082   0.4290
## SP.DYN.LE00.IN   670850    1100619  0.6095   0.5494
## 
## Total Sum of Squares:    3.1885e+16
## Residual Sum of Squares: 3.1273e+16
## R-Squared:      0.019178
## Adj. R-Squared: -0.032444
## F-statistic: 0.371515 on 1 and 19 DF, p-value: 0.5494

# Modelo 2: Efectos fijos
within <- plm(SP.POP.TOTL ~ SP.DYN.LE00.IN, data=panel_2, model="within")
summary(within)

## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = SP.POP.TOTL ~ SP.DYN.LE00.IN, data = panel_2, model = "within")
## 
## Balanced Panel: n = 3, T = 7, N = 21
## 
## Residuals:
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -23810452 -10271427   1321123         0  11066832  25702229 
## 
## Coefficients:
##                Estimate Std. Error t-value  Pr(>|t|)    
## SP.DYN.LE00.IN  4064844     583592  6.9652 2.279e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    1.6756e+16
## Residual Sum of Squares: 4.348e+15
## R-Squared:      0.74051
## Adj. R-Squared: 0.69472
## F-statistic: 48.5143 on 1 and 17 DF, p-value: 2.2794e-06

# F-test: fijos vs pooled
pFtest(within, pooled)

## 
##  F test for individual effects
## 
## data:  SP.POP.TOTL ~ SP.DYN.LE00.IN
## F = 52.636, df1 = 2, df2 = 17, p-value = 5.206e-08
## alternative hypothesis: significant effects

# Modelo 3: Efectos aleatorios
walhus  <- plm(SP.POP.TOTL ~ SP.DYN.LE00.IN, data=panel_2, model="random", random.method = "walhus")
summary(walhus)

## Oneway (individual) effect Random Effect Model 
##    (Wallace-Hussain's transformation)
## 
## Call:
## plm(formula = SP.POP.TOTL ~ SP.DYN.LE00.IN, data = panel_2, model = "random", 
##     random.method = "walhus")
## 
## Balanced Panel: n = 3, T = 7, N = 21
## 
## Effects:
##                     var   std.dev share
## idiosyncratic 7.221e+14 2.687e+07 0.485
## individual    7.670e+14 2.770e+07 0.515
## theta: 0.6557
## 
## Residuals:
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -30949248 -12270241  -2421181         0   5204214  51420578 
## 
## Coefficients:
##                  Estimate Std. Error z-value  Pr(>|z|)    
## (Intercept)    -133264301   56905903 -2.3418   0.01919 *  
## SP.DYN.LE00.IN    3400576     760006  4.4744 7.662e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    1.855e+16
## Residual Sum of Squares: 9.0324e+15
## R-Squared:      0.51307
## Adj. R-Squared: 0.48745
## Chisq: 20.0203 on 1 DF, p-value: 7.6624e-06

amemiya <- plm(SP.POP.TOTL ~ SP.DYN.LE00.IN, data=panel_2, model="random", random.method = "amemiya")
summary(amemiya)

## Oneway (individual) effect Random Effect Model 
##    (Amemiya's transformation)
## 
## Call:
## plm(formula = SP.POP.TOTL ~ SP.DYN.LE00.IN, data = panel_2, model = "random", 
##     random.method = "amemiya")
## 
## Balanced Panel: n = 3, T = 7, N = 21
## 
## Effects:
##                     var   std.dev share
## idiosyncratic 2.416e+14 1.554e+07 0.108
## individual    1.993e+15 4.464e+07 0.892
## theta: 0.8695
## 
## Residuals:
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -25216731 -11863798   -586593         0  11763479  34604749 
## 
## Coefficients:
##                  Estimate Std. Error z-value  Pr(>|z|)    
## (Intercept)    -174024510   50921076 -3.4175 0.0006319 ***
## SP.DYN.LE00.IN    3961745     591715  6.6954 2.151e-11 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    1.7014e+16
## Residual Sum of Squares: 5.0646e+15
## R-Squared:      0.70232
## Adj. R-Squared: 0.68666
## Chisq: 44.8278 on 1 DF, p-value: 2.1514e-11

nerlove <- plm(SP.POP.TOTL ~ SP.DYN.LE00.IN, data=panel_2, model="random", random.method = "nerlove")
summary(nerlove)

## Oneway (individual) effect Random Effect Model 
##    (Nerlove's transformation)
## 
## Call:
## plm(formula = SP.POP.TOTL ~ SP.DYN.LE00.IN, data = panel_2, model = "random", 
##     random.method = "nerlove")
## 
## Balanced Panel: n = 3, T = 7, N = 21
## 
## Effects:
##                     var   std.dev share
## idiosyncratic 2.070e+14 1.439e+07 0.064
## individual    3.041e+15 5.515e+07 0.936
## theta: 0.9019
## 
## Residuals:
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -24050572 -12252064   -135388         0  13400093  32255513 
## 
## Coefficients:
##                  Estimate Std. Error z-value  Pr(>|z|)    
## (Intercept)    -177249957   54608783 -3.2458  0.001171 ** 
## SP.DYN.LE00.IN    4006152     575074  6.9663 3.253e-12 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    1.6902e+16
## Residual Sum of Squares: 4.7555e+15
## R-Squared:      0.71864
## Adj. R-Squared: 0.70383
## Chisq: 48.5297 on 1 DF, p-value: 3.2533e-12

# Hausman test: fijos vs aleatorios
phtest(within, walhus)

## 
##  Hausman Test
## 
## data:  SP.POP.TOTL ~ SP.DYN.LE00.IN
## chisq = 1.8616, df = 1, p-value = 0.1724
## alternative hypothesis: one model is inconsistent

Aplicación de Shiny

Puedes ver la aplicación aquí: Shiny App

Actividad 1. Patentes

Contexto:

El entorno de negocios en el que las organizaciones se desarrollan es cada vez más dinámico por lo que las empresas enfrentan constantemente el reto de mantenerse al día y superar los nuevos retos que el ambiente presenta. La innovación es una de las mejores formas que las empresas tienen para conseguirlo. De acuerdo con el artículo “Innovation in business: What it is and why is so important” ´publicado en el Harvard Business Review la innovación presenta tres grandes ventajas para las empresas: les permite adaptarse, promueve el crecimiento y además les ayuda a diferenciarse de su competencia generando ventajas competitivas.

Importar Base de datos:

patentes <- read_excel("/Users/luisangeldiazcontreras/Library/CloudStorage/OneDrive-InstitutoTecnologicoydeEstudiosSuperioresdeMonterrey/9th season/PATENT 3.xls")
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 ...

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 NAs
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$rndeflt[is.na(patentes$rndeflt)] <- mean(patentes$rndeflt, na.rm=TRUE)
patentes$sales[is.na(patentes$sales)] <- mean(patentes$sales, na.rm=TRUE)
patentes$stckpr[is.na(patentes$stckpr)] <- mean(patentes$stckpr, na.rm=TRUE)
patentes$year <- patentes$year -40

Graficas

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)

Generar datos de panel

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

Prueba de heterogeneidad

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

Prueba de Efectos Fijos

#Regresión agrupada (pooling)
pooled_patentes <- plm(patents~merger+employ+return+stckpr+rnd+sales+sic, data=panel_patentes, model="pooling")
summary(pooled_patentes)

## Pooling Model
## 
## Call:
## plm(formula = patents ~ merger + employ + return + stckpr + rnd + 
##     sales + sic, data = panel_patentes, model = "pooling")
## 
## Balanced Panel: n = 226, T = 10, N = 2260
## 
## Residuals:
##       Min.    1st Qu.     Median    3rd Qu.       Max. 
## -320.36212  -10.01555    0.94472    7.40861  433.86316 
## 
## Coefficients:
##                Estimate  Std. Error t-value  Pr(>|t|)    
## (Intercept) -4.1831e-01  5.2757e+00 -0.0793   0.93681    
## merger      -1.1612e+01  7.2433e+00 -1.6031   0.10905    
## employ       1.3683e+00  4.1969e-02 32.6040 < 2.2e-16 ***
## return      -4.3505e-03  1.8155e-01 -0.0240   0.98088    
## stckpr       6.5137e-01  4.3139e-02 15.0994 < 2.2e-16 ***
## rnd         -1.3853e-01  1.6106e-02 -8.6007 < 2.2e-16 ***
## sales       -3.2049e-03  4.6962e-04 -6.8246  1.13e-11 ***
## sic         -2.6894e-03  1.4820e-03 -1.8146   0.06972 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    10998000
## Residual Sum of Squares: 4600300
## R-Squared:      0.58173
## Adj. R-Squared: 0.58043
## F-statistic: 447.437 on 7 and 2252 DF, p-value: < 2.22e-16

#Efecetor Fijos
within_patentes <- plm(patents~merger+employ+return+stckpr+rnd+sales+sic, data=panel_patentes, model="within")
summary(within_patentes)

## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = patents ~ merger + employ + return + stckpr + rnd + 
##     sales + sic, data = panel_patentes, model = "within")
## 
## Balanced Panel: n = 226, T = 10, N = 2260
## 
## Residuals:
##       Min.    1st Qu.     Median    3rd Qu.       Max. 
## -497.22898   -1.64569   -0.19669    1.64341  184.49423 
## 
## Coefficients:
##           Estimate  Std. Error  t-value  Pr(>|t|)    
## merger  3.30904770  4.16313684   0.7948   0.42680    
## employ  0.11963128  0.07052503   1.6963   0.08998 .  
## return -0.07056694  0.10867769  -0.6493   0.51620    
## stckpr -0.01107952  0.03242512  -0.3417   0.73262    
## rnd    -0.19889614  0.01443066 -13.7829 < 2.2e-16 ***
## sales  -0.00309052  0.00041525  -7.4426 1.451e-13 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    1091400
## Residual Sum of Squares: 819280
## R-Squared:      0.24935
## Adj. R-Squared: 0.16385
## F-statistic: 112.278 on 6 and 2028 DF, p-value: < 2.22e-16

#SI el pValue es menor que 0 se avanza a los siguientes modelos

Efectos Aleatorios

# 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

#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

#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

#Prueba de cuadrados perfectos
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

Pruebas de heterocedasticidad y autocorrelación serial

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 lor 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 autocorrelacion serial en los errores problema detectado

#Modelo de correcíón de ERRORES estandar robustos
coeficientes_corregidos <- coeftest(within_patentes, vcov=vcovHC(within_patentes, type="HC0"))
solo_coeficientes <- coeficientes_corregidos[,1]

Generar pronosticos y evaluar el modelo

datos_prueba <- data.frame(merger=0, employ=10, return=6, stckpr=48, rnd=3, sales=344)
prediccion <- sum(solo_coeficientes*datos_prueba)
prediccion

## [1] -1.418735

Conclusiones

En conclusion este ejercicio nos permite generar pronosticos en bases de datos con panel, tomando en en cuenta los tratamientos para distintos efectos en los datos y sus errores.