Tarea 1: Integración de Tema 1

1 Actividad 1. Análisis y aplicación de datos panel

1.0.1 Pregunta detonadora:

¿Qué factores afectan la probabilidad de tener una pareja?

• Edad: numérico años
• Hobbies: numérico cantidad
• Trabajo: binaria
• Salario: numérico cantidad
• Índice de atractividad: numérico
• Dating apps: numérico cantidad de apps donde está
  • ¿Qué app?: numérico categórico
• Preferencia sexual: numérico categórico
• Autoestima: numérico índice
• Parejas anteriores: numérico cantidad

1.0.1.1 Modelo económico →

relación = f(edad, hobbies, trabajo, dinero, índice de atractividad, dating apps, preferencia sexual, autoestima

1.0.1.2 Modelo econométrico →

relación = B0+ (b1edad^2) + (b2hobbies) + (b3trabajo)+ (b4dinero)+(b5atractividad) +(b6 dating apps)+(b7preferencia sexual)+(b8 autoestima) +(b9que_app)+(b10parejas anteriores )+ mu

2 Tarea 1. Definición de Tipo de Datos

2.1 Datos Panel

Los datos panel son aquellos que contienen observaciones de múltiples unidades a lo largo del tiempo, es decir, que una unidad puede ser repetida puesto se observa en varios periodos de tiempo.¹ Este tipo de datos permite analizar los datos de interés dentro de cada unidad a lo largo del tiempo.

2.2 Datos Transversales

Los datos transversales son observaciones de múltiples unidades, pero en un solo periodo de tiempo. Son útiles para realizar análisis descriptivos y comparativos.²

2.3 Datos Series de Tiempo

Los datos de series de tiempo tienen observaciones de una sola variable (o varias variables) en distintos periodos de tiempo, pero de manera regular y secuencial. Se pueden mencionar como aquellos datos que son recopilados de forma periódica en algún intérvalo de tiempo. ³

3 Indicadores del Banco Mundial

3.1 Tema 1 DATOS PANEL

3.1.1 Actividad 1

3.1.1.0.0.1 Obtener información de un país

Para obtener información directamente se puede buscar el indicador dentro de la página de indicadores del banco mundial y sacar el código que sale en el enlace de la página. Los códigos de 2 letras de los países estan en la ISO 3166-1.

Ejemplo de sacar indicador:

https://data.worldbank.org/indicator/NY.GDP.PCAP.CD?view=chart

El código del indicador es NY.GDP.PCAP.CD.

## Obtiene info de 1 país
gdp_data<- wb_data(country = "MX", indicator = "NY.GDP.PCAP.CD", start_date = 2013, end_date = 2023 )

kable(head(gdp_data)) %>% kable_classic_2()

iso2c	iso3c	country	date	NY.GDP.PCAP.CD	unit	obs_status	footnote	last_updated
MX	MEX	Mexico	2013	11317.491	NA	NA	NA	2024-02-21
MX	MEX	Mexico	2014	11490.022	NA	NA	NA	2024-02-21
MX	MEX	Mexico	2015	10098.173	NA	NA	NA	2024-02-21
MX	MEX	Mexico	2016	9152.737	NA	NA	NA	2024-02-21
MX	MEX	Mexico	2017	9693.330	NA	NA	NA	2024-02-21
MX	MEX	Mexico	2018	10130.321	NA	NA	NA	2024-02-21

Se generó la extracción de un indicador de PIB per cápita de México para los años de 2013 a 2023.

##Obtiene info de más países
gdp_data2<- wb_data(country = c("MX", "EC", "CA"), indicator = "NY.GDP.PCAP.CD", start_date = 2013, end_date = 2023 )

kable(head(gdp_data2)) %>% kable_classic()

iso2c	iso3c	country	date	NY.GDP.PCAP.CD	unit	obs_status	footnote	last_updated
CA	CAN	Canada	2013	52635.17	NA	NA	NA	2024-02-21
CA	CAN	Canada	2014	50956.00	NA	NA	NA	2024-02-21
CA	CAN	Canada	2015	43596.14	NA	NA	NA	2024-02-21
CA	CAN	Canada	2016	42315.60	NA	NA	NA	2024-02-21
CA	CAN	Canada	2017	45129.43	NA	NA	NA	2024-02-21
CA	CAN	Canada	2018	46548.64	NA	NA	NA	2024-02-21

Estos son datos de panel porque se tiene diferentes países en diferentes periodos de tiempo con la misma regularidad. Se tiene el mismo indicador de PIB per cápita de los mismos 10 años agregando a Ecuador y Canada.

3.1.1.0.0.2 Limpieza de información

Para tener solo la información necesaria.

panel<- gdp_data2 %>% select(country, date, NY.GDP.PCAP.CD)
kable(head(panel)) %>% kable_classic()

country	date	NY.GDP.PCAP.CD
Canada	2013	52635.17
Canada	2014	50956.00
Canada	2015	43596.14
Canada	2016	42315.60
Canada	2017	45129.43
Canada	2018	46548.64

4 Ejercicio 2. Conjunto de Datos Panel con Indicadores del Banco Central

4.0.0.0.0.1 Extraccion de datos

Variable endógena:

• Life Expectancy Total (years). https://data.worldbank.org/indicator/SP.DYN.LE00.IN?view=chart

Parámetros:

• CO2 Emissions. https://data.worldbank.org/indicator/EN.ATM.CO2E.PC?view=chart

• Investment in water and sanitation. https://data.worldbank.org/indicator/IE.PPI.WATR.CD?view=chart

• GDP. https://data.worldbank.org/indicator/NY.GDP.PCAP.CD?view=chart

• Population Density. https://data.worldbank.org/indicator/EN.POP.DNST?view=chart

• Cantidad de camas disponibles. https://data.worldbank.org/indicator/SH.MED.BEDS.ZS?view=chart

• Immunization. Children 12 to 23 months. https://data.worldbank.org/indicator/SH.IMM.IDPT?view=chart

• Surgical Specialists per 1000 habitants. https://data.worldbank.org/indicator/SH.MED.SAOP.P5?view=chart

• Intentional Homocides per 100,000. https://data.worldbank.org/indicator/VC.IHR.PSRC.P5?view=chart

• Population living in slums. https://data.worldbank.org/indicator/EN.POP.SLUM.UR.ZS?view=chart

panel_salud<- wb_data(country = c("MX", "CA", "US", "CH", "CO","CN" ), indicator =c("SP.DYN.LE00.IN", 
                                                                  "EN.ATM.CO2E.PC",
                                                                  "IE.PPI.WATR.CD", 
                                                                  "NY.GDP.PCAP.CD", 
                                                                  "EN.POP.DNST", 
                                                                  "SH.MED.BEDS.ZS",
                                                                  "SH.IMM.IDPT",
                                                                  "SH.MED.SAOP.P5", 
                                                                  "VC.IHR.PSRC.P5",
                                                                  "EN.POP.SLUM.UR.ZS"), start_date =1950 , end_date=2023)
panel_salud<-subset(panel_salud, date==1990| date==2000 | date==2010| date==2020)
panel_salud<- pdata.frame(panel_salud, index = c("country", "date"))
kable(head(panel_salud)) %>% kable_classic()

iso2c	iso3c	country	date	EN.ATM.CO2E.PC	EN.POP.DNST	EN.POP.SLUM.UR.ZS	IE.PPI.WATR.CD	NY.GDP.PCAP.CD	SH.IMM.IDPT	SH.MED.BEDS.ZS	SH.MED.SAOP.P5	SP.DYN.LE00.IN	VC.IHR.PSRC.P5
CA	CAN	Canada	1990	15.148969	3.088602	NA	NA	21525.8611	88	6.00	NA	77.43659	2.375511
CA	CAN	Canada	2000	16.757467	3.422611	NA	NA	24271.0021	89	3.77	NA	79.16683	1.779469
CA	CAN	Canada	2010	15.794538	3.792822	NA	NA	47562.0834	89	2.78	NA	81.32220	1.640000
CA	CAN	Canada	2020	13.599375	4.239226	NA	NA	43562.4358	92	NA	NA	81.67049	2.003236
CN	CHN	China	1990	1.914546	120.915506	NA	NA	347.5784	97	2.58	NA	68.00500	NA
CN	CHN	China	2000	2.650409	134.492481	NA	72400000	959.3604	85	1.68	NA	71.88100	NA

4.0.0.0.0.2 Visualización de Nulos

La verificación de NAs dentro de los datos se llama Panel Balanceado. En este caso se puede observar que se cuentan con gran pérdida de datos en algunos de los indicadores. La decisión a tomar es elimiar aquellas columnas que tienen un gran porcentaje de valores nulos para imputar aquellos que tengan un porcentaje de valores perdidos menor o igual al 10%.

vis_miss(panel_salud)

4.0.0.0.0.3 Delimitación de variables a utilizar

panel_salud<-panel_salud %>% select(-c(iso2c, iso3c,EN.ATM.CO2E.PC, EN.POP.SLUM.UR.ZS,IE.PPI.WATR.CD, SH.MED.BEDS.ZS, SH.MED.SAOP.P5))
kable(head(panel_salud)) %>% kable_classic()

country	date	EN.POP.DNST	NY.GDP.PCAP.CD	SH.IMM.IDPT	SP.DYN.LE00.IN	VC.IHR.PSRC.P5
Canada	1990	3.088602	21525.8611	88	77.43659	2.375511
Canada	2000	3.422611	24271.0021	89	79.16683	1.779469
Canada	2010	3.792822	47562.0834	89	81.32220	1.640000
Canada	2020	4.239226	43562.4358	92	81.67049	2.003236
China	1990	120.915506	347.5784	97	68.00500	NA
China	2000	134.492481	959.3604	85	71.88100	NA

4.0.0.0.0.4 Visualización de Nulos

vis_miss(panel_salud)

4.0.0.0.0.5 Imputación de datos

#panel_salud<- panel_salud %>% mice(m=5, method="pmm", maxit = 10)

panel_salud<- complete(panel_salud)

vis_miss(panel_salud)

Después de la imputación de los datos se puede observar como es que para todos los indicadores seleccionados ya no cuentan con valores nulos, se tiene el 100% de los valores presentes.

5 Tarea 2. Gráficas de heterogeneidad

5.0.0.1 Visualización de heterogeneidad

plotmeans(SP.DYN.LE00.IN ~ country, data = panel_salud, n.label=FALSE, main= "Heterogeneidad entre países")

La línea que une los promedios no se mantiene constante a lo largo de las diferentes observaciones de los países. Por consiguiente, se puede decir que la gráfica tiene diferentes picos donde los intervalos de confianza tampoco se presentan dentro de un mismo rango, se ve una variación muy grande entre los promedios de los países, presentando una variabilidad inconsistente. De esta manera es que de forma visual se presenta heterogeneidad, diferencia significativa en las medias o dispersión entre los grupos.

En términos de países sí es deseable que se pueda contar con heterogeneidad entre para poder contar con una forma de comparación entre los grupos.

plotmeans(SP.DYN.LE00.IN ~ date, data = panel_salud, n.label=FALSE, main= "Heterogeneidad entre años")

En términos de los años, se puede observar que si tiene picos pero de una manera un poco más consistente entre las décadas. Los intervalos de confianza también varían entre las décadas aunque no en gran manera. En el mismo caso como entre países, los años presentan heterogeneidad.

6 Ejercicio 3. Modelos con Indicadores del Banco Mundial

Siguiendo con la información presentada en los pasos anteriores, se seguirá trabajando con el modelamiento de una regresión para predecir la esperanza de vida en años en diferentes países a base de diferentes indicadores de diferentes índoles como económicos, de salud y de población.

6.1 Modelado

6.1.1 1. Regresión agrupado (pooled)

pooled<- plm(SP.DYN.LE00.IN ~ EN.POP.DNST+
              NY.GDP.PCAP.CD+
              SH.IMM.IDPT+
              VC.IHR.PSRC.P5, 
             data = panel_salud, 
             model = "pooling")


summary(pooled)

## Pooling Model
## 
## Call:
## plm(formula = SP.DYN.LE00.IN ~ EN.POP.DNST + NY.GDP.PCAP.CD + 
##     SH.IMM.IDPT + VC.IHR.PSRC.P5, data = panel_salud, model = "pooling")
## 
## Unbalanced Panel: n = 6, T = 2-4, N = 22
## 
## Residuals:
##      Min.   1st Qu.    Median   3rd Qu.      Max. 
## -3.411991 -1.047104 -0.024523  1.241106  2.598083 
## 
## Coefficients:
##                   Estimate  Std. Error t-value  Pr(>|t|)    
## (Intercept)     6.6229e+01  3.9377e+00 16.8190 4.971e-12 ***
## EN.POP.DNST    -2.4460e-03  6.4382e-03 -0.3799 0.7087152    
## NY.GDP.PCAP.CD  8.1505e-05  2.0245e-05  4.0260 0.0008764 ***
## SH.IMM.IDPT     1.0276e-01  4.3969e-02  2.3371 0.0319280 *  
## VC.IHR.PSRC.P5 -7.5102e-02  2.3553e-02 -3.1886 0.0053773 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    343.78
## Residual Sum of Squares: 57.636
## R-Squared:      0.83234
## Adj. R-Squared: 0.79289
## F-statistic: 21.0994 on 4 and 17 DF, p-value: 2.0641e-06

En este modelo se puede observar como es que el PIB per cápita, la cantidad de niños que son vacunados y el índice de homicidios intencionales, son significativos para predecir la esperanza de vida en años. Estas variables son significativas al menos con un 95% de nivel de confianza, el modelo como tal explica (de manera ajustada) el 79.28% de la varianza de los datos.

6.1.2 2. Efectos Fijos (within)

within<- plm(SP.DYN.LE00.IN ~ EN.POP.DNST+
              NY.GDP.PCAP.CD+
              SH.IMM.IDPT+
              VC.IHR.PSRC.P5, 
             data = panel_salud, 
             model = "within")


summary(within)

## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = SP.DYN.LE00.IN ~ EN.POP.DNST + NY.GDP.PCAP.CD + 
##     SH.IMM.IDPT + VC.IHR.PSRC.P5, data = panel_salud, model = "within")
## 
## Unbalanced Panel: n = 6, T = 2-4, N = 22
## 
## Residuals:
##     Min.  1st Qu.   Median  3rd Qu.     Max. 
## -1.43966 -0.80116  0.18810  0.82978  1.25760 
## 
## Coefficients:
##                   Estimate  Std. Error t-value Pr(>|t|)   
## EN.POP.DNST     2.7849e-02  4.0410e-02  0.6891 0.503842   
## NY.GDP.PCAP.CD  7.0917e-05  2.9678e-05  2.3896 0.034163 * 
## SH.IMM.IDPT     7.3990e-02  3.1809e-02  2.3261 0.038342 * 
## VC.IHR.PSRC.P5 -9.8453e-02  2.6217e-02 -3.7553 0.002745 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    83.675
## Residual Sum of Squares: 15.62
## R-Squared:      0.81332
## Adj. R-Squared: 0.67331
## F-statistic: 13.0705 on 4 and 12 DF, p-value: 0.00024884

Para el caso de within, se puede observar como es que se tienen 3 variables significativas para poder pronosticar la esperanza de vida en años, en específico el PIB per cápita, el índicde de niños que estan vacunados y el índice de homicidios intencionados. Presenta un buen modelo aunque podría tener mejor desempeño.

6.1.3 Prueba PF

pFtest(within, pooled)

## 
##  F test for individual effects
## 
## data:  SP.DYN.LE00.IN ~ EN.POP.DNST + NY.GDP.PCAP.CD + SH.IMM.IDPT +  ...
## F = 6.4557, df1 = 5, df2 = 12, p-value = 0.003911
## alternative hypothesis: significant effects

Cuando aparece como alternative hypothesis: significant effects se tiene que escoger el mejor modelo de los dos puesto que uno tiene mejor comportamiento que el otro. Si tuviera non-significan effects puedo utilizar ambos modelos sin tema. Por esta razón, es que en este caso sabemos que hay un mejor modelo entre los dos propuestos, y basando la decisión en las métricas presentadas se selecciona el modelo pooled.

6.2 3. Modelo aleatorio (random)

6.2.1 Walhus

walhus<- plm(SP.DYN.LE00.IN ~ EN.POP.DNST+
              NY.GDP.PCAP.CD+
              SH.IMM.IDPT+
              VC.IHR.PSRC.P5, 
             data = panel_salud, 
             model = "random",
             random.method = "walhus")


summary(walhus)

## Oneway (individual) effect Random Effect Model 
##    (Wallace-Hussain's transformation)
## 
## Call:
## plm(formula = SP.DYN.LE00.IN ~ EN.POP.DNST + NY.GDP.PCAP.CD + 
##     SH.IMM.IDPT + VC.IHR.PSRC.P5, data = panel_salud, model = "random", 
##     random.method = "walhus")
## 
## Unbalanced Panel: n = 6, T = 2-4, N = 22
## 
## Effects:
##                  var std.dev share
## idiosyncratic 0.4819  0.6942 0.079
## individual    5.6497  2.3769 0.921
## theta:
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.7977  0.8555  0.8555  0.8503  0.8555  0.8555 
## 
## Residuals:
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -1.80052 -0.83627  0.04402  0.00284  0.81264  1.52288 
## 
## Coefficients:
##                   Estimate  Std. Error z-value  Pr(>|z|)    
## (Intercept)     6.8238e+01  3.0340e+00 22.4911 < 2.2e-16 ***
## EN.POP.DNST     5.4896e-03  1.8827e-02  0.2916  0.770611    
## NY.GDP.PCAP.CD  8.1656e-05  2.0252e-05  4.0320 5.530e-05 ***
## SH.IMM.IDPT     7.7236e-02  2.7720e-02  2.7863  0.005331 ** 
## VC.IHR.PSRC.P5 -9.8181e-02  2.2256e-02 -4.4113 1.027e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    126.08
## Residual Sum of Squares: 17.175
## R-Squared:      0.86381
## Adj. R-Squared: 0.83176
## Chisq: 71.2043 on 4 DF, p-value: 1.2639e-14

Para el modelo Walhus se puede observar como es que se tiene que PIB per cápita y el índice de homicidios intencionales son las únicas variables significativas para poder predecir la esperanza de vida en años, estas dos variables con un índice de confianza del 99%. El modelo tiene una explicación del 68.82% de la varianza de los datos, lo cual podría decir que no sería el mejor modelo para realizar una predicción per tampoco sería el peor.

6.2.1.0.0.1 Amemiya

amemiya<- plm(SP.DYN.LE00.IN ~ EN.POP.DNST+
              NY.GDP.PCAP.CD+
              SH.IMM.IDPT+
              VC.IHR.PSRC.P5, 
             data = panel_salud, 
             model = "random",
             random.method = "amemiya")


summary(amemiya)

## Oneway (individual) effect Random Effect Model 
##    (Amemiya's transformation)
## 
## Call:
## plm(formula = SP.DYN.LE00.IN ~ EN.POP.DNST + NY.GDP.PCAP.CD + 
##     SH.IMM.IDPT + VC.IHR.PSRC.P5, data = panel_salud, model = "random", 
##     random.method = "amemiya")
## 
## Unbalanced Panel: n = 6, T = 2-4, N = 22
## 
## Effects:
##                 var std.dev share
## idiosyncratic 1.302   1.141     1
## individual    0.000   0.000     0
## theta:
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##       0       0       0       0       0       0 
## 
## Residuals:
##      Min.   1st Qu.    Median   3rd Qu.      Max. 
## -3.411991 -1.047104 -0.024523  1.241106  2.598083 
## 
## Coefficients:
##                   Estimate  Std. Error z-value  Pr(>|z|)    
## (Intercept)     6.6229e+01  3.9377e+00 16.8190 < 2.2e-16 ***
## EN.POP.DNST    -2.4460e-03  6.4382e-03 -0.3799  0.704011    
## NY.GDP.PCAP.CD  8.1505e-05  2.0245e-05  4.0260 5.673e-05 ***
## SH.IMM.IDPT     1.0276e-01  4.3969e-02  2.3371  0.019435 *  
## VC.IHR.PSRC.P5 -7.5102e-02  2.3553e-02 -3.1886  0.001429 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    343.78
## Residual Sum of Squares: 57.636
## R-Squared:      0.83234
## Adj. R-Squared: 0.79289
## Chisq: 84.3975 on 4 DF, p-value: < 2.22e-16

En el caso de amemiya se cuenta con un un comportamiento similar, se tiene como es que el PIB per cápita y el índice de homicidios intencionales son variables significativas para la predicción o pronóstico de la esperanza de vida en años aunque con un menor índice de confianza en el PIB per cápita. El modelo explica solo el 61.47% de la varianza de los datos.

6.2.1.0.0.2 Nerlove

nerlove<- plm(SP.DYN.LE00.IN ~ EN.POP.DNST+
              NY.GDP.PCAP.CD+
              SH.IMM.IDPT+
              VC.IHR.PSRC.P5, 
             data = panel_salud, 
             model = "random",
             random.method = "nerlove")


summary(nerlove)

## Oneway (individual) effect Random Effect Model 
##    (Nerlove's transformation)
## 
## Call:
## plm(formula = SP.DYN.LE00.IN ~ EN.POP.DNST + NY.GDP.PCAP.CD + 
##     SH.IMM.IDPT + VC.IHR.PSRC.P5, data = panel_salud, model = "random", 
##     random.method = "nerlove")
## 
## Unbalanced Panel: n = 6, T = 2-4, N = 22
## 
## Effects:
##                  var std.dev share
## idiosyncratic 0.7100  0.8426 0.087
## individual    7.4068  2.7215 0.913
## theta:
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.7861  0.8470  0.8470  0.8415  0.8470  0.8470 
## 
## Residuals:
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -1.82177 -0.85026  0.03870  0.00259  0.79928  1.53245 
## 
## Coefficients:
##                   Estimate  Std. Error z-value  Pr(>|z|)    
## (Intercept)     6.8265e+01  2.9941e+00 22.8001 < 2.2e-16 ***
## EN.POP.DNST     4.8131e-03  1.8138e-02  0.2654  0.790730    
## NY.GDP.PCAP.CD  8.1902e-05  2.0083e-05  4.0782 4.538e-05 ***
## SH.IMM.IDPT     7.7416e-02  2.7808e-02  2.7839  0.005371 ** 
## VC.IHR.PSRC.P5 -9.8006e-02  2.2260e-02 -4.4028 1.069e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    130.85
## Residual Sum of Squares: 17.311
## R-Squared:      0.86774
## Adj. R-Squared: 0.83661
## Chisq: 71.1581 on 4 DF, p-value: 1.2926e-14

Dentro del modelo de Nerlove, las variables significativas para pronosticar la esperanza de vida en años se incrementa pero disminuyendo su nivel de confianza, se presentan como significativas el PIB per cápita del país así como la densidad de población (ambas con un 90% de nivel de confianza), y el índice de homicidios intencionales con un 99% de confianza. En cuanto al desempeño del modelo se puede observar como es que el 62.51% de la varianza de los datos si está siendo explicada por el modelo.

6.3 Prueba Hausman

phtest(nerlove, pooled)

## 
##  Hausman Test
## 
## data:  SP.DYN.LE00.IN ~ EN.POP.DNST + NY.GDP.PCAP.CD + SH.IMM.IDPT +  ...
## chisq = 1.3586, df = 4, p-value = 0.8514
## alternative hypothesis: one model is inconsistent

Este test dice que entre los dos modelos evaluados se tienen inconsistencias entre el desempeño, entonces es neceario escoger uno de los demás. De ambos modelos (fijos y aleatorios)0se selecciona elmodelo aleatorio de nerlove puesto que cuenta con mejores métricas de explicación de la varianza.

7 Tarea 3. Patentes

Para este ejercicio se presenta una base de datos que incluye diferentes empresas en distintos periodos de tiempo (lo cual permite tener datos panel) con datos demográficos y financieros de las empresas para determinar la cantidad de patentes aprobadas.

Descripción de las variables

• cusip: firm identifier

• merger: =1 if major merger 

- employ: employees in 1000s 

- return: return on stock, % 

- patents: patents applied for 

- patentsg: patents granted 

- stckpr: price common stock 

- rnd: R&D expend, current mill $ 

- rndeflt: R&D expend, 1972 mill $ 

- rndstck: stock of R&D 

- sales: sales, current mill. $ 

- sic: 4 digit industry 

- year: 72 through 81 

7.0.0.1 Carga de datos

patents<- read.csv("C:/Users/Astrid Gonzalez/Documents/UNIVERSIDAD/OCTAVO/PATENT 3.csv")
patents<- patents[,1:13]
kable(head(patents)) %>% kable_classic()

cusip	merger	employ	return	patents	patentsg	stckpr	rnd	rndeflt	rndstck	sales	sic	year
800	0	10	6	22	24	48	3	3	16	344	3740	2012
800	0	12	6	34	32	58	3	3	17	436	3740	2013
800	0	12	4	31	30	33	3	3	20	535	3740	2014
800	0	12	5	32	34	38	3	3	22	567	3740	2015
800	0	13	5	40	28	35	4	3	23	631	3740	2016
800	0	13	5	60	33	34	4	3	25	706	3740	2017

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

str(patents)

## Classes 'pdata.frame' and 'data.frame':  2260 obs. of  13 variables:
##  $ cusip   : Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ merger  : 'pseries' Named int  0 0 0 0 0 0 0 0 0 0 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ employ  : 'pseries' Named int  10 12 12 12 13 13 14 14 13 12 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ return  : 'pseries' Named int  6 6 4 5 5 5 5 5 4 5 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ patents : 'pseries' Named int  22 34 31 32 40 60 57 77 38 5 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ patentsg: 'pseries' Named int  24 32 30 34 28 33 53 47 64 70 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ stckpr  : 'pseries' Named int  48 58 33 38 35 34 31 34 46 41 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ rnd     : 'pseries' Named int  3 3 3 3 4 4 5 5 7 8 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ rndeflt : 'pseries' Named int  3 3 3 3 3 3 3 3 4 4 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ rndstck : 'pseries' Named int  16 17 20 22 23 25 27 30 34 38 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ sales   : 'pseries' Named int  344 436 535 567 631 706 819 992 1045 939 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ sic     : 'pseries' Named int  3740 3740 3740 3740 3740 3740 3740 3740 3740 3740 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ year    : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  - attr(*, "index")=Classes 'pindex' and 'data.frame':   2260 obs. of  2 variables:
##   ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...

7.0.0.2 Transformación de variables

patents$year<- as.factor(patents$year)
patents$sic <- as.factor(patents$sic)
patents$merger<- as.factor(patents$merger)
patents$cusip<- as.factor(patents$cusip)

str(patents)

## Classes 'pdata.frame' and 'data.frame':  2260 obs. of  13 variables:
##  $ cusip   : Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ merger  : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ employ  : 'pseries' Named int  10 12 12 12 13 13 14 14 13 12 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ return  : 'pseries' Named int  6 6 4 5 5 5 5 5 4 5 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ patents : 'pseries' Named int  22 34 31 32 40 60 57 77 38 5 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ patentsg: 'pseries' Named int  24 32 30 34 28 33 53 47 64 70 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ stckpr  : 'pseries' Named int  48 58 33 38 35 34 31 34 46 41 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ rnd     : 'pseries' Named int  3 3 3 3 4 4 5 5 7 8 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ rndeflt : 'pseries' Named int  3 3 3 3 3 3 3 3 4 4 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ rndstck : 'pseries' Named int  16 17 20 22 23 25 27 30 34 38 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ sales   : 'pseries' Named int  344 436 535 567 631 706 819 992 1045 939 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ sic     : Factor w/ 85 levels "2000","2010",..: 75 75 75 75 75 75 75 75 75 75 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ year    : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##   ..- attr(*, "names")= chr [1:2260] "800-2012" "800-2013" "800-2014" "800-2015" ...
##   ..- attr(*, "index")=Classes 'pindex' and 'data.frame':    2260 obs. of  2 variables:
##   .. ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   .. ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...
##  - attr(*, "index")=Classes 'pindex' and 'data.frame':   2260 obs. of  2 variables:
##   ..$ cusip: Factor w/ 226 levels "800","4626","4671",..: 1 1 1 1 1 1 1 1 1 1 ...
##   ..$ year : Factor w/ 10 levels "2012","2013",..: 1 2 3 4 5 6 7 8 9 10 ...

7.0.0.3 Visualización de valores Nulos

vis_dat(patents)

vis_miss(patents)

Como se puede observar, se cuenta con valores nulos en un 0.7%, debido a su baja concentración de valores faltantes, se toma la decisión de realizar una imputación de datos puesto se encuentra todavía en valores aceptables para imputar.

colSums(is.na(patents))

##    cusip   merger   employ   return  patents patentsg   stckpr      rnd 
##        0        0       21        8        0        0        2        0 
##  rndeflt  rndstck    sales      sic     year 
##        0      157        3        0        0

7.0.0.4 Imputación de datos

set.seed(123)
patents_miced<- mice(patents, m=5, maxit=5, method = "cart")

## 
##  iter imp variable
##   1   1  employ  return  stckpr  rndstck  sales
##   1   2  employ  return  stckpr  rndstck  sales
##   1   3  employ  return  stckpr  rndstck  sales
##   1   4  employ  return  stckpr  rndstck  sales
##   1   5  employ  return  stckpr  rndstck  sales
##   2   1  employ  return  stckpr  rndstck  sales
##   2   2  employ  return  stckpr  rndstck  sales
##   2   3  employ  return  stckpr  rndstck  sales
##   2   4  employ  return  stckpr  rndstck  sales
##   2   5  employ  return  stckpr  rndstck  sales
##   3   1  employ  return  stckpr  rndstck  sales
##   3   2  employ  return  stckpr  rndstck  sales
##   3   3  employ  return  stckpr  rndstck  sales
##   3   4  employ  return  stckpr  rndstck  sales
##   3   5  employ  return  stckpr  rndstck  sales
##   4   1  employ  return  stckpr  rndstck  sales
##   4   2  employ  return  stckpr  rndstck  sales
##   4   3  employ  return  stckpr  rndstck  sales
##   4   4  employ  return  stckpr  rndstck  sales
##   4   5  employ  return  stckpr  rndstck  sales
##   5   1  employ  return  stckpr  rndstck  sales
##   5   2  employ  return  stckpr  rndstck  sales
##   5   3  employ  return  stckpr  rndstck  sales
##   5   4  employ  return  stckpr  rndstck  sales
##   5   5  employ  return  stckpr  rndstck  sales

patents<- complete(patents_miced)

vis_miss(patents)

Después de la imputación ya se cuenta con el 100% de los datos para comenzar a transformar y modelar.

7.0.0.5 Transofrmación de datos

Para solucionar que el sistema reconociera a la variable employ como númerica se decidió generar una nueva columna.

patents<- patents %>% mutate(employee= employ*1)

head(patents)

##   cusip merger employ return patents patentsg stckpr rnd rndeflt rndstck sales
## 1   800      0     10      6      22       24     48   3       3      16   344
## 2   800      0     12      6      34       32     58   3       3      17   436
## 3   800      0     12      4      31       30     33   3       3      20   535
## 4   800      0     12      5      32       34     38   3       3      22   567
## 5   800      0     13      5      40       28     35   4       3      23   631
## 6   800      0     13      5      60       33     34   4       3      25   706
##    sic year employee
## 1 3740 2012       10
## 2 3740 2013       12
## 3 3740 2014       12
## 4 3740 2015       12
## 5 3740 2016       13
## 6 3740 2017       13

7.0.0.6 Análisis de correlación

patent_numeric<- Filter(is.numeric, patents) %>% select(-employ)
patent_cor<- cor(patent_numeric)

corrplot(patent_cor,method = 'color', order = 'alphabet', type = 'lower')

Tomando en cuenta el análisis de correlación de variables, seleccionamos aquellas que estarían relacionadas a la cantidad de patentes autorizadas que se tienen en las empresas a un nivel del 0.4 y superior.

7.0.0.7 Selección de variables

patents1<- patents %>% select(c(patentsg,rnd, rndeflt, rndstck, sales, employee, patents, year, cusip))
patents2<- patents %>% select(c(patentsg,rnd, rndeflt, rndstck, sales, stckpr, employee, patents, year, cusip))
patents3<- patents %>% select(c(patentsg, rndeflt, rndstck, sales, patents, employee, year, cusip))

7.0.0.8 Pueba de heterogeneidad

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

Se puede observar como es que entre las empresas si se cuenta con una heterogeneidad puesto la línea de los promedios no se mantiene constante, se tienen picos importantes con una gran elevación, así como los rangos de confianza.

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

En términos de años se puede observar como también se cuenta con heterogeneidad al no contar con una línea constante aunque no presenta tanta variación (o en magnitudes muy altas). Los rangos de confianza aparentan tener una apertura similar.

7.1 Modelado

Para el modelado se generaron 2 bases de datos diferentes para realizar la evaluación de la decisión presentada en las variables de correlación. A esto se le denominó como patents1 y patents3.

7.1.1 Pooled

7.1.1.1 Patents1

pooled<- plm(patentsg~rnd+
               rndeflt+
               rndstck+
               sales+
               employee, 
               data=patent_numeric, model ="pooling")
summary(pooled)

## Pooling Model
## 
## Call:
## plm(formula = patentsg ~ rnd + rndeflt + rndstck + sales + employee, 
##     data = patent_numeric, model = "pooling")
## 
## Unbalanced Panel: n = 54, T = 1-242, N = 2260
## 
## Residuals:
##      Min.   1st Qu.    Median   3rd Qu.      Max. 
## -416.2323   -8.2121   -4.8365   -1.0479  538.1839 
## 
## Coefficients:
##                Estimate  Std. Error t-value  Pr(>|t|)    
## (Intercept)  4.66691243  1.19006678  3.9216 9.061e-05 ***
## rnd         -0.81409095  0.09576591 -8.5008 < 2.2e-16 ***
## rndeflt      0.46887428  0.07982390  5.8739 4.889e-09 ***
## rndstck      0.09432911  0.01358260  6.9449 4.938e-12 ***
## sales       -0.00173527  0.00055574 -3.1225  0.001816 ** 
## employee     1.32568923  0.05708009 23.2251 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    14168000
## Residual Sum of Squares: 6056700
## R-Squared:      0.5725
## Adj. R-Squared: 0.57156
## F-statistic: 603.712 on 5 and 2254 DF, p-value: < 2.22e-16

Para este primer modelo se presentan todas las variables como significativas para el pronóstico de patentes aceptadas par alas empresas con un nivel de confianza igual o mayor a 99%. Aunque se podría decir que el modelo no tiene un gran desempeño puesto representa solo el 57.16% de la varianza de los datos.

7.1.1.2 Patents3

pooled<- plm(patentsg~rndeflt+
               rndstck+
               sales+
               employee, 
               data=patent_numeric, model ="pooling")
summary(pooled)

## Pooling Model
## 
## Call:
## plm(formula = patentsg ~ rndeflt + rndstck + sales + employee, 
##     data = patent_numeric, model = "pooling")
## 
## Unbalanced Panel: n = 54, T = 1-242, N = 2260
## 
## Residuals:
##      Min.   1st Qu.    Median   3rd Qu.      Max. 
## -463.8220   -8.7292   -5.1706   -1.3107  544.2801 
## 
## Coefficients:
##                Estimate  Std. Error t-value  Pr(>|t|)    
## (Intercept)  5.02258807  1.20797798  4.1578 3.333e-05 ***
## rndeflt      0.00101163  0.05872310  0.0172    0.9863    
## rndstck     -0.00820691  0.00634278 -1.2939    0.1958    
## sales       -0.00299354  0.00054406 -5.5022 4.175e-08 ***
## employee     1.44598166  0.05616524 25.7451 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    14168000
## Residual Sum of Squares: 6250900
## R-Squared:      0.5588
## Adj. R-Squared: 0.55802
## F-statistic: 714.009 on 4 and 2255 DF, p-value: < 2.22e-16

Para la segunda selección de variables se obserca como las ventas y la cantidad de empleados son las significativas para poder pronosticar las patentes otorgadas, explicando menos de varianza que la base de datos anterior.

7.1.2 Within

7.1.2.1 Patents1

within1<- plm(patentsg~rnd+
               rndeflt+
               rndstck+
               sales+
               employee, 
               data=patent_numeric, model ="within")
summary(within1)

## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = patentsg ~ rnd + rndeflt + rndstck + sales + employee, 
##     data = patent_numeric, model = "within")
## 
## Unbalanced Panel: n = 54, T = 1-242, N = 2260
## 
## Residuals:
##      Min.   1st Qu.    Median   3rd Qu.      Max. 
## -413.3143  -13.6661   -3.0405    5.4509  525.3385 
## 
## Coefficients:
##             Estimate  Std. Error t-value  Pr(>|t|)    
## rnd      -0.85290736  0.09634668 -8.8525 < 2.2e-16 ***
## rndeflt   0.44904629  0.08098770  5.5446 3.299e-08 ***
## rndstck   0.10134782  0.01366122  7.4187 1.680e-13 ***
## sales    -0.00184343  0.00055801 -3.3036 0.0009699 ***
## employee  1.34855048  0.05793901 23.2753 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    13623000
## Residual Sum of Squares: 5898100
## R-Squared:      0.56705
## Adj. R-Squared: 0.55564
## F-statistic: 576.548 on 5 and 2201 DF, p-value: < 2.22e-16

Para el caso de within de la primera base de datos se presenta de nuevo como es que todas las variables son significativas con una R ajustada del 55.64%.

7.1.2.2 Patents3

within3<- plm(patentsg~rndeflt+
               rndstck+
               sales+
               employee, 
               data=patent_numeric, model ="within")
summary(within3)

## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = patentsg ~ rndeflt + rndstck + sales + employee, 
##     data = patent_numeric, model = "within")
## 
## Unbalanced Panel: n = 54, T = 1-242, N = 2260
## 
## Residuals:
##      Min.   1st Qu.    Median   3rd Qu.      Max. 
## -456.8419  -13.4296   -3.4891    4.7625  533.5554 
## 
## Coefficients:
##            Estimate Std. Error t-value  Pr(>|t|)    
## rndeflt  -0.0430254  0.0599260 -0.7180    0.4728    
## rndstck  -0.0059439  0.0064134 -0.9268    0.3541    
## sales    -0.0031409  0.0005478 -5.7337 1.118e-08 ***
## employee  1.4764714  0.0570852 25.8643 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    13623000
## Residual Sum of Squares: 6108100
## R-Squared:      0.55164
## Adj. R-Squared: 0.54003
## F-statistic: 677.297 on 4 and 2202 DF, p-value: < 2.22e-16

En la segunda base de datos se siguen manteniendo las variables significativas aunque su explicación de la varianza disminuye.

7.2 Aleatorios

7.2.0.1 Walhus

Patents 1

walhus1<- plm(patentsg~rnd+
               rndeflt+
               rndstck+
               sales+
               employee, 
               data=patent_numeric, 
              model = "random",
             random.method = "walhus")
summary(walhus1)

## Oneway (individual) effect Random Effect Model 
##    (Wallace-Hussain's transformation)
## 
## Call:
## plm(formula = patentsg ~ rnd + rndeflt + rndstck + sales + employee, 
##     data = patent_numeric, model = "random", random.method = "walhus")
## 
## Unbalanced Panel: n = 54, T = 1-242, N = 2260
## 
## Effects:
##                    var  std.dev share
## idiosyncratic 2681.756   51.786 0.998
## individual       5.756    2.399 0.002
## theta:
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## 0.001071 0.082865 0.137225 0.127430 0.174618 0.188730 
## 
## Residuals:
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -415.42   -8.31   -4.95   -0.06   -0.75  536.75 
## 
## Coefficients:
##                Estimate  Std. Error z-value  Pr(>|z|)    
## (Intercept)  4.86188710  1.32590835  3.6668 0.0002456 ***
## rnd         -0.82503082  0.09567070 -8.6237 < 2.2e-16 ***
## rndeflt      0.46981432  0.07977992  5.8889 3.888e-09 ***
## rndstck      0.09598874  0.01357078  7.0732 1.514e-12 ***
## sales       -0.00175641  0.00055515 -3.1638 0.0015571 ** 
## employee     1.32691182  0.05708273 23.2454 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    14050000
## Residual Sum of Squares: 6028400
## R-Squared:      0.57094
## Adj. R-Squared: 0.56999
## Chisq: 3003.29 on 5 DF, p-value: < 2.22e-16

De nuevo, para la primera base de datos se presentan todas las variables como significativas para pronosticar las patentes otorgadas con una mejor explicación de la varianza.

7.2.0.2 Patents3

walhus3<- plm(patentsg~rndeflt+
               rndstck+
               sales+
               employee, 
               data=patent_numeric, 
              model = "random",
             random.method = "walhus")
summary(walhus3)

## Oneway (individual) effect Random Effect Model 
##    (Wallace-Hussain's transformation)
## 
## Call:
## plm(formula = patentsg ~ rndeflt + rndstck + sales + employee, 
##     data = patent_numeric, model = "random", random.method = "walhus")
## 
## Unbalanced Panel: n = 54, T = 1-242, N = 2260
## 
## Effects:
##                   var std.dev share
## idiosyncratic 2775.64   52.68     1
## individual       0.00    0.00     0
## theta:
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##       0       0       0       0       0       0 
## 
## Residuals:
##      Min.   1st Qu.    Median   3rd Qu.      Max. 
## -463.8220   -8.7292   -5.1706   -1.3107  544.2801 
## 
## Coefficients:
##                Estimate  Std. Error z-value  Pr(>|z|)    
## (Intercept)  5.02258807  1.20797798  4.1578 3.213e-05 ***
## rndeflt      0.00101163  0.05872310  0.0172    0.9863    
## rndstck     -0.00820691  0.00634278 -1.2939    0.1957    
## sales       -0.00299354  0.00054406 -5.5022 3.750e-08 ***
## employee     1.44598166  0.05616524 25.7451 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    14168000
## Residual Sum of Squares: 6250900
## R-Squared:      0.5588
## Adj. R-Squared: 0.55802
## Chisq: 2856.04 on 4 DF, p-value: < 2.22e-16

La segunda base de datos presenta los mismos resultados que en sus modelos anteriores, con mayor varianza explicada por los datos pero aún no se podría considerar como un buen modelo.

7.2.0.3 Amemiya

Patents 1

amemiya1<- plm(patentsg~rnd+
               rndeflt+
               rndstck+
               sales+
               employee,
               data=patent_numeric,
              model = "random",
             random.method = "amemiya")
summary(amemiya1)

## Oneway (individual) effect Random Effect Model 
##    (Amemiya's transformation)
## 
## Call:
## plm(formula = patentsg ~ rnd + rndeflt + rndstck + sales + employee, 
##     data = patent_numeric, model = "random", random.method = "amemiya")
## 
## Unbalanced Panel: n = 54, T = 1-242, N = 2260
## 
## Effects:
##                    var  std.dev share
## idiosyncratic 2679.725   51.766 0.996
## individual      10.144    3.185 0.004
## theta:
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## 0.001887 0.133906 0.210829 0.193481 0.259814 0.277576 
## 
## Residuals:
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -415.02   -8.60   -4.96   -0.08   -0.64  535.94 
## 
## Coefficients:
##                Estimate  Std. Error z-value  Pr(>|z|)    
## (Intercept)  4.94225689  1.41331548  3.4969 0.0004707 ***
## rnd         -0.82988493  0.09561895 -8.6791 < 2.2e-16 ***
## rndeflt      0.46967145  0.07976780  5.8880 3.909e-09 ***
## rndstck      0.09674998  0.01356406  7.1328 9.834e-13 ***
## sales       -0.00176707  0.00055483 -3.1849 0.0014480 ** 
## employee     1.32791567  0.05708917 23.2604 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    13996000
## Residual Sum of Squares: 6014200
## R-Squared:      0.57028
## Adj. R-Squared: 0.56932
## Chisq: 2996.17 on 5 DF, p-value: < 2.22e-16

Siguiendo la misma progresión, se tienen todas las variables como significativas con un buen nivel de confianza y una explicación de la varianza más elevada aunque aún menor que con el modelo Pooled.

7.2.0.4 Patents3

amemiya3<- plm(patentsg~rndeflt+
               rndstck+
               sales+
               employee,
               data=patent_numeric,
              model = "random",
             random.method = "amemiya")
summary(amemiya3)

## Oneway (individual) effect Random Effect Model 
##    (Amemiya's transformation)
## 
## Call:
## plm(formula = patentsg ~ rndeflt + rndstck + sales + employee, 
##     data = patent_numeric, model = "random", random.method = "amemiya")
## 
## Unbalanced Panel: n = 54, T = 1-242, N = 2260
## 
## Effects:
##                   var std.dev share
## idiosyncratic 2773.88   52.67     1
## individual       0.00    0.00     0
## theta:
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##       0       0       0       0       0       0 
## 
## Residuals:
##      Min.   1st Qu.    Median   3rd Qu.      Max. 
## -463.8220   -8.7292   -5.1706   -1.3107  544.2801 
## 
## Coefficients:
##                Estimate  Std. Error z-value  Pr(>|z|)    
## (Intercept)  5.02258807  1.20797798  4.1578 3.213e-05 ***
## rndeflt      0.00101163  0.05872310  0.0172    0.9863    
## rndstck     -0.00820691  0.00634278 -1.2939    0.1957    
## sales       -0.00299354  0.00054406 -5.5022 3.750e-08 ***
## employee     1.44598166  0.05616524 25.7451 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    14168000
## Residual Sum of Squares: 6250900
## R-Squared:      0.5588
## Adj. R-Squared: 0.55802
## Chisq: 2856.04 on 4 DF, p-value: < 2.22e-16

Dentro de la base de datos de patentes 3 se puede observar el mismo comportamiento de contar solo con sales y employee como variables significativas para el pronóstico, aún con una explicación de la varianza baja con una r ajustada de 55.82%.

7.2.0.5 Nerlove

Patents 1

nerlove1<- plm(patentsg~rnd+
               rndeflt+
               rndstck+
               sales+
               employee,
               data=patent_numeric,
              model = "random",
             random.method = "nerlove")
summary(nerlove1)

## Oneway (individual) effect Random Effect Model 
##    (Nerlove's transformation)
## 
## Call:
## plm(formula = patentsg ~ rnd + rndeflt + rndstck + sales + employee, 
##     data = patent_numeric, model = "random", random.method = "nerlove")
## 
## Unbalanced Panel: n = 54, T = 1-242, N = 2260
## 
## Effects:
##                    var  std.dev share
## idiosyncratic 2609.767   51.086 0.972
## individual      73.815    8.592 0.028
## theta:
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## 0.01385 0.46464 0.57458 0.52147 0.62644 0.64297 
## 
## Residuals:
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -413.33  -10.02   -4.42    0.02    1.18  531.44 
## 
## Coefficients:
##                Estimate  Std. Error z-value  Pr(>|z|)    
## (Intercept)  4.91955991  2.18489470  2.2516  0.024346 *  
## rnd         -0.84563319  0.09536160 -8.8676 < 2.2e-16 ***
## rndeflt      0.46240880  0.07983756  5.7919 6.961e-09 ***
## rndstck      0.09952423  0.01352705  7.3574 1.875e-13 ***
## sales       -0.00181298  0.00055307 -3.2780  0.001045 ** 
## employee     1.33676896  0.05716653 23.3838 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    13773000
## Residual Sum of Squares: 5949700
## R-Squared:      0.56802
## Adj. R-Squared: 0.56706
## Chisq: 2969.86 on 5 DF, p-value: < 2.22e-16

Para este modelo utilizando Nerlove, se pueden observar todas las variables como significativas para el pronóstico de las patentes otorgadas en una empresa. Representa solo el 56.7% de la varianza de los datos.

nerlove2<- plm(patentsg~rndeflt+
               rndstck+
               sales+
               employee,
               data=patent_numeric,
              model = "random",
             random.method = "nerlove")
summary(nerlove2)

## Oneway (individual) effect Random Effect Model 
##    (Nerlove's transformation)
## 
## Call:
## plm(formula = patentsg ~ rndeflt + rndstck + sales + employee, 
##     data = patent_numeric, model = "random", random.method = "nerlove")
## 
## Unbalanced Panel: n = 54, T = 1-242, N = 2260
## 
## Effects:
##                    var  std.dev share
## idiosyncratic 2702.688   51.987 0.976
## individual      66.348    8.145 0.024
## theta:
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## 0.01205 0.43748 0.54952 0.49791 0.60321 0.62043 
## 
## Residuals:
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -458.51  -10.22   -4.96   -0.02    0.53  538.88 
## 
## Coefficients:
##                Estimate  Std. Error z-value  Pr(>|z|)    
## (Intercept)  5.37365820  2.13349891  2.5187   0.01178 *  
## rndeflt     -0.02290264  0.05895586 -0.3885   0.69767    
## rndstck     -0.00701707  0.00633631 -1.1074   0.26810    
## sales       -0.00310121  0.00054275 -5.7139 1.104e-08 ***
## employee     1.46202688  0.05630236 25.9674 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    13787000
## Residual Sum of Squares: 6161200
## R-Squared:      0.55311
## Adj. R-Squared: 0.55231
## Chisq: 2796.73 on 4 DF, p-value: < 2.22e-16

Para la tercera base de datos se cuentan las mismas 2 variables como significativas para poder pronosticar las patentes otorgadas, con un 55.23% de la varianza siendo explicada.

7.3 Evalución de modelo

pFtest(within, pooled)

## 
##  F test for individual effects
## 
## data:  SP.DYN.LE00.IN ~ EN.POP.DNST + NY.GDP.PCAP.CD + SH.IMM.IDPT +  ...
## F = 2141, df1 = 2243, df2 = 12, p-value < 2.2e-16
## alternative hypothesis: significant effects

phtest(walhus1, pooled)

## 
##  Hausman Test
## 
## data:  patentsg ~ rnd + rndeflt + rndstck + sales + employee
## chisq = 73.831, df = 4, p-value = 3.521e-15
## alternative hypothesis: one model is inconsistent

Se cuenta con efectos significativos entre los modelos presentados como fijos por lo tal se podría mencionar que el mejor modelo de los dos (tomando en cuenta solo la base de datos 1 que fue quien obtuvo un mejor desempeño en general) en las métricas de cantidad de variables significativas, la proporción de la varianza siendo explicada por el modelo e incluso los índices de confianza presentados.

Como la prueba de Hausman presenta inconsistencias entre los modelos entonces se debe seleccionar alguno que esté teniendo el mejor desmepeño. En este caso el modelo que se selecciona es el método agrupado de los fijos puesto fue el que explico la mayor proporción de varianza en el modelo. Se puede reconocer que o se tiene un mejor desempeño del modelo puesto que se decidió excluir la variables de patentes solicitadas para su otorgación, esto debido a que es una variable altamente correlacionada que en lugar de traer beneficios al modelo para explicar el comportamiento necesario o como ciertas variables afectan (en que magnitud y dirección) a la otorgación de patentes, más alla que la cantidad de patentes presentadas.

---

1. Sancho, A., Serrano, S. (2005). Econometría de Economías. Recuperado de: https://www.uv.es/~sancho/panel↩︎

2. Ortega, C. (s.f). Datos transversales: Qué son, características y tipos. Recuperado de: https://www.questionpro.com/blog/es/datos-transversales/↩︎

3. Universidad de Sonora. (s.f). Series de Tiempo - Estadística. Recuperado de: http://www.estadistica.mat.uson.mx/Material/seriesdetiempo.pdf↩︎