
library(WDI)
library(wbstats)
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.2 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.2 ✔ tibble 3.2.1
## ✔ lubridate 1.9.2 ✔ tidyr 1.3.0
## ✔ purrr 1.0.1
## ── 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
library(gplots)
##
## Attaching package: 'gplots'
##
## The following object is masked from 'package:stats':
##
## lowess
library(plm)
##
## Attaching package: 'plm'
##
## The following objects are masked from 'package:dplyr':
##
## between, lag, lead
library(readxl)
R Script “Panel” para obtener Indicadores del Banco Mundial
#Obtener información de 1 país
gdp_data <- wb_data(country=c("MX", "EC","CA"), indicator = "NY.GDP.PCAP.CD", start_date=2013, end_date=2013)
gdp_data
## # A tibble: 3 × 9
## iso2c iso3c country date NY.GDP.PCAP.CD unit obs_status footnote
## <chr> <chr> <chr> <dbl> <dbl> <chr> <chr> <chr>
## 1 CA CAN Canada 2013 52635. <NA> <NA> <NA>
## 2 EC ECU Ecuador 2013 6050. <NA> <NA> <NA>
## 3 MX MEX Mexico 2013 11317. <NA> <NA> <NA>
## # ℹ 1 more variable: last_updated <date>
#Generar un conjunto de datos de panel
#Generar un conjunto de datos de panel
panel <- select(gdp_data, country, date, NY.GDP.PCAP.CD)
panel_tax <- pdata.frame(panel, index = c("country","date"))
Ejercicio 2. Conjunto de Datos de Panel con Indicadores del Banco
Mundial
tax_data <- wb_data(country=c("US", "AU","CA","MA"), indicator = c("GC.TAX.TOTL.GD.ZS", "NY.GDP.MKTP.KD.ZG","FP.CPI.TOTL.ZG", "SL.UEM.TOTL.ZS"), start_date=2000, end_date=2023)
Explicación de variables
GC.TAX.TOTL.GD.ZS “Tax Revenue”
NY.GDP.MKTP.KD.ZG “Crecimiento del PIB (% anual)”
FP.CPI.TOTL.ZG “Inflación, precios al consumidor (% anual)”
SL.UEM.TOTL.ZS “Desempleo, total (% de la población activa”
Generar un conjunto de datos de panel
panel_tax <- select(tax_data, country, date, GC.TAX.TOTL.GD.ZS, NY.GDP.MKTP.KD.ZG,FP.CPI.TOTL.ZG, SL.UEM.TOTL.ZS)
panel_tax <- subset(panel_tax, date == 2000 | date == 2010 | date == 2020)
panel_tax <- panel_tax[complete.cases(panel_tax[ , c('GC.TAX.TOTL.GD.ZS', 'SL.UEM.TOTL.ZS')]), ]
Tarea 2. Gráficas de Heterogeneidad
plotmeans(tax_data$GC.TAX.TOTL.GD.ZS ~ tax_data$country, main=c("Hetereogeneidad entre países"), xlab = "Países", ylab = "% Tax Revenue")
## Warning in arrows(x, li, x, pmax(y - gap, li), col = barcol, lwd = lwd, :
## zero-length arrow is of indeterminate angle and so skipped
## Warning in arrows(x, li, x, pmax(y - gap, li), col = barcol, lwd = lwd, :
## zero-length arrow is of indeterminate angle and so skipped
## Warning in arrows(x, ui, x, pmin(y + gap, ui), col = barcol, lwd = lwd, :
## zero-length arrow is of indeterminate angle and so skipped
## Warning in arrows(x, ui, x, pmin(y + gap, ui), col = barcol, lwd = lwd, :
## zero-length arrow is of indeterminate angle and so skipped

¿Las líneas que une los promedios es horizontal, o tiene muchos
picos?
Para este caso descubrimos que las líneas muestran muchos
picos.
¿Los intervalos de confianza miden lo mismo, o están
desfasados?
Para este caso los intervalos de confianza están desfasados.
Investiga el concepto de Heterogeneidad y determina si lo que se ve
en las gráficas es deseable o no deseable.
Si es deseable porque estamos estudiando la variabilidad en estos
grupos, en este caso el porcentaje de ingresos fiscales en 4 diferentes
países.
plotmeans(tax_data$GC.TAX.TOTL.GD.ZS ~ tax_data$date, main=c("Hetereogeneidad entre años"), xlab = "Años", ylab = "% Tax Revenue")

¿Las líneas que une los promedios es horizontal, o tiene muchos
picos?
En este caso las líneas de los promedios se muestran de manera
horizontal.
¿Los intervalos de confianza miden lo mismo, o están
desfasados?
En este caso los intervalos de confianza se perciben bastante
homogéneos.
Investiga el concepto de Heterogeneidad y determina si lo que se ve
en las gráficas es deseable o no deseable.
No es deseable la heterogeneidad, ya que estamos buscando patrones
consistentes, debido a que los ingresos fiscales pueden ir aumentando
con los años.
Ejercicio 3. Modelos con Indicadores del Banco Mundial
Modelo 1. Regresión agrupada (pooled)
pooled <- plm(GC.TAX.TOTL.GD.ZS ~ NY.GDP.MKTP.KD.ZG + FP.CPI.TOTL.ZG+ SL.UEM.TOTL.ZS, data = panel_tax, model = "pooling")
summary(pooled)
## Pooling Model
##
## Call:
## plm(formula = GC.TAX.TOTL.GD.ZS ~ NY.GDP.MKTP.KD.ZG + FP.CPI.TOTL.ZG +
## SL.UEM.TOTL.ZS, data = panel_tax, model = "pooling")
##
## Unbalanced Panel: n = 4, T = 2-3, N = 11
##
## Residuals:
## Min. 1st Qu. Median 3rd Qu. Max.
## -6.3483 -4.2215 -1.0890 4.4031 6.9012
##
## Coefficients:
## Estimate Std. Error t-value Pr(>|t|)
## (Intercept) 17.71320 13.29512 1.3323 0.2245
## NY.GDP.MKTP.KD.ZG -0.30671 0.66340 -0.4623 0.6579
## FP.CPI.TOTL.ZG 0.83738 2.41997 0.3460 0.7395
## SL.UEM.TOTL.ZS -0.36129 1.30003 -0.2779 0.7891
##
## Total Sum of Squares: 275.85
## Residual Sum of Squares: 260.91
## R-Squared: 0.054142
## Adj. R-Squared: -0.35123
## F-statistic: 0.133562 on 3 and 7 DF, p-value: 0.93696
Modelo 2. Efectos fijos (within)
within <- plm(GC.TAX.TOTL.GD.ZS ~ NY.GDP.MKTP.KD.ZG + FP.CPI.TOTL.ZG + SL.UEM.TOTL.ZS, data = panel_tax, model = "within")
summary(within)
## Oneway (individual) effect Within Model
##
## Call:
## plm(formula = GC.TAX.TOTL.GD.ZS ~ NY.GDP.MKTP.KD.ZG + FP.CPI.TOTL.ZG +
## SL.UEM.TOTL.ZS, data = panel_tax, model = "within")
##
## Unbalanced Panel: n = 4, T = 2-3, N = 11
##
## Residuals:
## 1 2 3 4 5 6 7 8
## 0.985825 -2.060206 1.074381 0.839865 -1.409898 0.570034 0.322214 -0.322214
## 9 10 11
## 0.236637 -0.194555 -0.042082
##
## Coefficients:
## Estimate Std. Error t-value Pr(>|t|)
## NY.GDP.MKTP.KD.ZG -0.12871 0.17943 -0.7173 0.5128
## FP.CPI.TOTL.ZG 0.27481 0.63022 0.4361 0.6853
## SL.UEM.TOTL.ZS -0.65163 0.41304 -1.5776 0.1898
##
## Total Sum of Squares: 18.994
## Residual Sum of Squares: 9.692
## R-Squared: 0.48974
## Adj. R-Squared: -0.27565
## F-statistic: 1.27971 on 3 and 4 DF, p-value: 0.39495
Prueba pF
pFtest(within,pooled)
##
## F test for individual effects
##
## data: GC.TAX.TOTL.GD.ZS ~ NY.GDP.MKTP.KD.ZG + FP.CPI.TOTL.ZG + SL.UEM.TOTL.ZS
## F = 34.56, df1 = 3, df2 = 4, p-value = 0.002555
## alternative hypothesis: significant effects
Modelo 3. Efectos aleatorios (random) - Método
Walhus
walhus <- plm(GC.TAX.TOTL.GD.ZS ~ NY.GDP.MKTP.KD.ZG + FP.CPI.TOTL.ZG + SL.UEM.TOTL.ZS, data = panel_tax, model = "random", random.method = "walhus")
summary(walhus)
## Oneway (individual) effect Random Effect Model
## (Wallace-Hussain's transformation)
##
## Call:
## plm(formula = GC.TAX.TOTL.GD.ZS ~ NY.GDP.MKTP.KD.ZG + FP.CPI.TOTL.ZG +
## SL.UEM.TOTL.ZS, data = panel_tax, model = "random", random.method = "walhus")
##
## Unbalanced Panel: n = 4, T = 2-3, N = 11
##
## Effects:
## var std.dev share
## idiosyncratic 0.000 0.000 0
## individual 41.614 6.451 1
## theta:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1 1 1 1 1 1
##
## Residuals:
## Min. 1st Qu. Median 3rd Qu. Max.
## -2.06021 -0.25838 0.23664 0.70495 1.07438
##
## Coefficients:
## Estimate Std. Error z-value Pr(>|z|)
## NY.GDP.MKTP.KD.ZG -0.12871 0.12687 -1.0145 0.31037
## FP.CPI.TOTL.ZG 0.27481 0.44563 0.6167 0.53745
## SL.UEM.TOTL.ZS -0.65163 0.29207 -2.2311 0.02567 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Total Sum of Squares: 18.994
## Residual Sum of Squares: 9.692
## R-Squared: 0.48974
## Adj. R-Squared: 0.36217
## Chisq: 7.67828 on 2 DF, p-value: 0.021512
Modelo 3. Efectos aleatorios (random) - Método
Amemiya
amemiya <- plm(GC.TAX.TOTL.GD.ZS ~ NY.GDP.MKTP.KD.ZG + FP.CPI.TOTL.ZG + SL.UEM.TOTL.ZS, data = panel_tax, model = "random", random.method = "amemiya")
summary(amemiya)
## Oneway (individual) effect Random Effect Model
## (Amemiya's transformation)
##
## Call:
## plm(formula = GC.TAX.TOTL.GD.ZS ~ NY.GDP.MKTP.KD.ZG + FP.CPI.TOTL.ZG +
## SL.UEM.TOTL.ZS, data = panel_tax, model = "random", random.method = "amemiya")
##
## Unbalanced Panel: n = 4, T = 2-3, N = 11
##
## Effects:
## var std.dev share
## idiosyncratic 2.423 1.557 0.074
## individual 30.326 5.507 0.926
## theta:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.8040 0.8389 0.8389 0.8326 0.8389 0.8389
##
## Residuals:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.8909 -1.1974 0.0456 -0.0419 1.0622 1.7305
##
## Coefficients:
## Estimate Std. Error z-value Pr(>|z|)
## (Intercept) 21.13973 4.74842 4.4520 8.509e-06 ***
## NY.GDP.MKTP.KD.ZG -0.12976 0.18008 -0.7206 0.4712
## FP.CPI.TOTL.ZG 0.28218 0.63376 0.4452 0.6561
## SL.UEM.TOTL.ZS -0.62282 0.41082 -1.5160 0.1295
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Total Sum of Squares: 28.477
## Residual Sum of Squares: 17.19
## R-Squared: 0.40371
## Adj. R-Squared: 0.14816
## Chisq: 3.61865 on 3 DF, p-value: 0.3057
Modelo 3. Efectos aleatorios (random) - Método
Nerlove
nerlove <- plm(GC.TAX.TOTL.GD.ZS ~ NY.GDP.MKTP.KD.ZG + FP.CPI.TOTL.ZG + SL.UEM.TOTL.ZS, data = panel_tax, model = "random", random.method = "nerlove")
summary(nerlove)
## Oneway (individual) effect Random Effect Model
## (Nerlove's transformation)
##
## Call:
## plm(formula = GC.TAX.TOTL.GD.ZS ~ NY.GDP.MKTP.KD.ZG + FP.CPI.TOTL.ZG +
## SL.UEM.TOTL.ZS, data = panel_tax, model = "random", random.method = "nerlove")
##
## Unbalanced Panel: n = 4, T = 2-3, N = 11
##
## Effects:
## var std.dev share
## idiosyncratic 0.8811 0.9387 0.027
## individual 31.3126 5.5958 0.973
## theta:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.8822 0.9036 0.9036 0.8997 0.9036 0.9036
##
## Residuals:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.6993 -0.7566 0.2649 -0.0259 0.7713 1.4631
##
## Coefficients:
## Estimate Std. Error z-value Pr(>|z|)
## (Intercept) 21.30367 5.15204 4.1350 3.55e-05 ***
## NY.GDP.MKTP.KD.ZG -0.12902 0.15318 -0.8423 0.3996
## FP.CPI.TOTL.ZG 0.27731 0.53841 0.5151 0.6065
## SL.UEM.TOTL.ZS -0.64095 0.35145 -1.8237 0.0682 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Total Sum of Squares: 22.421
## Residual Sum of Squares: 12.389
## R-Squared: 0.4489
## Adj. R-Squared: 0.21271
## Chisq: 5.16727 on 3 DF, p-value: 0.15995
Prueba de Hausman
phtest(amemiya,within)
##
## Hausman Test
##
## data: GC.TAX.TOTL.GD.ZS ~ NY.GDP.MKTP.KD.ZG + FP.CPI.TOTL.ZG + SL.UEM.TOTL.ZS
## chisq = 0.12265, df = 3, p-value = 0.989
## alternative hypothesis: one model is inconsistent
Al final el mejor modelo resultó ser Walhus
Tarea 3. Modelos de Datos de Panel - Patentes
B1<- read_excel('Act_1_Datos.xlsx')
B1 <- pdata.frame(B1, index = c("cusip","year"))
levels(factor(B1$year))
## [1] "2012" "2013" "2014" "2015" "2016" "2017" "2018" "2019" "2020" "2021"
levels(factor(B1$cusip))
## [1] "800" "4626" "4671" "7500" "7603" "20753" "21367" "23519"
## [9] "29069" "38213" "54303" "67131" "67383" "74077" "77491" "87509"
## [17] "87779" "105655" "118745" "125761" "126149" "134429" "147195" "149123"
## [25] "158663" "165339" "171196" "172172" "189873" "200291" "202363" "212363"
## [33] "212813" "229669" "235773" "235811" "244199" "252741" "266867" "268039"
## [41] "277461" "278058" "286065" "296659" "296695" "303711" "316549" "345370"
## [49] "345838" "350244" "351604" "361428" "361556" "361606" "362360" "368298"
## [57] "368514" "369032" "369154" "369550" "369604" "369856" "370622" "370838"
## [65] "372298" "375046" "375766" "377352" "383492" "383550" "383883" "384109"
## [73] "390568" "402784" "404245" "413342" "413875" "415864" "421596" "422191"
## [81] "423002" "423236" "428399" "428875" "429812" "439272" "449290" "449680"
## [89] "451542" "451650" "456866" "457186" "457776" "459101" "459200" "459506"
## [97] "459578" "459884" "460043" "461135" "462218" "465632" "479169" "481070"
## [105] "481088" "481196" "486872" "487836" "489170" "493503" "494368" "495620"
## [113] "501026" "501206" "503624" "505336" "513696" "513847" "524660" "530000"
## [121] "538021" "539821" "540137" "540210" "541381" "543213" "551120" "551137"
## [129] "552618" "562706" "574055" "574599" "575379" "576680" "580033" "580169"
## [137] "580628" "585055" "589331" "597715" "601073" "608030" "608183" "620076"
## [145] "629853" "637742" "670148" "670250" "680665" "690207" "690734" "690768"
## [153] "704562" "707389" "717081" "718320" "724479" "727346" "727491" "736245"
## [161] "737407" "739732" "739868" "740512" "746252" "746299" "749720" "749738"
## [169] "750633" "754688" "754713" "755111" "756040" "758114" "760354" "760881"
## [177] "760898" "761406" "766481" "767329" "768024" "770196" "770519" "770553"
## [185] "775133" "775371" "776338" "776678" "776755" "784015" "784626" "794099"
## [193] "799850" "809367" "809877" "810640" "817698" "817732" "820208" "822440"
## [201] "826520" "828675" "831865" "832110" "832248" "832377" "833034" "847235"
## [209] "847567" "847660" "848355" "853683" "853700" "853734" "853836" "853887"
## [217] "857721" "859264" "866645" "866762" "871140" "871565" "871616" "878308"
## [225] "878555"
plotmeans(B1$patentsg ~ B1$cusip , main=c("Hetereogeneidad entre empresas"), xlab = "Empresas", ylab = "Patentes obtenidas")

plotmeans(B1$patentsg ~ B1$year , main=c("Hetereogeneidad entre años"), xlab = "Años", ylab = "Patentes obtenidas")

Modelo 1. Regresión agrupada (pooled)
pooled <- plm(B1$patentsg ~ B1$employ + B1$return + B1$rnd + B1$sales, data = B1, model ="pooling")
summary(pooled)
## Pooling Model
##
## Call:
## plm(formula = B1$patentsg ~ B1$employ + B1$return + B1$rnd +
## B1$sales, data = B1, model = "pooling")
##
## Unbalanced Panel: n = 225, T = 6-10, N = 2231
##
## Residuals:
## Min. 1st Qu. Median 3rd Qu. Max.
## -442.2632 -10.6067 -4.7467 1.8298 529.4454
##
## Coefficients:
## Estimate Std. Error t-value Pr(>|t|)
## (Intercept) -2.60509434 2.02574892 -1.2860 0.1986
## B1$employ 1.50807467 0.04815018 31.3202 < 2.2e-16 ***
## B1$return 0.91196207 0.20254442 4.5025 7.062e-06 ***
## B1$rnd -0.07961494 0.01855815 -4.2900 1.863e-05 ***
## B1$sales -0.00270527 0.00054283 -4.9836 6.721e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Total Sum of Squares: 14148000
## Residual Sum of Squares: 6158700
## R-Squared: 0.56471
## Adj. R-Squared: 0.56392
## F-statistic: 721.947 on 4 and 2226 DF, p-value: < 2.22e-16
Modelo 2. Efectos fijos (within)
within <- plm(B1$patentsg ~ B1$employ + B1$return + B1$rnd + B1$sales, data = B1, model ="within")
summary(within)
## Oneway (individual) effect Within Model
##
## Call:
## plm(formula = B1$patentsg ~ B1$employ + B1$return + B1$rnd +
## B1$sales, data = B1, model = "within")
##
## Unbalanced Panel: n = 225, T = 6-10, N = 2231
##
## Residuals:
## Min. 1st Qu. Median 3rd Qu. Max.
## -218.71094 -1.90284 -0.31552 1.52880 269.85101
##
## Coefficients:
## Estimate Std. Error t-value Pr(>|t|)
## B1$employ -0.06083751 0.06114261 -0.9950 0.3199
## B1$return -0.00629415 0.09150254 -0.0688 0.9452
## B1$rnd -0.14406290 0.01203980 -11.9656 < 2.2e-16 ***
## B1$sales -0.00156945 0.00035451 -4.4271 1.006e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Total Sum of Squares: 715600
## Residual Sum of Squares: 590200
## R-Squared: 0.17523
## Adj. R-Squared: 0.081304
## F-statistic: 106.338 on 4 and 2002 DF, p-value: < 2.22e-16
Prueba pf
pFtest(within,pooled)
##
## F test for individual effects
##
## data: B1$patentsg ~ B1$employ + B1$return + B1$rnd + B1$sales
## F = 84.324, df1 = 224, df2 = 2002, p-value < 2.2e-16
## alternative hypothesis: significant effects
Modelo 3. Efectos aleatorios (random) - Método
Walhus
walhus <- plm(B1$patentsg ~ B1$employ + B1$return + B1$rnd + B1$sales, data = B1, model ="random",random.method = "walhus")
summary(walhus)
## Oneway (individual) effect Random Effect Model
## (Wallace-Hussain's transformation)
##
## Call:
## plm(formula = B1$patentsg ~ B1$employ + B1$return + B1$rnd +
## B1$sales, data = B1, model = "random", random.method = "walhus")
##
## Unbalanced Panel: n = 225, T = 6-10, N = 2231
##
## Effects:
## var std.dev share
## idiosyncratic 415.44 20.38 0.148
## individual 2386.33 48.85 0.852
## theta:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.8321 0.8692 0.8692 0.8687 0.8692 0.8692
##
## Residuals:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -147.865 -3.953 -2.584 0.010 -0.127 315.974
##
## Coefficients:
## Estimate Std. Error z-value Pr(>|z|)
## (Intercept) 18.07605240 3.28303531 5.5059 3.673e-08 ***
## B1$employ 0.79528326 0.04960570 16.0321 < 2.2e-16 ***
## B1$return 0.05885953 0.10066248 0.5847 0.5587
## B1$rnd -0.11420604 0.01291561 -8.8425 < 2.2e-16 ***
## B1$sales -0.00231051 0.00038081 -6.0674 1.300e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Total Sum of Squares: 945440
## Residual Sum of Squares: 807880
## R-Squared: 0.1455
## Adj. R-Squared: 0.14396
## Chisq: 379.632 on 4 DF, p-value: < 2.22e-16
Modelo 3. Efectos aleatorios (random) - Método
Amemiya
amemiya <- plm(B1$patentsg ~ B1$employ + B1$return + B1$rnd + B1$sales, data = B1, model ="random",random.method = "amemiya")
summary(amemiya)
## Oneway (individual) effect Random Effect Model
## (Amemiya's transformation)
##
## Call:
## plm(formula = B1$patentsg ~ B1$employ + B1$return + B1$rnd +
## B1$sales, data = B1, model = "random", random.method = "amemiya")
##
## Unbalanced Panel: n = 225, T = 6-10, N = 2231
##
## Effects:
## var std.dev share
## idiosyncratic 294.81 17.17 0.031
## individual 9324.74 96.56 0.969
## theta:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.9276 0.9439 0.9439 0.9436 0.9439 0.9439
##
## Residuals:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -174.774 -3.102 -1.837 0.007 0.320 292.169
##
## Coefficients:
## Estimate Std. Error z-value Pr(>|z|)
## (Intercept) 29.31234567 6.52194041 4.4944 6.976e-06 ***
## B1$employ 0.21509532 0.05601519 3.8399 0.0001231 ***
## B1$return 0.01091431 0.09075130 0.1203 0.9042723
## B1$rnd -0.13455738 0.01187400 -11.3321 < 2.2e-16 ***
## B1$sales -0.00180826 0.00034979 -5.1696 2.346e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Total Sum of Squares: 757930
## Residual Sum of Squares: 647590
## R-Squared: 0.14558
## Adj. R-Squared: 0.14404
## Chisq: 379.406 on 4 DF, p-value: < 2.22e-16
Modelo 3. Efectos aleatorios (random) - Método
Nerlove
nerlove <- plm(B1$patentsg ~ B1$employ + B1$return + B1$rnd + B1$sales, data = B1, model ="random",random.method = "nerlove")
summary(nerlove)
## Oneway (individual) effect Random Effect Model
## (Nerlove's transformation)
##
## Call:
## plm(formula = B1$patentsg ~ B1$employ + B1$return + B1$rnd +
## B1$sales, data = B1, model = "random", random.method = "nerlove")
##
## Unbalanced Panel: n = 225, T = 6-10, N = 2231
##
## Effects:
## var std.dev share
## idiosyncratic 264.55 16.26 0.027
## individual 9363.75 96.77 0.973
## theta:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.9315 0.9469 0.9469 0.9467 0.9469 0.9469
##
## Residuals:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -176.538 -3.052 -1.776 0.007 0.390 290.975
##
## Coefficients:
## Estimate Std. Error z-value Pr(>|z|)
## (Intercept) 29.78825965 6.85746950 4.3439 1.400e-05 ***
## B1$employ 0.19033027 0.05621848 3.3855 0.0007104 ***
## B1$return 0.00928606 0.09038544 0.1027 0.9181706
## B1$rnd -0.13541319 0.01183277 -11.4439 < 2.2e-16 ***
## B1$sales -0.00178682 0.00034856 -5.1263 2.954e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Total Sum of Squares: 753440
## Residual Sum of Squares: 642170
## R-Squared: 0.14769
## Adj. R-Squared: 0.14616
## Chisq: 385.851 on 4 DF, p-value: < 2.22e-16
phtest(nerlove,within)
##
## Hausman Test
##
## data: B1$patentsg ~ B1$employ + B1$return + B1$rnd + B1$sales
## chisq = 111.71, df = 4, p-value < 2.2e-16
## alternative hypothesis: one model is inconsistent
Conclusión
Primero se analizaron las variables y se seleccionó “patentsg” como
nuestra variable independiente. Una vez que se obtuvieron todos los
modelos, identificamos que el modelo de “pooling” fue el mejor debido a
que nos lanzó un Rdj. R-Squared: 0.56392, a comparación con los otros
modelos que tenían uno Rdj más bajo que el de “pooling”.
LS0tCnRpdGxlOiAiQWN0aXZpZGFkIDEuIEFuw6FsaXNpcyB5IGFwbGljYWNpw7NuIGRlIGRhdG9zIHBhbmVsIgphdXRob3I6ICJUYW5pYSBPcnRlZ2EgLSBBMDE3MjE0NDkiCmRhdGU6ICIyMDI0LTAyLTE1IgpvdXRwdXQ6IAogIGh0bWxfZG9jdW1lbnQ6CiAgICB0b2M6IFRSVUUKICAgIHRvY19mbG9hdDogVFJVRQogICAgY29kZV9kb3dubG9hZDogVFJVRQotLS0KCmBgYHtyIHNldHVwLCBpbmNsdWRlPUZBTFNFfQprbml0cjo6b3B0c19jaHVuayRzZXQoZWNobyA9IFRSVUUpCmBgYAoKIVtdKGdpZi53ZWJwKQoKYGBge3J9CmxpYnJhcnkoV0RJKQpsaWJyYXJ5KHdic3RhdHMpCmxpYnJhcnkodGlkeXZlcnNlKQpsaWJyYXJ5KGdwbG90cykKbGlicmFyeShwbG0pCmxpYnJhcnkocmVhZHhsKQpgYGAKCiMjIFIgU2NyaXB0ICJQYW5lbCIgcGFyYSBvYnRlbmVyIEluZGljYWRvcmVzIGRlbCBCYW5jbyBNdW5kaWFsIApgYGB7cn0KI09idGVuZXIgaW5mb3JtYWNpw7NuIGRlIDEgcGHDrXMKZ2RwX2RhdGEgPC0gd2JfZGF0YShjb3VudHJ5PWMoIk1YIiwgIkVDIiwiQ0EiKSwgaW5kaWNhdG9yID0gIk5ZLkdEUC5QQ0FQLkNEIiwgc3RhcnRfZGF0ZT0yMDEzLCBlbmRfZGF0ZT0yMDEzKQpnZHBfZGF0YQpgYGAKCmBgYHtyfQojR2VuZXJhciB1biBjb25qdW50byBkZSBkYXRvcyBkZSBwYW5lbAojR2VuZXJhciB1biBjb25qdW50byBkZSBkYXRvcyBkZSBwYW5lbApwYW5lbCA8LSBzZWxlY3QoZ2RwX2RhdGEsIGNvdW50cnksIGRhdGUsIE5ZLkdEUC5QQ0FQLkNEKQpwYW5lbF90YXggPC0gcGRhdGEuZnJhbWUocGFuZWwsIGluZGV4ID0gYygiY291bnRyeSIsImRhdGUiKSkKCmBgYAoKIyMgRWplcmNpY2lvIDIuIENvbmp1bnRvIGRlIERhdG9zIGRlIFBhbmVsIGNvbiBJbmRpY2Fkb3JlcyBkZWwgQmFuY28gTXVuZGlhbCAKYGBge3J9CnRheF9kYXRhIDwtIHdiX2RhdGEoY291bnRyeT1jKCJVUyIsICJBVSIsIkNBIiwiTUEiKSwgaW5kaWNhdG9yID0gYygiR0MuVEFYLlRPVEwuR0QuWlMiLCAiTlkuR0RQLk1LVFAuS0QuWkciLCJGUC5DUEkuVE9UTC5aRyIsICJTTC5VRU0uVE9UTC5aUyIpLCBzdGFydF9kYXRlPTIwMDAsIGVuZF9kYXRlPTIwMjMpCgpgYGAKIyMjIyMgRXhwbGljYWNpw7NuIGRlIHZhcmlhYmxlcyAgICAgICAgCiMjIyMjIyBHQy5UQVguVE9UTC5HRC5aUyAqIlRheCBSZXZlbnVlIiogICAgICAgIAojIyMjIyMgIE5ZLkdEUC5NS1RQLktELlpHICJDcmVjaW1pZW50byBkZWwgUElCICglIGFudWFsKSIgICAgICAgCiMjIyMjIyBGUC5DUEkuVE9UTC5aRyAiSW5mbGFjacOzbiwgcHJlY2lvcyBhbCBjb25zdW1pZG9yICglIGFudWFsKSIgICAgICAgIAojIyMjIyMgIFNMLlVFTS5UT1RMLlpTICJEZXNlbXBsZW8sIHRvdGFsICglIGRlIGxhIHBvYmxhY2nDs24gYWN0aXZhIiAgICAgICAKCiMjIyBHZW5lcmFyIHVuIGNvbmp1bnRvIGRlIGRhdG9zIGRlIHBhbmVsCmBgYHtyfQpwYW5lbF90YXggPC0gc2VsZWN0KHRheF9kYXRhLCBjb3VudHJ5LCBkYXRlLCBHQy5UQVguVE9UTC5HRC5aUywgTlkuR0RQLk1LVFAuS0QuWkcsRlAuQ1BJLlRPVEwuWkcsIFNMLlVFTS5UT1RMLlpTKQpwYW5lbF90YXggPC0gc3Vic2V0KHBhbmVsX3RheCwgZGF0ZSA9PSAyMDAwIHwgZGF0ZSA9PSAyMDEwIHwgZGF0ZSA9PSAyMDIwKQpwYW5lbF90YXggPC0gcGFuZWxfdGF4W2NvbXBsZXRlLmNhc2VzKHBhbmVsX3RheFsgLCBjKCdHQy5UQVguVE9UTC5HRC5aUycsICdTTC5VRU0uVE9UTC5aUycpXSksIF0gCmBgYAoKIyMgVGFyZWEgMi4gR3LDoWZpY2FzIGRlIEhldGVyb2dlbmVpZGFkIApgYGB7cn0KcGxvdG1lYW5zKHRheF9kYXRhJEdDLlRBWC5UT1RMLkdELlpTIH4gdGF4X2RhdGEkY291bnRyeSwgbWFpbj1jKCJIZXRlcmVvZ2VuZWlkYWQgZW50cmUgcGHDrXNlcyIpLCB4bGFiID0gIlBhw61zZXMiLCB5bGFiID0gIiUgVGF4IFJldmVudWUiKQpgYGAKCiMjIyMgwr9MYXMgbMOtbmVhcyBxdWUgdW5lIGxvcyBwcm9tZWRpb3MgZXMgaG9yaXpvbnRhbCwgbyB0aWVuZSBtdWNob3MgcGljb3M/CiMjIyMjIFBhcmEgZXN0ZSBjYXNvIGRlc2N1YnJpbW9zIHF1ZSBsYXMgbMOtbmVhcyBtdWVzdHJhbiBtdWNob3MgcGljb3MuIAoKIyMjIyDCv0xvcyBpbnRlcnZhbG9zIGRlIGNvbmZpYW56YSBtaWRlbiBsbyBtaXNtbywgbyBlc3TDoW4gZGVzZmFzYWRvcz8KIyMjIyMgUGFyYSBlc3RlIGNhc28gbG9zIGludGVydmFsb3MgZGUgY29uZmlhbnphIGVzdMOhbiBkZXNmYXNhZG9zLgoKIyMjIyAgSW52ZXN0aWdhIGVsIGNvbmNlcHRvIGRlIEhldGVyb2dlbmVpZGFkIHkgZGV0ZXJtaW5hIHNpIGxvIHF1ZSBzZSB2ZSBlbiBsYXMgZ3LDoWZpY2FzIGVzIGRlc2VhYmxlIG8gbm8gZGVzZWFibGUuIAojIyMjIyBTaSBlcyBkZXNlYWJsZSBwb3JxdWUgZXN0YW1vcyBlc3R1ZGlhbmRvIGxhIHZhcmlhYmlsaWRhZCBlbiBlc3RvcyBncnVwb3MsIGVuIGVzdGUgY2FzbyBlbCBwb3JjZW50YWplIGRlIGluZ3Jlc29zIGZpc2NhbGVzIGVuIDQgZGlmZXJlbnRlcyBwYcOtc2VzLiAKCmBgYHtyfQpwbG90bWVhbnModGF4X2RhdGEkR0MuVEFYLlRPVEwuR0QuWlMgfiB0YXhfZGF0YSRkYXRlLCBtYWluPWMoIkhldGVyZW9nZW5laWRhZCBlbnRyZSBhw7FvcyIpLCB4bGFiID0gIkHDsW9zIiwgeWxhYiA9ICIlIFRheCBSZXZlbnVlIikKYGBgCgojIyMjIMK/TGFzIGzDrW5lYXMgcXVlIHVuZSBsb3MgcHJvbWVkaW9zIGVzIGhvcml6b250YWwsIG8gdGllbmUgbXVjaG9zIHBpY29zPwojIyMjIyBFbiBlc3RlIGNhc28gbGFzIGzDrW5lYXMgZGUgbG9zIHByb21lZGlvcyBzZSBtdWVzdHJhbiBkZSBtYW5lcmEgaG9yaXpvbnRhbC4gCgojIyMjIMK/TG9zIGludGVydmFsb3MgZGUgY29uZmlhbnphIG1pZGVuIGxvIG1pc21vLCBvIGVzdMOhbiBkZXNmYXNhZG9zPwojIyMjIyBFbiBlc3RlIGNhc28gbG9zIGludGVydmFsb3MgZGUgY29uZmlhbnphIHNlIHBlcmNpYmVuIGJhc3RhbnRlIGhvbW9nw6luZW9zLiAKCiMjIyMgSW52ZXN0aWdhIGVsIGNvbmNlcHRvIGRlIEhldGVyb2dlbmVpZGFkIHkgZGV0ZXJtaW5hIHNpIGxvIHF1ZSBzZSB2ZSBlbiBsYXMgZ3LDoWZpY2FzIGVzIGRlc2VhYmxlIG8gbm8gZGVzZWFibGUuIAojIyMjIyBObyBlcyBkZXNlYWJsZSBsYSBoZXRlcm9nZW5laWRhZCwgeWEgcXVlIGVzdGFtb3MgYnVzY2FuZG8gcGF0cm9uZXMgY29uc2lzdGVudGVzLCBkZWJpZG8gYSBxdWUgbG9zIGluZ3Jlc29zIGZpc2NhbGVzIHB1ZWRlbiBpciBhdW1lbnRhbmRvIGNvbiBsb3MgYcOxb3MuCgojIyBFamVyY2ljaW8gMy4gTW9kZWxvcyBjb24gSW5kaWNhZG9yZXMgZGVsIEJhbmNvIE11bmRpYWwgCgojIyMgTW9kZWxvIDEuIFJlZ3Jlc2nDs24gYWdydXBhZGEgKihwb29sZWQpKgpgYGB7cn0KcG9vbGVkIDwtIHBsbShHQy5UQVguVE9UTC5HRC5aUyB+IE5ZLkdEUC5NS1RQLktELlpHICsgRlAuQ1BJLlRPVEwuWkcrIFNMLlVFTS5UT1RMLlpTLCBkYXRhID0gcGFuZWxfdGF4LCBtb2RlbCA9ICJwb29saW5nIikKc3VtbWFyeShwb29sZWQpCmBgYAoKIyMjIE1vZGVsbyAyLiBFZmVjdG9zIGZpam9zICood2l0aGluKSoKYGBge3J9CndpdGhpbiA8LSBwbG0oR0MuVEFYLlRPVEwuR0QuWlMgfiBOWS5HRFAuTUtUUC5LRC5aRyArIEZQLkNQSS5UT1RMLlpHICsgU0wuVUVNLlRPVEwuWlMsIGRhdGEgPSBwYW5lbF90YXgsIG1vZGVsID0gIndpdGhpbiIpCnN1bW1hcnkod2l0aGluKQpgYGAKCiMjIyBQcnVlYmEgcEYKYGBge3J9CnBGdGVzdCh3aXRoaW4scG9vbGVkKQpgYGAKCiMjIyBNb2RlbG8gMy4gRWZlY3RvcyBhbGVhdG9yaW9zIChyYW5kb20pIC0gKipNw6l0b2RvIFdhbGh1cyoqCmBgYHtyfQp3YWxodXMgPC0gcGxtKEdDLlRBWC5UT1RMLkdELlpTIH4gTlkuR0RQLk1LVFAuS0QuWkcgKyBGUC5DUEkuVE9UTC5aRyAgKyBTTC5VRU0uVE9UTC5aUywgZGF0YSA9IHBhbmVsX3RheCwgbW9kZWwgPSAicmFuZG9tIiwgcmFuZG9tLm1ldGhvZCA9ICJ3YWxodXMiKQpzdW1tYXJ5KHdhbGh1cykKYGBgCgojIyMgIE1vZGVsbyAzLiBFZmVjdG9zIGFsZWF0b3Jpb3MgKHJhbmRvbSkgLSAqKk3DqXRvZG8gQW1lbWl5YSoqCmBgYHtyfQphbWVtaXlhIDwtIHBsbShHQy5UQVguVE9UTC5HRC5aUyB+IE5ZLkdEUC5NS1RQLktELlpHICsgRlAuQ1BJLlRPVEwuWkcgICsgU0wuVUVNLlRPVEwuWlMsIGRhdGEgPSBwYW5lbF90YXgsIG1vZGVsID0gInJhbmRvbSIsIHJhbmRvbS5tZXRob2QgPSAiYW1lbWl5YSIpCnN1bW1hcnkoYW1lbWl5YSkKYGBgCgojIyMgTW9kZWxvIDMuIEVmZWN0b3MgYWxlYXRvcmlvcyAocmFuZG9tKSAtICoqTcOpdG9kbyBOZXJsb3ZlKioKYGBge3J9Cm5lcmxvdmUgPC0gcGxtKEdDLlRBWC5UT1RMLkdELlpTIH4gTlkuR0RQLk1LVFAuS0QuWkcgKyBGUC5DUEkuVE9UTC5aRyAgKyBTTC5VRU0uVE9UTC5aUywgZGF0YSA9IHBhbmVsX3RheCwgbW9kZWwgPSAicmFuZG9tIiwgcmFuZG9tLm1ldGhvZCA9ICJuZXJsb3ZlIikKc3VtbWFyeShuZXJsb3ZlKQpgYGAKCiMjIyBQcnVlYmEgZGUgSGF1c21hbgpgYGB7cn0KcGh0ZXN0KGFtZW1peWEsd2l0aGluKQpgYGAKIyMjIyMgIEFsIGZpbmFsIGVsIG1lam9yIG1vZGVsbyByZXN1bHTDsyBzZXIgKldhbGh1cyoKCgojIyBUYXJlYSAzLiBNb2RlbG9zIGRlIERhdG9zIGRlIFBhbmVsIC0gUGF0ZW50ZXMKYGBge3J9CkIxPC0gcmVhZF9leGNlbCgnQWN0XzFfRGF0b3MueGxzeCcpCmBgYAoKYGBge3J9CkIxIDwtIHBkYXRhLmZyYW1lKEIxLCBpbmRleCA9IGMoImN1c2lwIiwieWVhciIpKQpgYGAKCmBgYHtyfQpsZXZlbHMoZmFjdG9yKEIxJHllYXIpKQpgYGAKCmBgYHtyfQpsZXZlbHMoZmFjdG9yKEIxJGN1c2lwKSkKYGBgCgpgYGB7cix3YXJuaW5nPUZBTFNFfQpwbG90bWVhbnMoQjEkcGF0ZW50c2cgfiBCMSRjdXNpcCAsIG1haW49YygiSGV0ZXJlb2dlbmVpZGFkIGVudHJlIGVtcHJlc2FzIiksIHhsYWIgPSAiRW1wcmVzYXMiLCB5bGFiID0gIlBhdGVudGVzIG9idGVuaWRhcyIpCgpgYGAKCmBgYHtyfQpwbG90bWVhbnMoQjEkcGF0ZW50c2cgfiBCMSR5ZWFyICwgbWFpbj1jKCJIZXRlcmVvZ2VuZWlkYWQgZW50cmUgYcOxb3MiKSwgeGxhYiA9ICJBw7FvcyIsIHlsYWIgPSAiUGF0ZW50ZXMgb2J0ZW5pZGFzIikKYGBgCgojIyMgTW9kZWxvIDEuIFJlZ3Jlc2nDs24gYWdydXBhZGEgKihwb29sZWQpKgpgYGB7cn0KcG9vbGVkIDwtIHBsbShCMSRwYXRlbnRzZyB+IEIxJGVtcGxveSArIEIxJHJldHVybiArIEIxJHJuZCArIEIxJHNhbGVzLCBkYXRhID0gQjEsIG1vZGVsID0icG9vbGluZyIpCnN1bW1hcnkocG9vbGVkKQpgYGAKCiMjIyBNb2RlbG8gMi4gRWZlY3RvcyBmaWpvcyAqKHdpdGhpbikqCmBgYHtyfQp3aXRoaW4gPC0gcGxtKEIxJHBhdGVudHNnIH4gQjEkZW1wbG95ICsgQjEkcmV0dXJuICsgQjEkcm5kICsgQjEkc2FsZXMsIGRhdGEgPSBCMSwgbW9kZWwgPSJ3aXRoaW4iKQpzdW1tYXJ5KHdpdGhpbikKYGBgCgojIyMgUHJ1ZWJhIHBmCmBgYHtyfQpwRnRlc3Qod2l0aGluLHBvb2xlZCkKYGBgCgojIyMgTW9kZWxvIDMuIEVmZWN0b3MgYWxlYXRvcmlvcyAocmFuZG9tKSAtICoqTcOpdG9kbyBXYWxodXMqKgpgYGB7cn0Kd2FsaHVzIDwtIHBsbShCMSRwYXRlbnRzZyB+IEIxJGVtcGxveSArIEIxJHJldHVybiArIEIxJHJuZCArIEIxJHNhbGVzLCBkYXRhID0gQjEsIG1vZGVsID0icmFuZG9tIixyYW5kb20ubWV0aG9kID0gIndhbGh1cyIpCnN1bW1hcnkod2FsaHVzKQpgYGAKCiMjIyAgTW9kZWxvIDMuIEVmZWN0b3MgYWxlYXRvcmlvcyAocmFuZG9tKSAtICoqTcOpdG9kbyBBbWVtaXlhKioKYGBge3J9CmFtZW1peWEgPC0gcGxtKEIxJHBhdGVudHNnIH4gQjEkZW1wbG95ICsgQjEkcmV0dXJuICsgQjEkcm5kICsgQjEkc2FsZXMsIGRhdGEgPSBCMSwgbW9kZWwgPSJyYW5kb20iLHJhbmRvbS5tZXRob2QgPSAiYW1lbWl5YSIpCnN1bW1hcnkoYW1lbWl5YSkKYGBgCgojIyMgTW9kZWxvIDMuIEVmZWN0b3MgYWxlYXRvcmlvcyAocmFuZG9tKSAtICoqTcOpdG9kbyBOZXJsb3ZlKioKYGBge3J9Cm5lcmxvdmUgPC0gcGxtKEIxJHBhdGVudHNnIH4gQjEkZW1wbG95ICsgQjEkcmV0dXJuICsgQjEkcm5kICsgQjEkc2FsZXMsIGRhdGEgPSBCMSwgbW9kZWwgPSJyYW5kb20iLHJhbmRvbS5tZXRob2QgPSAibmVybG92ZSIpCnN1bW1hcnkobmVybG92ZSkKYGBgCgpgYGB7cn0KcGh0ZXN0KG5lcmxvdmUsd2l0aGluKQpgYGAKCiMjIyMgQ29uY2x1c2nDs24KIyMjIyMgUHJpbWVybyBzZSBhbmFsaXphcm9uIGxhcyB2YXJpYWJsZXMgeSBzZSBzZWxlY2Npb27DsyDigJxwYXRlbnRzZ+KAnSBjb21vIG51ZXN0cmEgdmFyaWFibGUgaW5kZXBlbmRpZW50ZS4gVW5hIHZleiBxdWUgc2Ugb2J0dXZpZXJvbiB0b2RvcyBsb3MgbW9kZWxvcywgaWRlbnRpZmljYW1vcyBxdWUgZWwgbW9kZWxvIGRlIOKAnHBvb2xpbmfigJ0gZnVlIGVsIG1lam9yIGRlYmlkbyBhIHF1ZSBub3MgbGFuesOzIHVuIFJkai4gUi1TcXVhcmVkOiAwLjU2MzkyLCBhIGNvbXBhcmFjacOzbiBjb24gbG9zIG90cm9zIG1vZGVsb3MgcXVlIHRlbsOtYW4gdW5vIFJkaiBtw6FzIGJham8gcXVlIGVsIGRlIOKAnHBvb2xpbmfigJ0uCg==