gif
gif
# Instalar paquetes y llamar librerías
#install.packages("WDI")
library(WDI)
#install.packages("wbstats")
library(wbstats)
#install.packages("tidyverse")
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.4.4     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.1
## ✔ purrr     1.0.2     
## ── 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
#install.packages("gplots")
library(gplots)
## 
## Attaching package: 'gplots'
## 
## The following object is masked from 'package:stats':
## 
##     lowess
#install.packages("plm")
library(plm)
## 
## Attaching package: 'plm'
## 
## The following objects are masked from 'package:dplyr':
## 
##     between, lag, lead

R Script “Panel” para obtener Indicadores del Banco Mundial

# Obtener información de varios países
gdp_data1 <- wb_data(country=c("MX","EC","CA"), indicator = "NY.GDP.PCAP.CD", start_date=2013, end_date=2023)
gdp_data1
## # A tibble: 30 × 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 CA    CAN   Canada   2014         50956. <NA>  <NA>       <NA>    
##  3 CA    CAN   Canada   2015         43596. <NA>  <NA>       <NA>    
##  4 CA    CAN   Canada   2016         42316. <NA>  <NA>       <NA>    
##  5 CA    CAN   Canada   2017         45129. <NA>  <NA>       <NA>    
##  6 CA    CAN   Canada   2018         46549. <NA>  <NA>       <NA>    
##  7 CA    CAN   Canada   2019         46374. <NA>  <NA>       <NA>    
##  8 CA    CAN   Canada   2020         43350. <NA>  <NA>       <NA>    
##  9 CA    CAN   Canada   2021         52359. <NA>  <NA>       <NA>    
## 10 CA    CAN   Canada   2022         54918. <NA>  <NA>       <NA>    
## # ℹ 20 more rows
## # ℹ 1 more variable: last_updated <date>
# Generar un conjunto de datos de panel
panel1 <- select(gdp_data1,country, date, NY.GDP.PCAP.CD)

Ejercicio 2. Conjunto de Datos de Panel con Indicadores del Banco Mundial

Integrantes: Regina Enríquez, Maximiliano Carvajal, Guillermo Cazares

# Obtener información de varios países
gdp_data <- wb_data(country=c("MX","NO","FI","SE","DK"), indicator = c("EN.ATM.CO2E.KT", "EG.FEC.RNEW.ZS", "SP.URB.TOTL.IN.ZS", "AG.LND.AGRI.ZS"), start_date=1950, end_date=2020)
EN.ATM.CO2E.KT es Emisiones de CO2 (kt)
EG.FEC.RNEW.ZS es Consumo de energía renovable (% del consumo total de energía final)
SP.URB.TOTL.IN.ZS es Población urbana (% del total)
AG.LND.AGRI.ZS es Tierras agrícolas (% del área de tierra)
# Generar un conjunto de datos de panel
panel <- select(gdp_data, country,date,EN.ATM.CO2E.KT,EG.FEC.RNEW.ZS,SP.URB.TOTL.IN.ZS,AG.LND.AGRI.ZS)
panel <- subset(panel, date == 1990 | date == 2000 | date == 2010 | date == 2020)
panel <- pdata.frame(panel, index = c("country", "date"))
panel
##              country date EN.ATM.CO2E.KT EG.FEC.RNEW.ZS SP.URB.TOTL.IN.ZS
## Denmark-1990 Denmark 1990        51978.0           7.05            84.843
## Denmark-2000 Denmark 2000        52602.0          10.73            85.100
## Denmark-2010 Denmark 2010        48124.8          21.20            86.795
## Denmark-2020 Denmark 2020        27356.5          39.70            88.116
## Finland-1990 Finland 1990        54562.8          24.51            79.367
## Finland-2000 Finland 2000        55097.5          31.68            82.183
## Finland-2010 Finland 2010        62526.4          33.43            83.770
## Finland-2020 Finland 2020        36329.9          47.49            85.517
## Mexico-1990   Mexico 1990       269575.4          14.41            71.419
## Mexico-2000   Mexico 2000       379176.0          12.17            74.722
## Mexico-2010   Mexico 2010       462869.5           9.36            77.815
## Mexico-2020   Mexico 2020       383131.4          12.33            80.731
## Norway-1990   Norway 1990        29305.4          59.17            71.956
## Norway-2000   Norway 2000        34283.1          60.18            76.020
## Norway-2010   Norway 2010        40116.4          56.71            79.102
## Norway-2020   Norway 2020        36177.4          61.29            82.974
## Sweden-1990   Sweden 1990        53346.2          34.06            83.100
## Sweden-2000   Sweden 2000        53277.5          39.82            84.026
## Sweden-2010   Sweden 2010        47985.5          44.70            85.056
## Sweden-2020   Sweden 2020        33576.1          58.40            87.977
##              AG.LND.AGRI.ZS
## Denmark-1990      69.700000
## Denmark-2000      66.175000
## Denmark-2010      65.650000
## Denmark-2020      65.499675
## Finland-1990       7.856463
## Finland-2000       7.281920
## Finland-2010       7.541626
## Finland-2020       7.468579
## Mexico-1990       54.091412
## Mexico-2000       54.697909
## Mexico-2010       52.371203
## Mexico-2020       49.969392
## Norway-1990        2.672186
## Norway-2000        2.852887
## Norway-2010        2.754049
## Norway-2020        2.706568
## Sweden-1990        8.378756
## Sweden-2000        7.301277
## Sweden-2010        7.545790
## Sweden-2020        7.379478
# Buscar si es que hay NAs en los datos
na_count <- colSums(is.na(panel))
na_count
##           country              date    EN.ATM.CO2E.KT    EG.FEC.RNEW.ZS 
##                 0                 0                 0                 0 
## SP.URB.TOTL.IN.ZS    AG.LND.AGRI.ZS 
##                 0                 0

Tarea 2. Gráficas de Heterogeneidad

Integrantes: Regina Enríquez, Maximiliano Carvajal, Guillermo Cazares

# Heterogeneidad

# Gráfico para la heterogeneidad entre países
plotmeans(EN.ATM.CO2E.KT ~ country, data = panel, main = "Heterogeneidad entre países", xlab = "País", ylab = "Promedio de CO2E (KT)")

# Gráfico para la heterogeneidad entre años
plotmeans(EN.ATM.CO2E.KT ~ date, data = panel, main = "Heterogeneidad entre años", xlab = "Año", ylab = "Promedio de CO2E (KT)")

¿La línea que une los promedios es horizontal, o tiene muchos picos?

La heterogeneidad entre países tiene un pico en México. La gráfica de años es homogénea, pues mantiene promedios horizontales entre los años.

¿Los intervalos de confianza miden lo mismo, o están desfasados?

Los intervalos de confianza de los países están desfasados, por otro lado, los intervalos de confianza de los años tienen una varianza ligera,

Investiga el concepto de Heterogeneidad y determina si lo que se ve en las gráficas es deseable o no deseable.

