Paneles - Actividad 1
Lorena Villarreal
2024-02-15
GIF
Descargar Librerías
Importar Datos
patentes <- read_excel("PATENT 3.xls")Creación de Panel
panel <- patentes %>% dplyr::select(cusip,patentsg,merger,employ,return,patents,stckpr,rnd,rndstck,sales,year) %>%
arrange(year) %>%
group_by(cusip) %>%
fill(employ,return,stckpr,rndstck,sales) %>% ungroup() %>%
arrange(cusip)panel[is.na(panel)] <- 0
panel[] <- sapply(panel, as.numeric)
pdata <- pdata.frame(panel, index=c("cusip","year"))Pruebas de Heterogeneidad
plotmeans(patentsg ~ year, data = patentes,
main = "Promedio de patentes otorgadas por año",
xlab = "Año", ylab = "Promedio de patentes otorgadas",
barcol = "blue")
Como podemos ver, no existen picos muy notorios cuando se compara el promedio de los patentes otorgados por año. Sin embargo, en el año 2019 se ve un decline lo suficientemente notorio. Por esto, suponemos que existe homogeneidad entre los datos.
plotmeans(patentsg ~ sic, data = patentes,
main = "Promedio de patentes otorgadas por industria",
xlab = "Industria", ylab = "Promedio de patentes otorgadas",
barcol = "blue")
Cuando se visualizan los datos del promedio de patentes otorgados por cada industria, vemos un claro pico, al igual que otros picos menos potentes, pero igualmente importantes. Por lo mismo, podemos suponer que, en estos datos, está presente la heterogeneidad, ya que los datos no son lo suficientemente constantes para considerar la homogeneidad.
Modelos
Pooled
pooled <- plm(patentsg~employ+patents+stckpr+rnd+rndstck,data=pdata,model='pooling')
summary(pooled)## Pooling Model
##
## Call:
## plm(formula = patentsg ~ employ + patents + stckpr + rnd + rndstck,
## data = pdata, model = "pooling")
##
## Balanced Panel: n = 226, T = 10, N = 2260
##
## Residuals:
## Min. 1st Qu. Median 3rd Qu. Max.
## -273.22610 -4.00052 -0.43974 1.89473 643.72186
##
## Coefficients:
## Estimate Std. Error t-value Pr(>|t|)
## (Intercept) -1.4861306 0.7337290 -2.0254 0.04294 *
## employ 0.1823769 0.0255225 7.1457 1.204e-12 ***
## patents 0.9375323 0.0116057 80.7823 < 2.2e-16 ***
## stckpr 0.1421048 0.0239891 5.9237 3.630e-09 ***
## rnd -0.1699043 0.0338270 -5.0228 5.493e-07 ***
## rndstck 0.0361981 0.0062167 5.8227 6.616e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Total Sum of Squares: 14168000
## Residual Sum of Squares: 1411500
## R-Squared: 0.90037
## Adj. R-Squared: 0.90015
## F-statistic: 4074.02 on 5 and 2254 DF, p-value: < 2.22e-16Within
within <- plm(patentsg~employ+patents+stckpr+rnd+rndstck,data=pdata,model='within')
summary(within)## Oneway (individual) effect Within Model
##
## Call:
## plm(formula = patentsg ~ employ + patents + stckpr + rnd + rndstck,
## data = pdata, model = "within")
##
## Balanced Panel: n = 226, T = 10, N = 2260
##
## Residuals:
## Min. 1st Qu. Median 3rd Qu. Max.
## -226.86121 -1.91659 -0.33548 1.51974 258.24199
##
## Coefficients:
## Estimate Std. Error t-value Pr(>|t|)
## employ -0.1863311 0.0685649 -2.7176 0.006632 **
## patents 0.0735127 0.0187631 3.9179 9.227e-05 ***
## stckpr 0.0248818 0.0276181 0.9009 0.367736
## rnd -0.0846721 0.0321723 -2.6318 0.008557 **
## rndstck -0.0130047 0.0057733 -2.2526 0.024394 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Total Sum of Squares: 715640
## Residual Sum of Squares: 588660
## R-Squared: 0.17743
## Adj. R-Squared: 0.08419
## F-statistic: 87.5337 on 5 and 2029 DF, p-value: < 2.22e-16Prueba pF
pFtest(within,pooled)##
## F test for individual effects
##
## data: patentsg ~ employ + patents + stckpr + rnd + rndstck
## F = 12.606, df1 = 225, df2 = 2029, p-value < 2.2e-16
## alternative hypothesis: significant effectsAleatorios (walhus)
walhus <- plm(patentsg~employ+patents+stckpr+rnd+rndstck,data=pdata,model='random',random.method = 'walhus')
summary(walhus)## Oneway (individual) effect Random Effect Model
## (Wallace-Hussain's transformation)
##
## Call:
## plm(formula = patentsg ~ employ + patents + stckpr + rnd + rndstck,
## data = pdata, model = "random", random.method = "walhus")
##
## Balanced Panel: n = 226, T = 10, N = 2260
##
## Effects:
## var std.dev share
## idiosyncratic 597.076 24.435 0.956
## individual 27.492 5.243 0.044
## theta: 0.1725
##
## Residuals:
## Min. 1st Qu. Median 3rd Qu. Max.
## -260.84846 -4.12285 -0.39777 1.89895 613.20670
##
## Coefficients:
## Estimate Std. Error z-value Pr(>|z|)
## (Intercept) -1.7695669 0.8314818 -2.1282 0.03332 *
## employ 0.2464792 0.0285117 8.6448 < 2.2e-16 ***
## patents 0.8745414 0.0129288 67.6429 < 2.2e-16 ***
## stckpr 0.1693922 0.0257784 6.5711 4.995e-11 ***
## rnd -0.1832516 0.0349067 -5.2498 1.523e-07 ***
## rndstck 0.0381972 0.0063317 6.0327 1.613e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Total Sum of Squares: 9926700
## Residual Sum of Squares: 1334800
## R-Squared: 0.86554
## Adj. R-Squared: 0.86524
## Chisq: 14508.8 on 5 DF, p-value: < 2.22e-16Aleatorios (amemiya)
amemiya <- plm(patentsg~employ+patents+stckpr+rnd+sales,data=pdata,model='random',random.method = 'amemiya')
summary(amemiya)## Oneway (individual) effect Random Effect Model
## (Amemiya's transformation)
##
## Call:
## plm(formula = patentsg ~ employ + patents + stckpr + rnd + sales,
## data = pdata, model = "random", random.method = "amemiya")
##
## Balanced Panel: n = 226, T = 10, N = 2260
##
## Effects:
## var std.dev share
## idiosyncratic 287.95 16.97 0.035
## individual 7838.47 88.54 0.965
## theta: 0.9395
##
## Residuals:
## Min. 1st Qu. Median 3rd Qu. Max.
## -187.47285 -3.03765 -1.55182 0.65098 272.61083
##
## Coefficients:
## Estimate Std. Error z-value Pr(>|z|)
## (Intercept) 23.06322292 5.98017150 3.8566 0.0001150 ***
## employ 0.20753304 0.05504136 3.7705 0.0001629 ***
## patents 0.12913613 0.01801175 7.1695 7.524e-13 ***
## stckpr 0.08789749 0.02598965 3.3820 0.0007196 ***
## rnd -0.10090554 0.01240146 -8.1366 4.066e-16 ***
## sales -0.00146459 0.00034993 -4.1854 2.846e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Total Sum of Squares: 764870
## Residual Sum of Squares: 637690
## R-Squared: 0.16629
## Adj. R-Squared: 0.16444
## Chisq: 449.564 on 5 DF, p-value: < 2.22e-16Aleatorios (nerlove)
nerlove <- plm(patentsg~employ+patents+stckpr+rnd+sales,data=pdata,model='random',random.method = 'nerlove')
summary(nerlove)## Oneway (individual) effect Random Effect Model
## (Nerlove's transformation)
##
## Call:
## plm(formula = patentsg ~ employ + patents + stckpr + rnd + sales,
## data = pdata, model = "random", random.method = "nerlove")
##
## Balanced Panel: n = 226, T = 10, N = 2260
##
## Effects:
## var std.dev share
## idiosyncratic 259.16 16.10 0.032
## individual 7902.23 88.89 0.968
## theta: 0.9428
##
## Residuals:
## Min. 1st Qu. Median 3rd Qu. Max.
## -188.47497 -3.00366 -1.52701 0.66022 272.35959
##
## Coefficients:
## Estimate Std. Error z-value Pr(>|z|)
## (Intercept) 23.72242825 6.29330012 3.7695 0.0001636 ***
## employ 0.18587233 0.05527759 3.3625 0.0007723 ***
## patents 0.12374063 0.01799719 6.8756 6.175e-12 ***
## stckpr 0.08458818 0.02592117 3.2633 0.0011013 **
## rnd -0.10303073 0.01237765 -8.3239 < 2.2e-16 ***
## sales -0.00145991 0.00034891 -4.1842 2.861e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Total Sum of Squares: 759610
## Residual Sum of Squares: 633110
## R-Squared: 0.16654
## Adj. R-Squared: 0.16469
## Chisq: 450.374 on 5 DF, p-value: < 2.22e-16Prueba de Hausman
phtest(nerlove,within)##
## Hausman Test
##
## data: patentsg ~ employ + patents + stckpr + rnd + sales
## chisq = 93.587, df = 4, p-value < 2.2e-16
## alternative hypothesis: one model is inconsistentAl ver la R Ajustada de todos los modelos que realizamos, nos damos cuenta que el mejor modelo es el modelo de “pooled,” ya que es el que tiene la R Ajustada más cercana a 1 (teniendo 0.90).