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