El concepto de heterogeneidad se refiere a la diversidad y variabilidad entre distintas entidades dentro de un conjunto o población. Para un estudio, la gráfica de países es deseada debido a que se identifica una diferencia entre el país de México a diferencia de los demás territorios. Por otro lado, debido a que la gráfica de años mantiene promedios similares, para un estudio esto no es deseado, pues no se pueden resaltar observaciones significativas en los cambios de CO2 a través de los años.

Ejercicio 3. Modelos con Indicadores del Banco Mundial

# Modelo 1. Regresión agrupada (pooled)
pooled <- plm(EN.ATM.CO2E.KT ~ EG.FEC.RNEW.ZS + SP.URB.TOTL.IN.ZS + AG.LND.AGRI.ZS, data = panel, model = "pooling")
summary(pooled)
## Pooling Model
## 
## Call:
## plm(formula = EN.ATM.CO2E.KT ~ EG.FEC.RNEW.ZS + SP.URB.TOTL.IN.ZS + 
##     AG.LND.AGRI.ZS, data = panel, model = "pooling")
## 
## Balanced Panel: n = 5, T = 4, N = 20
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
## -136648  -52292   -9079   39455  204408 
## 
## Coefficients:
##                     Estimate Std. Error t-value Pr(>|t|)   
## (Intercept)       1222636.00  373989.24  3.2692 0.004822 **
## EG.FEC.RNEW.ZS      -3731.73    1972.73 -1.8917 0.076779 . 
## SP.URB.TOTL.IN.ZS  -12233.92    4689.56 -2.6088 0.019000 * 
## AG.LND.AGRI.ZS        434.16    1376.95  0.3153 0.756605   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    3.6681e+11
## Residual Sum of Squares: 1.5952e+11
## R-Squared:      0.56511
## Adj. R-Squared: 0.48357
## F-statistic: 6.93026 on 3 and 16 DF, p-value: 0.0033436

Los asteriscos me indican la relevancia de la variable en el modelo.

La Adj. R-Squared me dice la cantidad de puntos que están sobre la línea.

Siempre hay que dar prioridad a la Adj. R-Squared.

# Modelo 2. Efectos fijos (within)
within <- plm(EN.ATM.CO2E.KT ~ EG.FEC.RNEW.ZS + SP.URB.TOTL.IN.ZS + AG.LND.AGRI.ZS, data = panel, model = "within")
summary(within)
## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = EN.ATM.CO2E.KT ~ EG.FEC.RNEW.ZS + SP.URB.TOTL.IN.ZS + 
##     AG.LND.AGRI.ZS, data = panel, model = "within")
## 
## Balanced Panel: n = 5, T = 4, N = 20
## 
## Residuals:
##     Min.  1st Qu.   Median  3rd Qu.     Max. 
## -65601.0  -4652.2   -261.2   4404.5  71652.4 
## 
## Coefficients:
##                   Estimate Std. Error t-value Pr(>|t|)  
## EG.FEC.RNEW.ZS     -2325.4     1030.7 -2.2562  0.04351 *
## SP.URB.TOTL.IN.ZS   5630.1     3161.8  1.7807  0.10027  
## AG.LND.AGRI.ZS     -4817.8     7447.1 -0.6469  0.52985  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    2.0033e+10
## Residual Sum of Squares: 1.2546e+10
## R-Squared:      0.37373
## Adj. R-Squared: 0.0083984
## F-statistic: 2.38697 on 3 and 12 DF, p-value: 0.12004
# Prueba pF
pFtest(within,pooled)
## 
##  F test for individual effects
## 
## data:  EN.ATM.CO2E.KT ~ EG.FEC.RNEW.ZS + SP.URB.TOTL.IN.ZS + AG.LND.AGRI.ZS
## F = 35.144, df1 = 4, df2 = 12, p-value = 1.545e-06
## alternative hypothesis: significant effects

En este caso el modelo de ‘pooled’ es mejor que el de ‘within’ porque se pueden observar más * a un lado de las variables, de igual forma la Adj. R-Squared de ‘pooled’ es más cercana a 1, lo que de igual forma nos indica que es un mejor modelo a comparación con el de ‘within’.

# Modelo 3. Efectos aleatorios (random) - Método walhus
walhus <- plm(EN.ATM.CO2E.KT ~ EG.FEC.RNEW.ZS + SP.URB.TOTL.IN.ZS + AG.LND.AGRI.ZS, data = panel, model = "random", random.method="walhus")
summary(walhus)
## Oneway (individual) effect Random Effect Model 
##    (Wallace-Hussain's transformation)
## 
## Call:
## plm(formula = EN.ATM.CO2E.KT ~ EG.FEC.RNEW.ZS + SP.URB.TOTL.IN.ZS + 
##     AG.LND.AGRI.ZS, data = panel, model = "random", random.method = "walhus")
## 
## Balanced Panel: n = 5, T = 4, N = 20
## 
## Effects:
##                     var   std.dev share
## idiosyncratic 5.456e+09 7.386e+04 0.684
## individual    2.520e+09 5.020e+04 0.316
## theta: 0.4074
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
## -102642  -34418  -11046   17706  183325 
## 
## Coefficients:
##                    Estimate Std. Error z-value Pr(>|z|)
## (Intercept)       604781.74  377280.91  1.6030   0.1089
## EG.FEC.RNEW.ZS     -2582.41    1898.47 -1.3603   0.1737
## SP.URB.TOTL.IN.ZS  -5293.62    4816.46 -1.0991   0.2717
## AG.LND.AGRI.ZS       908.12    1503.49  0.6040   0.5458
## 
## Total Sum of Squares:    1.418e+11
## Residual Sum of Squares: 9.0765e+10
## R-Squared:      0.35992
## Adj. R-Squared: 0.23991
## Chisq: 8.99696 on 3 DF, p-value: 0.029331

Como no sale ningún * este método me indica que es peor a los anteriores, pero la Adj. R-Squared si es mejor que la de ‘within’. En este caso hay que dar prioridad a la Adj. R-Squared, lo cual nos indica que este modelo ‘walhus’ es mejor que el modelo ‘within’ aunque no tenga asteriscos.

# Modelo 3.1 Efectos aleatorios (random) - Método amemiya
amemiya <- plm(EN.ATM.CO2E.KT ~ EG.FEC.RNEW.ZS + SP.URB.TOTL.IN.ZS + AG.LND.AGRI.ZS, data = panel, model = "random", random.method="amemiya")
summary(amemiya)
## Oneway (individual) effect Random Effect Model 
##    (Amemiya's transformation)
## 
## Call:
## plm(formula = EN.ATM.CO2E.KT ~ EG.FEC.RNEW.ZS + SP.URB.TOTL.IN.ZS + 
##     AG.LND.AGRI.ZS, data = panel, model = "random", random.method = "amemiya")
## 
## Balanced Panel: n = 5, T = 4, N = 20
## 
## Effects:
##                     var   std.dev share
## idiosyncratic 8.364e+08 2.892e+04 0.021
## individual    3.966e+10 1.991e+05 0.979
## theta: 0.9276
## 
## Residuals:
##     Min.  1st Qu.   Median  3rd Qu.     Max. 
## -50889.6  -9549.8  -4287.7   1382.3  91281.3 
## 
## Coefficients:
##                     Estimate Std. Error z-value Pr(>|z|)  
## (Intercept)       -308381.32  259915.46 -1.1865  0.23544  
## EG.FEC.RNEW.ZS      -2236.96     958.68 -2.3334  0.01963 *
## SP.URB.TOTL.IN.ZS    6156.92    2717.24  2.2659  0.02346 *
## AG.LND.AGRI.ZS       -259.79    3193.72 -0.0813  0.93517  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    2.1852e+10
## Residual Sum of Squares: 1.4785e+10
## R-Squared:      0.32339
## Adj. R-Squared: 0.19653
## Chisq: 7.64745 on 3 DF, p-value: 0.053889
# Modelo 3.2 Efectos aleatorios (random) - Método nerlove
nerlove <- plm(EN.ATM.CO2E.KT ~ EG.FEC.RNEW.ZS + SP.URB.TOTL.IN.ZS + AG.LND.AGRI.ZS, data = panel, model = "random", random.method="nerlove")
summary(nerlove)
## Oneway (individual) effect Random Effect Model 
##    (Nerlove's transformation)
## 
## Call:
## plm(formula = EN.ATM.CO2E.KT ~ EG.FEC.RNEW.ZS + SP.URB.TOTL.IN.ZS + 
##     AG.LND.AGRI.ZS, data = panel, model = "random", random.method = "nerlove")
## 
## Balanced Panel: n = 5, T = 4, N = 20
## 
## Effects:
##                     var   std.dev share
## idiosyncratic 6.273e+08 2.505e+04 0.012
## individual    4.983e+10 2.232e+05 0.988
## theta: 0.944
## 
## Residuals:
##      Min.   1st Qu.    Median   3rd Qu.      Max. 
## -53402.84  -9145.02  -3809.63    744.93  87580.93 
## 
## Coefficients:
##                     Estimate Std. Error z-value Pr(>|z|)  
## (Intercept)       -294948.37  279648.48 -1.0547  0.29156  
## EG.FEC.RNEW.ZS      -2250.45     936.20 -2.4038  0.01623 *
## SP.URB.TOTL.IN.ZS    6183.64    2682.50  2.3052  0.02116 *
## AG.LND.AGRI.ZS       -810.95    3755.61 -0.2159  0.82904  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    2.1121e+10
## Residual Sum of Squares: 1.4028e+10
## R-Squared:      0.33584
## Adj. R-Squared: 0.21132
## Chisq: 8.09074 on 3 DF, p-value: 0.044173
# Prueba de Hausman
phtest(amemiya,within)
## 
##  Hausman Test
## 
## data:  EN.ATM.CO2E.KT ~ EG.FEC.RNEW.ZS + SP.URB.TOTL.IN.ZS + AG.LND.AGRI.ZS
## chisq = 0.57227, df = 3, p-value = 0.9028
## alternative hypothesis: one model is inconsistent

Esto nos indica que un modelo si es mejor que otro, en este caso el de ‘within’ ya que el Adj. R-Squared es más cercano a 1 a comparación con el modelo ‘amemiya’. Aun así, el modelo ‘pooled’ sigue siendo el mejor.

Tarea 3. Patentes

Integrantes: Regina Enríquez, Maximiliano Carvajal, Guillermo Cazares

#install.packages("psych")
#install.packages("xlsx")
library(psych)
## 
## Attaching package: 'psych'
## The following objects are masked from 'package:ggplot2':
## 
##     %+%, alpha
library(dplyr)
library(readxl)
library(xlsx)
#Import Data
patente <- read.csv("PATENT 3.csv")
patente <- patente[,1:12]
patente <- pdata.frame(patente, index = c("cusip", "year"))
#EDA
summary(patente)
##      cusip          merger            employ           return      
##  800    :  10   Min.   :0.00000   Min.   :  0.00   Min.   :-73.00  
##  4626   :  10   1st Qu.:0.00000   1st Qu.:  1.00   1st Qu.:  5.00  
##  4671   :  10   Median :0.00000   Median :  4.00   Median :  8.00  
##  7500   :  10   Mean   :0.01778   Mean   : 18.75   Mean   :  8.02  
##  7603   :  10   3rd Qu.:0.00000   3rd Qu.: 15.00   3rd Qu.: 11.00  
##  20753  :  10   Max.   :1.00000   Max.   :507.00   Max.   : 49.00  
##  (Other):2190                                                      
##     patents       patentsg           stckpr            rnd         
##  Min.   :  0   Min.   :   0.00   Min.   :  0.00   Min.   :   0.00  
##  1st Qu.:  1   1st Qu.:   1.00   1st Qu.:  8.00   1st Qu.:   1.00  
##  Median :  3   Median :   4.00   Median : 17.00   Median :   2.00  
##  Mean   : 23   Mean   :  27.26   Mean   : 22.71   Mean   :  29.44  
##  3rd Qu.: 15   3rd Qu.:  19.00   3rd Qu.: 29.00   3rd Qu.:  12.00  
##  Max.   :906   Max.   :1063.00   Max.   :402.00   Max.   :1719.00  
##                                                                    
##     rndeflt            sales               sic            year    
##  Min.   :   0.00   Min.   :    1.00   Min.   :2000   2012   :225  
##  1st Qu.:   0.00   1st Qu.:   54.25   1st Qu.:2890   2013   :225  
##  Median :   1.00   Median :  176.50   Median :3531   2014   :225  
##  Mean   :  19.79   Mean   : 1223.54   Mean   :3334   2015   :225  
##  3rd Qu.:   9.00   3rd Qu.:  740.50   3rd Qu.:3661   2016   :225  
##  Max.   :1001.00   Max.   :44224.00   Max.   :9997   2017   :225  
##                                                      (Other):900
psych::describe(patente)
##          vars    n    mean      sd median trimmed    mad  min   max range  skew
## cusip*      1 2250  113.00   64.97  113.0  113.00  83.03    1   225   224  0.00
## merger      2 2250    0.02    0.13    0.0    0.00   0.00    0     1     1  7.29
## employ      3 2250   18.75   49.96    4.0    8.31   4.45    0   507   507  6.17
## return      4 2250    8.02    5.55    8.0    7.83   4.45  -73    49   122 -0.96
## patents     5 2250   23.00   69.91    3.0    8.73   4.45    0   906   906  7.76
## patentsg    6 2250   27.26   79.35    4.0   11.02   5.93    0  1063  1063  7.39
## stckpr      7 2250   22.71   25.50   17.0   18.70  14.83    0   402   402  5.37
## rnd         8 2250   29.44  124.66    2.0    6.96   2.97    0  1719  1719  8.98
## rndeflt     9 2250   19.79   80.61    1.0    4.83   1.48    0  1001  1001  8.07
## sales      10 2250 1223.54 3712.01  176.5  431.68 226.10    1 44224 44223  6.63
## sic        11 2250 3334.15  654.47 3531.0 3372.52 269.83 2000  9997  7997  4.18
## year*      12 2250    5.50    2.87    5.5    5.50   3.71    1    10     9  0.00
##          kurtosis    se
## cusip*      -1.20  1.37
## merger      51.22  0.00
## employ      44.41  1.05
## return      24.82  0.12
## patents     76.94  1.47
## patentsg    69.84  1.67
## stckpr      52.54  0.54
## rnd         95.41  2.63
## rndeflt     73.21  1.70
## sales       54.32 78.26
## sic         45.79 13.80
## year*       -1.23  0.06
#Tratamiento de NA's
# Código para obtener el % de NA por columna
porcentaje_NA <- colSums(is.na(patente)) / nrow(patente) * 100
# Mostrar el resultado
porcentaje_NA
##    cusip   merger   employ   return  patents patentsg   stckpr      rnd 
##        0        0        0        0        0        0        0        0 
##  rndeflt    sales      sic     year 
##        0        0        0        0
#Pruebas de autocorrelación y heteroscedasticidad

plotmeans(patentsg ~ cusip, data = patente, n.label=FALSE, main= "Heterogeneidad entre firmas")

plotmeans(patentsg ~ year, data = patente, n.label=FALSE, main= "Heterogeneidad por años")

# Modelo 1. Regresión agrupada (pooled)
pooled1 <- plm(patentsg ~ return + employ + rnd + sales, data = patente, model = "pooling")
summary(pooled1)
## Pooling Model
## 
## Call:
## plm(formula = patentsg ~ return + employ + rnd + sales, data = patente, 
##     model = "pooling")
## 
## Balanced Panel: n = 225, T = 10, N = 2250
## 
## Residuals:
##      Min.   1st Qu.    Median   3rd Qu.      Max. 
## -442.5435  -10.5304   -4.6064    1.7056  529.9156 
## 
## Coefficients:
##                Estimate  Std. Error t-value  Pr(>|t|)    
## (Intercept) -2.53818295  2.00364931 -1.2668    0.2054    
## return       0.89882599  0.20031729  4.4870 7.588e-06 ***
## employ       1.50534937  0.04795130 31.3933 < 2.2e-16 ***
## rnd         -0.07849107  0.01848652 -4.2459 2.266e-05 ***
## sales       -0.00271798  0.00054088 -5.0251 5.428e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    14161000
## Residual Sum of Squares: 6169000
## R-Squared:      0.56435
## Adj. R-Squared: 0.56357
## F-statistic: 727.051 on 4 and 2245 DF, p-value: < 2.22e-16
# Modelo 2. Efectos fijos (within)
within1 <- plm(patentsg ~ return + employ + rnd + sales, data = patente, model =  "within")
summary(within1)
## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = patentsg ~ return + employ + rnd + sales, data = patente, 
##     model = "within")
## 
## Balanced Panel: n = 225, T = 10, N = 2250
## 
## Residuals:
##       Min.    1st Qu.     Median    3rd Qu.       Max. 
## -218.73410   -1.90671   -0.31204    1.51679  269.88092 
## 
## Coefficients:
##          Estimate Std. Error  t-value  Pr(>|t|)    
## return -0.0032470  0.0897144  -0.0362    0.9711    
## employ -0.0575524  0.0606945  -0.9482    0.3431    
## rnd    -0.1442205  0.0119849 -12.0335 < 2.2e-16 ***
## sales  -0.0015633  0.0003528  -4.4312 9.872e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    715640
## Residual Sum of Squares: 590370
## R-Squared:      0.17504
## Adj. R-Squared: 0.081968
## F-statistic: 107.202 on 4 and 2021 DF, p-value: < 2.22e-16
# Prueba pF
pFtest(within1,pooled1)
## 
##  F test for individual effects
## 
## data:  patentsg ~ return + employ + rnd + sales
## F = 85.256, df1 = 224, df2 = 2021, p-value < 2.2e-16
## alternative hypothesis: significant effects
# Modelo 3. Efectos aleatorios (random) - Método walhus
walhus1 <- plm(patentsg ~ return + employ + rnd + sales, data = patente, model = "random", random.method="walhus")
summary(walhus1)
## Oneway (individual) effect Random Effect Model 
##    (Wallace-Hussain's transformation)
## 
## Call:
## plm(formula = patentsg ~ return + employ + rnd + sales, data = patente, 
##     model = "random", random.method = "walhus")
## 
## Balanced Panel: n = 225, T = 10, N = 2250
## 
## Effects:
##                   var std.dev share
## idiosyncratic  419.34   20.48 0.153
## individual    2322.46   48.19 0.847
## theta: 0.8668
## 
## Residuals:
##       Min.    1st Qu.     Median    3rd Qu.       Max. 
## -147.41970   -3.95214   -2.55913   -0.11644  316.47117 
## 
## Coefficients:
##                Estimate  Std. Error z-value  Pr(>|z|)    
## (Intercept) 17.78900639  3.22493375  5.5161 3.466e-08 ***
## return       0.06266189  0.09910040  0.6323    0.5272    
## employ       0.80860589  0.04913451 16.4570 < 2.2e-16 ***
## rnd         -0.11358574  0.01289051 -8.8116 < 2.2e-16 ***
## sales       -0.00232998  0.00037996 -6.1322 8.665e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    954090
## Residual Sum of Squares: 813500
## R-Squared:      0.14736
## Adj. R-Squared: 0.14584
## Chisq: 387.993 on 4 DF, p-value: < 2.22e-16
# Modelo 3.1 Efectos aleatorios (random) - Método amemiya
amemiya1 <- plm(patentsg ~ return + employ + rnd + sales, data = patente, model = "random", random.method="amemiya")
summary(amemiya1)
## Oneway (individual) effect Random Effect Model 
##    (Amemiya's transformation)
## 
## Call:
## plm(formula = patentsg ~ return + employ + rnd + sales, data = patente, 
##     model = "random", random.method = "amemiya")
## 
## Balanced Panel: n = 225, T = 10, N = 2250
## 
## Effects:
##                   var std.dev share
## idiosyncratic  291.54   17.07 0.031
## individual    9195.47   95.89 0.969
## theta: 0.9438
## 
## Residuals:
##       Min.    1st Qu.     Median    3rd Qu.       Max. 
## -174.82200   -3.06717   -1.81866    0.34135  292.16706 
## 
## Coefficients:
##                Estimate  Std. Error  z-value  Pr(>|z|)    
## (Intercept) 29.25087312  6.48511746   4.5105 6.469e-06 ***
## return       0.01382987  0.08902992   0.1553    0.8766    
## employ       0.21701390  0.05564707   3.8998 9.626e-05 ***
## rnd         -0.13463308  0.01182496 -11.3855 < 2.2e-16 ***
## sales       -0.00180637  0.00034825  -5.1871 2.136e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    758130
## Residual Sum of Squares: 647790
## R-Squared:      0.14554
## Adj. R-Squared: 0.14402
## Chisq: 382.393 on 4 DF, p-value: < 2.22e-16
# Modelo 3.2 Efectos aleatorios (random) - Método nerlove
nerlove1 <- plm(patentsg ~ return + employ + rnd + sales, data = patente, model = "random", random.method="nerlove")
summary(nerlove1)
## Oneway (individual) effect Random Effect Model 
##    (Nerlove's transformation)
## 
## Call:
## plm(formula = patentsg ~ return + employ + rnd + sales, data = patente, 
##     model = "random", random.method = "nerlove")
## 
## Balanced Panel: n = 225, T = 10, N = 2250
## 
## Effects:
##                   var std.dev share
## idiosyncratic  262.39   16.20 0.028
## individual    9265.80   96.26 0.972
## theta: 0.9469
## 
## Residuals:
##       Min.    1st Qu.     Median    3rd Qu.       Max. 
## -176.59240   -3.00166   -1.76173    0.38987  290.97104 
## 
## Coefficients:
##                Estimate  Std. Error  z-value  Pr(>|z|)    
## (Intercept) 29.72678963  6.82036888   4.3585 1.309e-05 ***
## return       0.01220865  0.08866824   0.1377 0.8904862    
## employ       0.19225413  0.05584827   3.4424 0.0005765 ***
## rnd         -0.13550037  0.01178374 -11.4989 < 2.2e-16 ***
## sales       -0.00178445  0.00034702  -5.1422 2.715e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    753600
## Residual Sum of Squares: 642330
## R-Squared:      0.14765
## Adj. R-Squared: 0.14613
## Chisq: 388.894 on 4 DF, p-value: < 2.22e-16
# Prueba de Hausman
phtest(nerlove1,within1)
## 
##  Hausman Test
## 
## data:  patentsg ~ return + employ + rnd + sales
## chisq = 113.03, df = 4, p-value < 2.2e-16
## alternative hypothesis: one model is inconsistent

Conclusión

Al comparar todos los modelos de panel, identificamos que el mejor modelo fue el de ‘pooled’ debido a que el Adjusted R^2 es de 0.564 a comparación con todos los demás que son por debajo del 0.2. De igual forma se encontró una gran significancia en las variables del modelo lo cual indica que el modelo es óptimo.

LS0tCnRpdGxlOiAiQWN0aXZpZGFkIDEgLSBBbsOhbGlzaXMgeSBhcGxpY2FjacOzbiBkZSBkYXRvcyBwYW5lbCIKYXV0aG9yOiAiUmVnaW5hIEVucsOtcXVleiAtIEEwMTcyMTQzNSIKZGF0ZTogIjIwMjQtMDItMTMiCm91dHB1dDogCiAgaHRtbF9kb2N1bWVudDoKICAgIHRvYzogVFJVRQogICAgdG9jX2Zsb2F0OiBUUlVFCiAgICBjb2RlX2Rvd25sb2FkOiBUUlVFCi0tLQpgYGB7ciBzZXR1cCwgaW5jbHVkZT1GQUxTRX0Ka25pdHI6Om9wdHNfY2h1bmskc2V0KGVjaG8gPSBUUlVFKQpgYGAKCiFbZ2lmXShwYXRlbnQgcGVuZGluZy53ZWJwKQoKYGBge3J9CiMgSW5zdGFsYXIgcGFxdWV0ZXMgeSBsbGFtYXIgbGlicmVyw61hcwojaW5zdGFsbC5wYWNrYWdlcygiV0RJIikKbGlicmFyeShXREkpCiNpbnN0YWxsLnBhY2thZ2VzKCJ3YnN0YXRzIikKbGlicmFyeSh3YnN0YXRzKQojaW5zdGFsbC5wYWNrYWdlcygidGlkeXZlcnNlIikKbGlicmFyeSh0aWR5dmVyc2UpCiNpbnN0YWxsLnBhY2thZ2VzKCJncGxvdHMiKQpsaWJyYXJ5KGdwbG90cykKI2luc3RhbGwucGFja2FnZXMoInBsbSIpCmxpYnJhcnkocGxtKQpgYGAKCiMjIFIgU2NyaXB0ICJQYW5lbCIgcGFyYSBvYnRlbmVyIEluZGljYWRvcmVzIGRlbCBCYW5jbyBNdW5kaWFsCgpgYGB7cn0KIyBPYnRlbmVyIGluZm9ybWFjacOzbiBkZSB2YXJpb3MgcGHDrXNlcwpnZHBfZGF0YTEgPC0gd2JfZGF0YShjb3VudHJ5PWMoIk1YIiwiRUMiLCJDQSIpLCBpbmRpY2F0b3IgPSAiTlkuR0RQLlBDQVAuQ0QiLCBzdGFydF9kYXRlPTIwMTMsIGVuZF9kYXRlPTIwMjMpCmdkcF9kYXRhMQpgYGAKCmBgYHtyfQojIEdlbmVyYXIgdW4gY29uanVudG8gZGUgZGF0b3MgZGUgcGFuZWwKcGFuZWwxIDwtIHNlbGVjdChnZHBfZGF0YTEsY291bnRyeSwgZGF0ZSwgTlkuR0RQLlBDQVAuQ0QpCmBgYAoKIyMgRWplcmNpY2lvIDIuIENvbmp1bnRvIGRlIERhdG9zIGRlIFBhbmVsIGNvbiBJbmRpY2Fkb3JlcyBkZWwgQmFuY28gTXVuZGlhbAojIyMjIEludGVncmFudGVzOiBSZWdpbmEgRW5yw61xdWV6LCBNYXhpbWlsaWFubyBDYXJ2YWphbCwgR3VpbGxlcm1vIENhemFyZXMKCmBgYHtyfQojIE9idGVuZXIgaW5mb3JtYWNpw7NuIGRlIHZhcmlvcyBwYcOtc2VzCmdkcF9kYXRhIDwtIHdiX2RhdGEoY291bnRyeT1jKCJNWCIsIk5PIiwiRkkiLCJTRSIsIkRLIiksIGluZGljYXRvciA9IGMoIkVOLkFUTS5DTzJFLktUIiwgIkVHLkZFQy5STkVXLlpTIiwgIlNQLlVSQi5UT1RMLklOLlpTIiwgIkFHLkxORC5BR1JJLlpTIiksIHN0YXJ0X2RhdGU9MTk1MCwgZW5kX2RhdGU9MjAyMCkKYGBgCiMjIyMjIEVOLkFUTS5DTzJFLktUIGVzIEVtaXNpb25lcyBkZSBDTzIgKGt0KQojIyMjIyBFRy5GRUMuUk5FVy5aUyBlcyBDb25zdW1vIGRlIGVuZXJnw61hIHJlbm92YWJsZSAoJSBkZWwgY29uc3VtbyB0b3RhbCBkZSBlbmVyZ8OtYSBmaW5hbCkKIyMjIyMgU1AuVVJCLlRPVEwuSU4uWlMgZXMgUG9ibGFjacOzbiB1cmJhbmEgKCUgZGVsIHRvdGFsKQojIyMjIyBBRy5MTkQuQUdSSS5aUyBlcyBUaWVycmFzIGFncsOtY29sYXMgKCUgZGVsIMOhcmVhIGRlIHRpZXJyYSkKCmBgYHtyfQojIEdlbmVyYXIgdW4gY29uanVudG8gZGUgZGF0b3MgZGUgcGFuZWwKcGFuZWwgPC0gc2VsZWN0KGdkcF9kYXRhLCBjb3VudHJ5LGRhdGUsRU4uQVRNLkNPMkUuS1QsRUcuRkVDLlJORVcuWlMsU1AuVVJCLlRPVEwuSU4uWlMsQUcuTE5ELkFHUkkuWlMpCnBhbmVsIDwtIHN1YnNldChwYW5lbCwgZGF0ZSA9PSAxOTkwIHwgZGF0ZSA9PSAyMDAwIHwgZGF0ZSA9PSAyMDEwIHwgZGF0ZSA9PSAyMDIwKQpwYW5lbCA8LSBwZGF0YS5mcmFtZShwYW5lbCwgaW5kZXggPSBjKCJjb3VudHJ5IiwgImRhdGUiKSkKcGFuZWwKYGBgCgpgYGB7cn0KIyBCdXNjYXIgc2kgZXMgcXVlIGhheSBOQXMgZW4gbG9zIGRhdG9zCm5hX2NvdW50IDwtIGNvbFN1bXMoaXMubmEocGFuZWwpKQpuYV9jb3VudApgYGAKCgojIyBUYXJlYSAyLiBHcsOhZmljYXMgZGUgSGV0ZXJvZ2VuZWlkYWQKIyMjIyBJbnRlZ3JhbnRlczogUmVnaW5hIEVucsOtcXVleiwgTWF4aW1pbGlhbm8gQ2FydmFqYWwsIEd1aWxsZXJtbyBDYXphcmVzCgpgYGB7ciwgd2FybmluZyA9IEZBTFNFfQojIEhldGVyb2dlbmVpZGFkCgojIEdyw6FmaWNvIHBhcmEgbGEgaGV0ZXJvZ2VuZWlkYWQgZW50cmUgcGHDrXNlcwpwbG90bWVhbnMoRU4uQVRNLkNPMkUuS1QgfiBjb3VudHJ5LCBkYXRhID0gcGFuZWwsIG1haW4gPSAiSGV0ZXJvZ2VuZWlkYWQgZW50cmUgcGHDrXNlcyIsIHhsYWIgPSAiUGHDrXMiLCB5bGFiID0gIlByb21lZGlvIGRlIENPMkUgKEtUKSIpCgojIEdyw6FmaWNvIHBhcmEgbGEgaGV0ZXJvZ2VuZWlkYWQgZW50cmUgYcOxb3MKcGxvdG1lYW5zKEVOLkFUTS5DTzJFLktUIH4gZGF0ZSwgZGF0YSA9IHBhbmVsLCBtYWluID0gIkhldGVyb2dlbmVpZGFkIGVudHJlIGHDsW9zIiwgeGxhYiA9ICJBw7FvIiwgeWxhYiA9ICJQcm9tZWRpbyBkZSBDTzJFIChLVCkiKQpgYGAKCiMjIyDCv0xhIGzDrW5lYSBxdWUgdW5lIGxvcyBwcm9tZWRpb3MgZXMgaG9yaXpvbnRhbCwgbyB0aWVuZSBtdWNob3MgcGljb3M/CiMjIyMgTGEgaGV0ZXJvZ2VuZWlkYWQgZW50cmUgcGHDrXNlcyB0aWVuZSB1biBwaWNvIGVuIE3DqXhpY28uIExhIGdyw6FmaWNhIGRlIGHDsW9zIGVzIGhvbW9nw6luZWEsIHB1ZXMgbWFudGllbmUgcHJvbWVkaW9zIGhvcml6b250YWxlcyBlbnRyZSBsb3MgYcOxb3MuCgojIyMgwr9Mb3MgaW50ZXJ2YWxvcyBkZSBjb25maWFuemEgbWlkZW4gbG8gbWlzbW8sIG8gZXN0w6FuIGRlc2Zhc2Fkb3M/CiMjIyMgTG9zIGludGVydmFsb3MgZGUgY29uZmlhbnphIGRlIGxvcyBwYcOtc2VzIGVzdMOhbiBkZXNmYXNhZG9zLCBwb3Igb3RybyBsYWRvLCBsb3MgaW50ZXJ2YWxvcyBkZSBjb25maWFuemEgZGUgbG9zIGHDsW9zIHRpZW5lbiB1bmEgdmFyaWFuemEgbGlnZXJhLCAKCiMjIyBJbnZlc3RpZ2EgZWwgY29uY2VwdG8gZGUgSGV0ZXJvZ2VuZWlkYWQgeSBkZXRlcm1pbmEgc2kgbG8gcXVlIHNlIHZlIGVuIGxhcyBncsOhZmljYXMgZXMgZGVzZWFibGUgbyBubyBkZXNlYWJsZS4KIyMjIyBFbCBjb25jZXB0byBkZSBoZXRlcm9nZW5laWRhZCBzZSByZWZpZXJlIGEgbGEgZGl2ZXJzaWRhZCB5IHZhcmlhYmlsaWRhZCBlbnRyZSBkaXN0aW50YXMgZW50aWRhZGVzIGRlbnRybyBkZSB1biBjb25qdW50byBvIHBvYmxhY2nDs24uIFBhcmEgdW4gZXN0dWRpbywgbGEgZ3LDoWZpY2EgZGUgcGHDrXNlcyBlcyBkZXNlYWRhIGRlYmlkbyBhIHF1ZSBzZSBpZGVudGlmaWNhIHVuYSBkaWZlcmVuY2lhIGVudHJlIGVsIHBhw61zIGRlIE3DqXhpY28gYSBkaWZlcmVuY2lhIGRlIGxvcyBkZW3DoXMgdGVycml0b3Jpb3MuIFBvciBvdHJvIGxhZG8sIGRlYmlkbyBhIHF1ZSBsYSBncsOhZmljYSBkZSBhw7FvcyBtYW50aWVuZSBwcm9tZWRpb3Mgc2ltaWxhcmVzLCBwYXJhIHVuIGVzdHVkaW8gZXN0byBubyBlcyBkZXNlYWRvLCBwdWVzIG5vIHNlIHB1ZWRlbiByZXNhbHRhciBvYnNlcnZhY2lvbmVzIHNpZ25pZmljYXRpdmFzIGVuIGxvcyBjYW1iaW9zIGRlIENPMiBhIHRyYXbDqXMgZGUgbG9zIGHDsW9zLgoKCiMjIEVqZXJjaWNpbyAzLiBNb2RlbG9zIGNvbiBJbmRpY2Fkb3JlcyBkZWwgQmFuY28gTXVuZGlhbAoKYGBge3J9CiMgTW9kZWxvIDEuIFJlZ3Jlc2nDs24gYWdydXBhZGEgKHBvb2xlZCkKcG9vbGVkIDwtIHBsbShFTi5BVE0uQ08yRS5LVCB+IEVHLkZFQy5STkVXLlpTICsgU1AuVVJCLlRPVEwuSU4uWlMgKyBBRy5MTkQuQUdSSS5aUywgZGF0YSA9IHBhbmVsLCBtb2RlbCA9ICJwb29saW5nIikKc3VtbWFyeShwb29sZWQpCmBgYAojIyMjIExvcyBhc3RlcmlzY29zIG1lIGluZGljYW4gbGEgcmVsZXZhbmNpYSBkZSBsYSB2YXJpYWJsZSBlbiBlbCBtb2RlbG8uCiMjIyMgTGEgQWRqLiBSLVNxdWFyZWQgbWUgZGljZSBsYSBjYW50aWRhZCBkZSBwdW50b3MgcXVlIGVzdMOhbiBzb2JyZSBsYSBsw61uZWEuCiMjIyMgU2llbXByZSBoYXkgcXVlIGRhciBwcmlvcmlkYWQgYSBsYSBBZGouIFItU3F1YXJlZC4KCmBgYHtyfQojIE1vZGVsbyAyLiBFZmVjdG9zIGZpam9zICh3aXRoaW4pCndpdGhpbiA8LSBwbG0oRU4uQVRNLkNPMkUuS1QgfiBFRy5GRUMuUk5FVy5aUyArIFNQLlVSQi5UT1RMLklOLlpTICsgQUcuTE5ELkFHUkkuWlMsIGRhdGEgPSBwYW5lbCwgbW9kZWwgPSAid2l0aGluIikKc3VtbWFyeSh3aXRoaW4pCmBgYAoKYGBge3J9CiMgUHJ1ZWJhIHBGCnBGdGVzdCh3aXRoaW4scG9vbGVkKQpgYGAKIyMjIyBFbiBlc3RlIGNhc28gZWwgbW9kZWxvIGRlICdwb29sZWQnIGVzIG1lam9yIHF1ZSBlbCBkZSAnd2l0aGluJyBwb3JxdWUgc2UgcHVlZGVuIG9ic2VydmFyIG3DoXMgKiBhIHVuIGxhZG8gZGUgbGFzIHZhcmlhYmxlcywgZGUgaWd1YWwgZm9ybWEgbGEgQWRqLiBSLVNxdWFyZWQgZGUgJ3Bvb2xlZCcgZXMgbcOhcyBjZXJjYW5hIGEgMSwgbG8gcXVlIGRlIGlndWFsIGZvcm1hIG5vcyBpbmRpY2EgcXVlIGVzIHVuIG1lam9yIG1vZGVsbyBhIGNvbXBhcmFjacOzbiBjb24gZWwgZGUgJ3dpdGhpbicuCgpgYGB7cn0KIyBNb2RlbG8gMy4gRWZlY3RvcyBhbGVhdG9yaW9zIChyYW5kb20pIC0gTcOpdG9kbyB3YWxodXMKd2FsaHVzIDwtIHBsbShFTi5BVE0uQ08yRS5LVCB+IEVHLkZFQy5STkVXLlpTICsgU1AuVVJCLlRPVEwuSU4uWlMgKyBBRy5MTkQuQUdSSS5aUywgZGF0YSA9IHBhbmVsLCBtb2RlbCA9ICJyYW5kb20iLCByYW5kb20ubWV0aG9kPSJ3YWxodXMiKQpzdW1tYXJ5KHdhbGh1cykKYGBgCiMjIyMgQ29tbyBubyBzYWxlIG5pbmfDum4gKiBlc3RlIG3DqXRvZG8gbWUgaW5kaWNhIHF1ZSBlcyBwZW9yIGEgbG9zIGFudGVyaW9yZXMsIHBlcm8gbGEgQWRqLiBSLVNxdWFyZWQgc2kgZXMgbWVqb3IgcXVlIGxhIGRlICd3aXRoaW4nLiBFbiBlc3RlIGNhc28gaGF5IHF1ZSBkYXIgcHJpb3JpZGFkIGEgbGEgQWRqLiBSLVNxdWFyZWQsIGxvIGN1YWwgbm9zIGluZGljYSBxdWUgZXN0ZSBtb2RlbG8gJ3dhbGh1cycgZXMgbWVqb3IgcXVlIGVsIG1vZGVsbyAnd2l0aGluJyBhdW5xdWUgbm8gdGVuZ2EgYXN0ZXJpc2Nvcy4KCmBgYHtyfQojIE1vZGVsbyAzLjEgRWZlY3RvcyBhbGVhdG9yaW9zIChyYW5kb20pIC0gTcOpdG9kbyBhbWVtaXlhCmFtZW1peWEgPC0gcGxtKEVOLkFUTS5DTzJFLktUIH4gRUcuRkVDLlJORVcuWlMgKyBTUC5VUkIuVE9UTC5JTi5aUyArIEFHLkxORC5BR1JJLlpTLCBkYXRhID0gcGFuZWwsIG1vZGVsID0gInJhbmRvbSIsIHJhbmRvbS5tZXRob2Q9ImFtZW1peWEiKQpzdW1tYXJ5KGFtZW1peWEpCmBgYAoKYGBge3J9CiMgTW9kZWxvIDMuMiBFZmVjdG9zIGFsZWF0b3Jpb3MgKHJhbmRvbSkgLSBNw6l0b2RvIG5lcmxvdmUKbmVybG92ZSA8LSBwbG0oRU4uQVRNLkNPMkUuS1QgfiBFRy5GRUMuUk5FVy5aUyArIFNQLlVSQi5UT1RMLklOLlpTICsgQUcuTE5ELkFHUkkuWlMsIGRhdGEgPSBwYW5lbCwgbW9kZWwgPSAicmFuZG9tIiwgcmFuZG9tLm1ldGhvZD0ibmVybG92ZSIpCnN1bW1hcnkobmVybG92ZSkKYGBgCgpgYGB7cn0KIyBQcnVlYmEgZGUgSGF1c21hbgpwaHRlc3QoYW1lbWl5YSx3aXRoaW4pCmBgYAojIyMjIEVzdG8gbm9zIGluZGljYSBxdWUgdW4gbW9kZWxvIHNpIGVzIG1lam9yIHF1ZSBvdHJvLCBlbiBlc3RlIGNhc28gZWwgZGUgJ3dpdGhpbicgeWEgcXVlIGVsIEFkai4gUi1TcXVhcmVkIGVzIG3DoXMgY2VyY2FubyBhIDEgYSBjb21wYXJhY2nDs24gY29uIGVsIG1vZGVsbyAnYW1lbWl5YScuIEF1biBhc8OtLCBlbCBtb2RlbG8gJ3Bvb2xlZCcgc2lndWUgc2llbmRvIGVsIG1lam9yLgoKCiMjIFRhcmVhIDMuIFBhdGVudGVzCiMjIyMgSW50ZWdyYW50ZXM6IFJlZ2luYSBFbnLDrXF1ZXosIE1heGltaWxpYW5vIENhcnZhamFsLCBHdWlsbGVybW8gQ2F6YXJlcwoKYGBge3J9CiNpbnN0YWxsLnBhY2thZ2VzKCJwc3ljaCIpCiNpbnN0YWxsLnBhY2thZ2VzKCJ4bHN4IikKbGlicmFyeShwc3ljaCkKbGlicmFyeShkcGx5cikKbGlicmFyeShyZWFkeGwpCmxpYnJhcnkoeGxzeCkKYGBgCgpgYGB7cn0KI0ltcG9ydCBEYXRhCnBhdGVudGUgPC0gcmVhZC5jc3YoIlBBVEVOVCAzLmNzdiIpCnBhdGVudGUgPC0gcGF0ZW50ZVssMToxMl0KcGF0ZW50ZSA8LSBwZGF0YS5mcmFtZShwYXRlbnRlLCBpbmRleCA9IGMoImN1c2lwIiwgInllYXIiKSkKYGBgCgpgYGB7cn0KI0VEQQpzdW1tYXJ5KHBhdGVudGUpCnBzeWNoOjpkZXNjcmliZShwYXRlbnRlKQpgYGAKCmBgYHtyfQojVHJhdGFtaWVudG8gZGUgTkEncwojIEPDs2RpZ28gcGFyYSBvYnRlbmVyIGVsICUgZGUgTkEgcG9yIGNvbHVtbmEKcG9yY2VudGFqZV9OQSA8LSBjb2xTdW1zKGlzLm5hKHBhdGVudGUpKSAvIG5yb3cocGF0ZW50ZSkgKiAxMDAKIyBNb3N0cmFyIGVsIHJlc3VsdGFkbwpwb3JjZW50YWplX05BCmBgYAoKYGBge3IsIHdhcm5pbmcgPSBGQUxTRX0KI1BydWViYXMgZGUgYXV0b2NvcnJlbGFjacOzbiB5IGhldGVyb3NjZWRhc3RpY2lkYWQKCnBsb3RtZWFucyhwYXRlbnRzZyB+IGN1c2lwLCBkYXRhID0gcGF0ZW50ZSwgbi5sYWJlbD1GQUxTRSwgbWFpbj0gIkhldGVyb2dlbmVpZGFkIGVudHJlIGZpcm1hcyIpCnBsb3RtZWFucyhwYXRlbnRzZyB+IHllYXIsIGRhdGEgPSBwYXRlbnRlLCBuLmxhYmVsPUZBTFNFLCBtYWluPSAiSGV0ZXJvZ2VuZWlkYWQgcG9yIGHDsW9zIikKYGBgCgpgYGB7cn0KIyBNb2RlbG8gMS4gUmVncmVzacOzbiBhZ3J1cGFkYSAocG9vbGVkKQpwb29sZWQxIDwtIHBsbShwYXRlbnRzZyB+IHJldHVybiArIGVtcGxveSArIHJuZCArIHNhbGVzLCBkYXRhID0gcGF0ZW50ZSwgbW9kZWwgPSAicG9vbGluZyIpCnN1bW1hcnkocG9vbGVkMSkKYGBgCgpgYGB7cn0KIyBNb2RlbG8gMi4gRWZlY3RvcyBmaWpvcyAod2l0aGluKQp3aXRoaW4xIDwtIHBsbShwYXRlbnRzZyB+IHJldHVybiArIGVtcGxveSArIHJuZCArIHNhbGVzLCBkYXRhID0gcGF0ZW50ZSwgbW9kZWwgPSAgIndpdGhpbiIpCnN1bW1hcnkod2l0aGluMSkKYGBgCgpgYGB7cn0KIyBQcnVlYmEgcEYKcEZ0ZXN0KHdpdGhpbjEscG9vbGVkMSkKYGBgCgpgYGB7cn0KIyBNb2RlbG8gMy4gRWZlY3RvcyBhbGVhdG9yaW9zIChyYW5kb20pIC0gTcOpdG9kbyB3YWxodXMKd2FsaHVzMSA8LSBwbG0ocGF0ZW50c2cgfiByZXR1cm4gKyBlbXBsb3kgKyBybmQgKyBzYWxlcywgZGF0YSA9IHBhdGVudGUsIG1vZGVsID0gInJhbmRvbSIsIHJhbmRvbS5tZXRob2Q9IndhbGh1cyIpCnN1bW1hcnkod2FsaHVzMSkKYGBgCgpgYGB7cn0KIyBNb2RlbG8gMy4xIEVmZWN0b3MgYWxlYXRvcmlvcyAocmFuZG9tKSAtIE3DqXRvZG8gYW1lbWl5YQphbWVtaXlhMSA8LSBwbG0ocGF0ZW50c2cgfiByZXR1cm4gKyBlbXBsb3kgKyBybmQgKyBzYWxlcywgZGF0YSA9IHBhdGVudGUsIG1vZGVsID0gInJhbmRvbSIsIHJhbmRvbS5tZXRob2Q9ImFtZW1peWEiKQpzdW1tYXJ5KGFtZW1peWExKQpgYGAKCmBgYHtyfQojIE1vZGVsbyAzLjIgRWZlY3RvcyBhbGVhdG9yaW9zIChyYW5kb20pIC0gTcOpdG9kbyBuZXJsb3ZlCm5lcmxvdmUxIDwtIHBsbShwYXRlbnRzZyB+IHJldHVybiArIGVtcGxveSArIHJuZCArIHNhbGVzLCBkYXRhID0gcGF0ZW50ZSwgbW9kZWwgPSAicmFuZG9tIiwgcmFuZG9tLm1ldGhvZD0ibmVybG92ZSIpCnN1bW1hcnkobmVybG92ZTEpCmBgYAoKYGBge3J9CiMgUHJ1ZWJhIGRlIEhhdXNtYW4KcGh0ZXN0KG5lcmxvdmUxLHdpdGhpbjEpCmBgYAoKIyMjIENvbmNsdXNpw7NuCiMjIyMgQWwgY29tcGFyYXIgdG9kb3MgbG9zIG1vZGVsb3MgZGUgcGFuZWwsIGlkZW50aWZpY2Ftb3MgcXVlIGVsIG1lam9yIG1vZGVsbyBmdWUgZWwgZGUgJ3Bvb2xlZCcgZGViaWRvIGEgcXVlIGVsIEFkanVzdGVkIFJeMiBlcyBkZSAwLjU2NCBhIGNvbXBhcmFjacOzbiBjb24gdG9kb3MgbG9zIGRlbcOhcyBxdWUgc29uIHBvciBkZWJham8gZGVsIDAuMi4gRGUgaWd1YWwgZm9ybWEgc2UgZW5jb250csOzIHVuYSBncmFuIHNpZ25pZmljYW5jaWEgZW4gbGFzIHZhcmlhYmxlcyBkZWwgbW9kZWxvIGxvIGN1YWwgaW5kaWNhIHF1ZSBlbCBtb2RlbG8gZXMgw7NwdGltby4K