Actividad Sesión 1. Modelo Econométrico

Código Sesiones 2, 3 y 4. Análisis de Datos de Panel

# Instalar paquetes y llamar librerías
#install.packages("WDI")
library(WDI)
#install.packages("wbstats")
library(wbstats)
#install.packages("tidyverse")
library(ggplot2)
#install.packages("gplots")
library(gplots)
## 
## Adjuntando el paquete: 'gplots'
## The following object is masked from 'package:stats':
## 
##     lowess
#install.packages("plm")
library(plm)

# Obtener la información de 1 país
PIB_MEX <- wb_data(country = "MX", indicator = "NY.GDP.PCAP.CD", 
                   start_date=1900, end_date=2025)
summary(PIB_MEX)
##     iso2c              iso3c             country               date     
##  Length:64          Length:64          Length:64          Min.   :1960  
##  Class :character   Class :character   Class :character   1st Qu.:1976  
##  Mode  :character   Mode  :character   Mode  :character   Median :1992  
##                                                           Mean   :1992  
##                                                           3rd Qu.:2007  
##                                                           Max.   :2023  
##  NY.GDP.PCAP.CD        unit            obs_status          footnote        
##  Min.   :  355.1   Length:64          Length:64          Length:64         
##  1st Qu.: 1427.8   Class :character   Class :character   Class :character  
##  Median : 4006.5   Mode  :character   Mode  :character   Mode  :character  
##  Mean   : 5097.1                                                           
##  3rd Qu.: 8905.4                                                           
##  Max.   :13790.0                                                           
##   last_updated       
##  Min.   :2025-01-28  
##  1st Qu.:2025-01-28  
##  Median :2025-01-28  
##  Mean   :2025-01-28  
##  3rd Qu.:2025-01-28  
##  Max.   :2025-01-28
ggplot(PIB_MEX, aes(x= date, y=NY.GDP.PCAP.CD)) +
  geom_point () +
  geom_line() +
  labs(title="PIB per Capita en México (Current USD$)", x = "Año", 
       y = "Valor")

# Obtener la información de varios paises
PIB_PANEL <- wb_data(country = c("MX","US","CA"), indicator = "NY.GDP.PCAP.CD", 
                     start_date=1900, end_date=2025)
summary(PIB_PANEL)
##     iso2c              iso3c             country               date     
##  Length:192         Length:192         Length:192         Min.   :1960  
##  Class :character   Class :character   Class :character   1st Qu.:1976  
##  Mode  :character   Mode  :character   Mode  :character   Median :1992  
##                                                           Mean   :1992  
##                                                           3rd Qu.:2007  
##                                                           Max.   :2023  
##  NY.GDP.PCAP.CD        unit            obs_status          footnote        
##  Min.   :  355.1   Length:192         Length:192         Length:192        
##  1st Qu.: 4059.2   Class :character   Class :character   Class :character  
##  Median :10544.4   Mode  :character   Mode  :character   Mode  :character  
##  Mean   :19152.2                                                           
##  3rd Qu.:29010.1                                                           
##  Max.   :82769.4                                                           
##   last_updated       
##  Min.   :2025-01-28  
##  1st Qu.:2025-01-28  
##  Median :2025-01-28  
##  Mean   :2025-01-28  
##  3rd Qu.:2025-01-28  
##  Max.   :2025-01-28
ggplot(PIB_PANEL, aes(x= date, y=NY.GDP.PCAP.CD, color =iso3c)) +
  geom_point () +
  geom_line() +
  labs(title="PIB per Capita en Norteamérica (Current USD$)", x = "Año", 
       y = "Valor")

# Obtener la información de varios indicadores en varios paises
MEGAPIB<- wb_data(country = c("MX","US","CA"), indicator = c("NY.GDP.PCAP.CD",
                                                             "SP.DYN.LE00.IN"), start_date=1900, end_date=2025)
summary(MEGAPIB)
##     iso2c              iso3c             country               date     
##  Length:192         Length:192         Length:192         Min.   :1960  
##  Class :character   Class :character   Class :character   1st Qu.:1976  
##  Mode  :character   Mode  :character   Mode  :character   Median :1992  
##                                                           Mean   :1992  
##                                                           3rd Qu.:2007  
##                                                           Max.   :2023  
##                                                                         
##  NY.GDP.PCAP.CD    SP.DYN.LE00.IN 
##  Min.   :  355.1   Min.   :55.02  
##  1st Qu.: 4059.2   1st Qu.:71.11  
##  Median :10544.4   Median :74.36  
##  Mean   :19152.2   Mean   :73.41  
##  3rd Qu.:29010.1   3rd Qu.:77.49  
##  Max.   :82769.4   Max.   :82.22  
##                    NA's   :3
# Heterogeneidad 
# Variación entre individuos
plotmeans(NY.GDP.PCAP.CD ~ country, main = "Heterogeneidad entre países", xlab = "País", ylab = "PIB per Cápita", data=MEGAPIB)
## Warning in arrows(x, li, x, pmax(y - gap, li), col = barcol, lwd = lwd, :
## zero-length arrow is of indeterminate angle and so skipped
## Warning in arrows(x, ui, x, pmin(y + gap, ui), col = barcol, lwd = lwd, :
## zero-length arrow is of indeterminate angle and so skipped

# Interpretación: 
# Alta Heterogeneidad: Si los puntos (medias) están muy separados entre países.
# Baja Heterogeneidad: Si los puntos (medias) están cerca uno de otros.
# En este caso, EUA y Canadá tienen un PIB per Cápita mayor que México, mostrando 
# alta heterogeneidad entre países.


# Modelos de Efectos Fijos y Aleatorios

# Paso 1. Convertir la base de datos a formato de panel
datos_panel <- pdata.frame(PIB_PANEL, index = c("country", "date"))

# Modelo de Efectos Fijos 
modelo_efectos_fijos <- plm(NY.GDP.PCAP.CD ~ date, data=datos_panel, 
                            model = "within")
summary(modelo_efectos_fijos)
## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = NY.GDP.PCAP.CD ~ date, data = datos_panel, model = "within")
## 
## Balanced Panel: n = 3, T = 64, N = 192
## 
## Residuals:
##      Min.   1st Qu.    Median   3rd Qu.      Max. 
## -22869.42  -3713.59   -740.79   4417.57  22788.54 
## 
## Coefficients:
##           Estimate Std. Error t-value  Pr(>|t|)    
## date1961    19.689   7891.777  0.0025 0.9980133    
## date1962    93.003   7891.777  0.0118 0.9906159    
## date1963   182.117   7891.777  0.0231 0.9816255    
## date1964   329.256   7891.777  0.0417 0.9667868    
## date1965   493.812   7891.777  0.0626 0.9502057    
## date1966   705.548   7891.777  0.0894 0.9289037    
## date1967   836.074   7891.777  0.1059 0.9157965    
## date1968  1051.287   7891.777  0.1332 0.8942375    
## date1969  1278.661   7891.777  0.1620 0.8715461    
## date1970  1483.079   7891.777  0.1879 0.8512361    
## date1971  1757.600   7891.777  0.2227 0.8241196    
## date1972  2139.145   7891.777  0.2711 0.7867884    
## date1973  2652.616   7891.777  0.3361 0.7373364    
## date1974  3306.205   7891.777  0.4189 0.6759711    
## date1975  3736.686   7891.777  0.4735 0.6366822    
## date1976  4425.604   7891.777  0.5608 0.5759388    
## date1977  4698.806   7891.777  0.5954 0.5526405    
## date1978  5234.634   7891.777  0.6633 0.5083487    
## date1979  6060.354   7891.777  0.7679 0.4439640    
## date1980  7072.576   7891.777  0.8962 0.3718573    
## date1981  8188.133   7891.777  1.0376 0.3014655    
## date1982  7987.390   7891.777  1.0121 0.3134224    
## date1983  8523.654   7891.777  1.0801 0.2821751    
## date1984  9312.706   7891.777  1.1801 0.2402027    
## date1985  9796.257   7891.777  1.2413 0.2167918    
## date1986  9909.818   7891.777  1.2557 0.2115431    
## date1987 10895.002   7891.777  1.3806 0.1698612    
## date1988 12362.836   7891.777  1.5665 0.1197288    
## date1989 13585.668   7891.777  1.7215 0.0876150 .  
## date1990 14316.347   7891.777  1.8141 0.0720442 .  
## date1991 14759.335   7891.777  1.8702 0.0637741 .  
## date1992 14990.000   7891.777  1.8994 0.0597918 .  
## date1993 15667.517   7891.777  1.9853 0.0492832 *  
## date1994 16091.651   7891.777  2.0390 0.0435376 *  
## date1995 15978.167   7891.777  2.0247 0.0450159 *  
## date1996 16773.055   7891.777  2.1254 0.0355067 *  
## date1997 17769.387   7891.777  2.2516 0.0260772 *  
## date1998 18030.354   7891.777  2.2847 0.0240026 *  
## date1999 19236.904   7891.777  2.4376 0.0161811 *  
## date2000 20835.037   7891.777  2.6401 0.0093360 ** 
## date2001 21096.198   7891.777  2.6732 0.0085083 ** 
## date2002 21538.969   7891.777  2.7293 0.0072554 ** 
## date2003 23202.118   7891.777  2.9400 0.0039054 ** 
## date2004 25366.654   7891.777  3.2143 0.0016609 ** 
## date2005 27852.977   7891.777  3.5294 0.0005823 ***
## date2006 30232.924   7891.777  3.8309 0.0002003 ***
## date2007 32408.252   7891.777  4.1066 7.172e-05 ***
## date2008 33394.731   7891.777  4.2316 4.431e-05 ***
## date2009 30291.171   7891.777  3.8383 0.0001950 ***
## date2010 33440.081   7891.777  4.2373 4.333e-05 ***
## date2011 35778.148   7891.777  4.5336 1.331e-05 ***
## date2012 36526.334   7891.777  4.6284 9.027e-06 ***
## date2013 37214.927   7891.777  4.7157 6.286e-06 ***
## date2014 37345.549   7891.777  4.7322 5.866e-06 ***
## date2015 35011.917   7891.777  4.4365 1.971e-05 ***
## date2016 34666.237   7891.777  4.3927 2.348e-05 ***
## date2017 36493.760   7891.777  4.6243 9.182e-06 ***
## date2018 38068.376   7891.777  4.8238 3.990e-06 ***
## date2019 38902.406   7891.777  4.9295 2.543e-06 ***
## date2020 37056.865   7891.777  4.6956 6.833e-06 ***
## date2021 42836.438   7891.777  5.4280 2.815e-07 ***
## date2022 46436.696   7891.777  5.8842 3.387e-08 ***
## date2023 48123.578   7891.777  6.0979 1.218e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    5.061e+10
## Residual Sum of Squares: 1.1771e+10
## R-Squared:      0.76742
## Adj. R-Squared: 0.64743
## F-statistic: 6.59909 on 63 and 126 DF, p-value: < 2.22e-16
# Modelo de Efectos Aleatorios 
modelo_efectos_aleatorios <- plm(NY.GDP.PCAP.CD ~ date, data=datos_panel, 
                            model = "random")
summary(modelo_efectos_aleatorios)
## Oneway (individual) effect Random Effect Model 
##    (Swamy-Arora's transformation)
## 
## Call:
## plm(formula = NY.GDP.PCAP.CD ~ date, data = datos_panel, model = "random")
## 
## Balanced Panel: n = 3, T = 64, N = 192
## 
## Effects:
##                     var   std.dev share
## idiosyncratic  93420218      9665 0.375
## individual    155441504     12468 0.625
## theta: 0.9035
## 
## Residuals:
##      Min.   1st Qu.    Median   3rd Qu.      Max. 
## -24225.08  -3320.91   -892.17   5059.72  23751.53 
## 
## Coefficients:
##              Estimate Std. Error z-value  Pr(>|z|)    
## (Intercept)  1873.296   9107.904  0.2057 0.8370424    
## date1961       19.689   7891.777  0.0025 0.9980093    
## date1962       93.003   7891.777  0.0118 0.9905973    
## date1963      182.117   7891.777  0.0231 0.9815890    
## date1964      329.256   7891.777  0.0417 0.9667208    
## date1965      493.812   7891.777  0.0626 0.9501065    
## date1966      705.548   7891.777  0.0894 0.9287617    
## date1967      836.074   7891.777  0.1059 0.9156280    
## date1968     1051.287   7891.777  0.1332 0.8940250    
## date1969     1278.661   7891.777  0.1620 0.8712866    
## date1970     1483.079   7891.777  0.1879 0.8509338    
## date1971     1757.600   7891.777  0.2227 0.8237590    
## date1972     2139.145   7891.777  0.2711 0.7863449    
## date1973     2652.616   7891.777  0.3361 0.7367774    
## date1974     3306.205   7891.777  0.4189 0.6752578    
## date1975     3736.686   7891.777  0.4735 0.6358628    
## date1976     4425.604   7891.777  0.5608 0.5749430    
## date1977     4698.806   7891.777  0.5954 0.5515726    
## date1978     5234.634   7891.777  0.6633 0.5071370    
## date1979     6060.354   7891.777  0.7679 0.4425272    
## date1980     7072.576   7891.777  0.8962 0.3701483    
## date1981     8188.133   7891.777  1.0376 0.2994785    
## date1982     7987.390   7891.777  1.0121 0.3114828    
## date1983     8523.654   7891.777  1.0801 0.2801120    
## date1984     9312.706   7891.777  1.1801 0.2379796    
## date1985     9796.257   7891.777  1.2413 0.2144858    
## date1986     9909.818   7891.777  1.2557 0.2092195    
## date1987    10895.002   7891.777  1.3806 0.1674170    
## date1988    12362.836   7891.777  1.5665 0.1172207    
## date1989    13585.668   7891.777  1.7215 0.0851607 .  
## date1990    14316.347   7891.777  1.8141 0.0696648 .  
## date1991    14759.335   7891.777  1.8702 0.0614537 .  
## date1992    14990.000   7891.777  1.8994 0.0575059 .  
## date1993    15667.517   7891.777  1.9853 0.0471115 *  
## date1994    16091.651   7891.777  2.0390 0.0414460 *  
## date1995    15978.167   7891.777  2.0247 0.0429023 *  
## date1996    16773.055   7891.777  2.1254 0.0335546 *  
## date1997    17769.387   7891.777  2.2516 0.0243455 *  
## date1998    18030.354   7891.777  2.2847 0.0223303 *  
## date1999    19236.904   7891.777  2.4376 0.0147856 *  
## date2000    20835.037   7891.777  2.6401 0.0082883 ** 
## date2001    21096.198   7891.777  2.6732 0.0075134 ** 
## date2002    21538.969   7891.777  2.7293 0.0063470 ** 
## date2003    23202.118   7891.777  2.9400 0.0032817 ** 
## date2004    25366.654   7891.777  3.2143 0.0013076 ** 
## date2005    27852.977   7891.777  3.5294 0.0004166 ***
## date2006    30232.924   7891.777  3.8309 0.0001277 ***
## date2007    32408.252   7891.777  4.1066 4.016e-05 ***
## date2008    33394.731   7891.777  4.2316 2.320e-05 ***
## date2009    30291.171   7891.777  3.8383 0.0001239 ***
## date2010    33440.081   7891.777  4.2373 2.262e-05 ***
## date2011    35778.148   7891.777  4.5336 5.799e-06 ***
## date2012    36526.334   7891.777  4.6284 3.685e-06 ***
## date2013    37214.927   7891.777  4.7157 2.409e-06 ***
## date2014    37345.549   7891.777  4.7322 2.221e-06 ***
## date2015    35011.917   7891.777  4.4365 9.143e-06 ***
## date2016    34666.237   7891.777  4.3927 1.119e-05 ***
## date2017    36493.760   7891.777  4.6243 3.759e-06 ***
## date2018    38068.376   7891.777  4.8238 1.408e-06 ***
## date2019    38902.406   7891.777  4.9295 8.245e-07 ***
## date2020    37056.865   7891.777  4.6956 2.658e-06 ***
## date2021    42836.438   7891.777  5.4280 5.699e-08 ***
## date2022    46436.696   7891.777  5.8842 4.000e-09 ***
## date2023    48123.578   7891.777  6.0979 1.074e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    5.0797e+10
## Residual Sum of Squares: 1.1958e+10
## R-Squared:      0.76459
## Adj. R-Squared: 0.64873
## Chisq: 415.742 on 63 DF, p-value: < 2.22e-16
# Prueba de Hausman
phtest(modelo_efectos_fijos, modelo_efectos_aleatorios)
## 
##  Hausman Test
## 
## data:  NY.GDP.PCAP.CD ~ date
## chisq = 3.8736e-13, df = 63, p-value = 1
## alternative hypothesis: one model is inconsistent
# Como el p-value es mayor a 0.05, usamos el modelo de Efectos Aleatorios.

Aplicación de Shiny (Ejemplo en Clase y Ejercicio Sesión 3 por Mesas)

Dar click para ir a la aplicación de Shiny

Actividad Patentes

Instalar Paquetes y Llamar Librerías

#install.packages("WDI")
library(WDI)
#install.packages("wbstats")
library(wbstats)
#install.packages("tidyverse")
library(ggplot2)
#install.packages("gplots")
library(gplots)
#install.packages("plm")
library(plm)
#install.packages("readxl")
library(readxl)
#install.packages("lmtest")
library(lmtest)
## Cargando paquete requerido: zoo
## 
## Adjuntando el paquete: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
#install.packages("pglm")
library(pglm)
## Cargando paquete requerido: maxLik
## Cargando paquete requerido: miscTools
## 
## Please cite the 'maxLik' package as:
## Henningsen, Arne and Toomet, Ott (2011). maxLik: A package for maximum likelihood estimation in R. Computational Statistics 26(3), 443-458. DOI 10.1007/s00180-010-0217-1.
## 
## If you have questions, suggestions, or comments regarding the 'maxLik' package, please use a forum or 'tracker' at maxLik's R-Forge site:
## https://r-forge.r-project.org/projects/maxlik/

Importar la Base de Datos

#file.choose()
patentes <- read_excel("D:\\PATENT 3 (3).xls")

Entender la Base de Datos

summary(patentes)
##      cusip            merger           employ            return       
##  Min.   :   800   Min.   :0.0000   Min.   :  0.085   Min.   :-73.022  
##  1st Qu.:368514   1st Qu.:0.0000   1st Qu.:  1.227   1st Qu.:  5.128  
##  Median :501116   Median :0.0000   Median :  3.842   Median :  7.585  
##  Mean   :514536   Mean   :0.0177   Mean   : 18.826   Mean   :  8.003  
##  3rd Qu.:754688   3rd Qu.:0.0000   3rd Qu.: 15.442   3rd Qu.: 10.501  
##  Max.   :878555   Max.   :1.0000   Max.   :506.531   Max.   : 48.675  
##                                    NA's   :21        NA's   :8        
##     patents         patentsg           stckpr              rnd           
##  Min.   :  0.0   Min.   :   0.00   Min.   :  0.1875   Min.   :   0.0000  
##  1st Qu.:  1.0   1st Qu.:   1.00   1st Qu.:  7.6250   1st Qu.:   0.6847  
##  Median :  3.0   Median :   4.00   Median : 16.5000   Median :   2.1456  
##  Mean   : 22.9   Mean   :  27.14   Mean   : 22.6270   Mean   :  29.3398  
##  3rd Qu.: 15.0   3rd Qu.:  19.00   3rd Qu.: 29.2500   3rd Qu.:  11.9168  
##  Max.   :906.0   Max.   :1063.00   Max.   :402.0000   Max.   :1719.3535  
##                                    NA's   :2                             
##     rndeflt             rndstck             sales               sic      
##  Min.   :   0.0000   Min.   :   0.125   Min.   :    1.22   Min.   :2000  
##  1st Qu.:   0.4788   1st Qu.:   5.152   1st Qu.:   52.99   1st Qu.:2890  
##  Median :   1.4764   Median :  13.353   Median :  174.06   Median :3531  
##  Mean   :  19.7238   Mean   : 163.823   Mean   : 1219.60   Mean   :3333  
##  3rd Qu.:   8.7527   3rd Qu.:  74.563   3rd Qu.:  728.96   3rd Qu.:3661  
##  Max.   :1000.7876   Max.   :9755.352   Max.   :44224.00   Max.   :9997  
##                      NA's   :157        NA's   :3                        
##       year     
##  Min.   :2012  
##  1st Qu.:2014  
##  Median :2016  
##  Mean   :2016  
##  3rd Qu.:2019  
##  Max.   :2021  
## 
sum(is.na(patentes)) # Contar NA's
## [1] 191
sapply(patentes, function(x) sum(is.na(x))) # NA's por variable
##    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
patentes1 <- na.omit(patentes)

1. Construcción del modelo de datos en panel

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

2. Modelo de Efectos Fijos y Aleatorios

# Modelo de Efectos Fijos 
modelo_efectos_fijos_patentes <- plm(patents ~ merger + employ + return + patentsg + stckpr + rnd + rndeflt + rndstck + sales + sic, data=panel_patentes, model = "within")
summary(modelo_efectos_fijos_patentes)
## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = patents ~ merger + employ + return + patentsg + 
##     stckpr + rnd + rndeflt + rndstck + sales + sic, data = panel_patentes, 
##     model = "within")
## 
## Unbalanced Panel: n = 215, T = 2-10, N = 2083
## 
## Residuals:
##       Min.    1st Qu.     Median    3rd Qu.       Max. 
## -468.39577   -1.75634   -0.25666    1.85265  172.64513 
## 
## Coefficients:
##             Estimate  Std. Error  t-value  Pr(>|t|)    
## merger    6.02467998  4.30535335   1.3993    0.1619    
## employ   -0.09095534  0.08057733  -1.1288    0.2591    
## return   -0.01221444  0.12005904  -0.1017    0.9190    
## patentsg  0.03913907  0.02580379   1.5168    0.1295    
## stckpr   -0.03959771  0.03347713  -1.1828    0.2370    
## rnd      -2.04101003  0.15053766 -13.5581 < 2.2e-16 ***
## rndeflt   3.25369409  0.22523191  14.4460 < 2.2e-16 ***
## rndstck   0.19724166  0.01808942  10.9037 < 2.2e-16 ***
## sales    -0.00188938  0.00041715  -4.5293 6.294e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    1090400
## Residual Sum of Squares: 714450
## R-Squared:      0.34479
## Adj. R-Squared: 0.2662
## F-statistic: 108.696 on 9 and 1859 DF, p-value: < 2.22e-16
# Modelo de Efectos Aleatorios 
modelo_efectos_aleatorios_patentes <- plm(patents ~ merger + employ + return + patentsg + stckpr + rnd + rndeflt + rndstck + sales + sic, data = panel_patentes, model = "random")
summary(modelo_efectos_aleatorios_patentes)
## Oneway (individual) effect Random Effect Model 
##    (Swamy-Arora's transformation)
## 
## Call:
## plm(formula = patents ~ merger + employ + return + patentsg + 
##     stckpr + rnd + rndeflt + rndstck + sales + sic, data = panel_patentes, 
##     model = "random")
## 
## Unbalanced Panel: n = 215, T = 2-10, N = 2083
## 
## Effects:
##                 var std.dev share
## idiosyncratic 384.3    19.6     1
## individual      0.0     0.0     0
## theta:
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##       0       0       0       0       0       0 
## 
## Residuals:
##       Min.    1st Qu.     Median    3rd Qu.       Max. 
## -525.42194   -2.59738   -0.31264    1.88763  277.92369 
## 
## Coefficients:
##                Estimate  Std. Error z-value  Pr(>|z|)    
## (Intercept)  1.19864916  2.94181986  0.4075   0.68368    
## merger       1.92231907  4.04770404  0.4749   0.63485    
## employ       0.12548448  0.03060149  4.1006 4.121e-05 ***
## return       0.06432167  0.10374558  0.6200   0.53526    
## patentsg     0.78696226  0.01016726 77.4016 < 2.2e-16 ***
## stckpr       0.00355791  0.02557045  0.1391   0.88934    
## rnd         -0.18291882  0.04480367 -4.0827 4.452e-05 ***
## rndeflt      0.26805014  0.03877619  6.9128 4.753e-12 ***
## rndstck     -0.00122890  0.00628664 -0.1955   0.84502    
## sales       -0.00054529  0.00025769 -2.1161   0.03434 *  
## sic         -0.00049485  0.00081918 -0.6041   0.54579    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    10910000
## Residual Sum of Squares: 1154800
## R-Squared:      0.89416
## Adj. R-Squared: 0.89365
## Chisq: 17504.4 on 10 DF, p-value: < 2.22e-16
# Prueba de Hausman
phtest(modelo_efectos_fijos_patentes, modelo_efectos_aleatorios_patentes)
## 
##  Hausman Test
## 
## data:  patents ~ merger + employ + return + patentsg + stckpr + rnd +  ...
## chisq = 1104.9, df = 9, p-value < 2.2e-16
## alternative hypothesis: one model is inconsistent
# Como el p-value es < 0.05, usaremos el Modelo de Efectos Fijos.

3. Pruebas de Heterocedasticidad y Autocorrelación Serial

# Prueba de Heterocedasticidad para el Modelo de Efectos Fijos
bptest(modelo_efectos_fijos_patentes)
## 
##  studentized Breusch-Pagan test
## 
## data:  modelo_efectos_fijos_patentes
## BP = 617.25, df = 10, p-value < 2.2e-16
# Como el p-value es < 0.05, hay heterocedasticidad en los residuos (problema detectado)

# Prueba de Heterocedasticidad para el Modelo de Efectos Aleatorios
bptest(modelo_efectos_aleatorios_patentes)
## 
##  studentized Breusch-Pagan test
## 
## data:  modelo_efectos_aleatorios_patentes
## BP = 617.25, df = 10, p-value < 2.2e-16
# Como el p-value es < 0.05, hay heterocedasticidad en los residuos (problema detectado)

# Prueba de Autocorrelación Serial para el Modelo de Efectos Fijos
pwartest(modelo_efectos_fijos_patentes)
## 
##  Wooldridge's test for serial correlation in FE panels
## 
## data:  modelo_efectos_fijos_patentes
## F = 42.281, df1 = 1, df2 = 1866, p-value = 1.012e-10
## alternative hypothesis: serial correlation
# Como el p-value < 0.05, hay autocorrelación serial en errores

# Prueba de Autocorrelación Serial para el Modelo de Efectos Aleatorios
pbnftest(modelo_efectos_aleatorios_patentes)
## 
##  modified Bhargava/Franzini/Narendranathan Panel Durbin-Watson Test
## 
## data:  patents ~ merger + employ + return + patentsg + stckpr + rnd +  ...
## DW = 1.0069
## alternative hypothesis: serial correlation in idiosyncratic errors
# Como el valor es < 1.5 hay autocorrelación positiva significativa

# Corrección del Modelo con Errores Estándar Robustos
coeficientes_corregidos <- coeftest(modelo_efectos_fijos_patentes, vcov=vcovHC(modelo_efectos_fijos_patentes, type = "HC0"))
solo_coeficientes <- coeficientes_corregidos[,1]

4. Generar Pronóstivos y Evaluar Modelo

datos_de_prueba <- data.frame(merger=0, employ=10, return=6 , patentsg = 24, stckpr = 48, rnd = 3, rndeflt = 3, rndstck = 16,sales
= 344)

prediccion <- sum(solo_coeficientes*c(datos_de_prueba$merger,datos_de_prueba$employ, datos_de_prueba$return,datos_de_prueba$patentsg,datos_de_prueba$stckpr,datos_de_prueba$rnd,datos_de_prueba$rndeflt,datos_de_prueba$rndstck,datos_de_prueba$sales))
prediccion
## [1] 4.199779
# El valor esperado de la predicción es 22, y el resultado fue 4.2, por lo que tenemos una diferencia significativa.
LS0tDQp0aXRsZTogIkFjdGl2aWRhZCAxIg0KYXV0aG9yOiAiUmF1bCBDYW50dSAtIEEwMTA4NzY4MyINCmRhdGU6ICIyMDI1LTAyLTEzIg0Kb3V0cHV0OiANCiAgaHRtbF9kb2N1bWVudDoNCiAgICB0b2M6IFRSVUUNCiAgICB0b2NfZmxvYXQ6IFRSVUUNCiAgICBjb2RlX2Rvd25sb2FkOiBUUlVFDQogICAgdGhlbWU6IGNlcnVsZWFuDQotLS0NCg0KIVtdKEQ6XFxwYXRlbnRlcy5naWYpDQoNCiMgQWN0aXZpZGFkIFNlc2nDs24gMS4gTW9kZWxvIEVjb25vbcOpdHJpY28NCg0KIVtdKCkNCg0KIyBDw7NkaWdvIFNlc2lvbmVzIDIsIDMgeSA0LiBBbsOhbGlzaXMgZGUgRGF0b3MgZGUgUGFuZWwNCmBgYHtyfQ0KIyBJbnN0YWxhciBwYXF1ZXRlcyB5IGxsYW1hciBsaWJyZXLDrWFzDQojaW5zdGFsbC5wYWNrYWdlcygiV0RJIikNCmxpYnJhcnkoV0RJKQ0KI2luc3RhbGwucGFja2FnZXMoIndic3RhdHMiKQ0KbGlicmFyeSh3YnN0YXRzKQ0KI2luc3RhbGwucGFja2FnZXMoInRpZHl2ZXJzZSIpDQpsaWJyYXJ5KGdncGxvdDIpDQojaW5zdGFsbC5wYWNrYWdlcygiZ3Bsb3RzIikNCmxpYnJhcnkoZ3Bsb3RzKQ0KI2luc3RhbGwucGFja2FnZXMoInBsbSIpDQpsaWJyYXJ5KHBsbSkNCg0KIyBPYnRlbmVyIGxhIGluZm9ybWFjacOzbiBkZSAxIHBhw61zDQpQSUJfTUVYIDwtIHdiX2RhdGEoY291bnRyeSA9ICJNWCIsIGluZGljYXRvciA9ICJOWS5HRFAuUENBUC5DRCIsIA0KICAgICAgICAgICAgICAgICAgIHN0YXJ0X2RhdGU9MTkwMCwgZW5kX2RhdGU9MjAyNSkNCnN1bW1hcnkoUElCX01FWCkNCmdncGxvdChQSUJfTUVYLCBhZXMoeD0gZGF0ZSwgeT1OWS5HRFAuUENBUC5DRCkpICsNCiAgZ2VvbV9wb2ludCAoKSArDQogIGdlb21fbGluZSgpICsNCiAgbGFicyh0aXRsZT0iUElCIHBlciBDYXBpdGEgZW4gTcOpeGljbyAoQ3VycmVudCBVU0QkKSIsIHggPSAiQcOxbyIsIA0KICAgICAgIHkgPSAiVmFsb3IiKQ0KDQojIE9idGVuZXIgbGEgaW5mb3JtYWNpw7NuIGRlIHZhcmlvcyBwYWlzZXMNClBJQl9QQU5FTCA8LSB3Yl9kYXRhKGNvdW50cnkgPSBjKCJNWCIsIlVTIiwiQ0EiKSwgaW5kaWNhdG9yID0gIk5ZLkdEUC5QQ0FQLkNEIiwgDQogICAgICAgICAgICAgICAgICAgICBzdGFydF9kYXRlPTE5MDAsIGVuZF9kYXRlPTIwMjUpDQpzdW1tYXJ5KFBJQl9QQU5FTCkNCmdncGxvdChQSUJfUEFORUwsIGFlcyh4PSBkYXRlLCB5PU5ZLkdEUC5QQ0FQLkNELCBjb2xvciA9aXNvM2MpKSArDQogIGdlb21fcG9pbnQgKCkgKw0KICBnZW9tX2xpbmUoKSArDQogIGxhYnModGl0bGU9IlBJQiBwZXIgQ2FwaXRhIGVuIE5vcnRlYW3DqXJpY2EgKEN1cnJlbnQgVVNEJCkiLCB4ID0gIkHDsW8iLCANCiAgICAgICB5ID0gIlZhbG9yIikNCg0KIyBPYnRlbmVyIGxhIGluZm9ybWFjacOzbiBkZSB2YXJpb3MgaW5kaWNhZG9yZXMgZW4gdmFyaW9zIHBhaXNlcw0KTUVHQVBJQjwtIHdiX2RhdGEoY291bnRyeSA9IGMoIk1YIiwiVVMiLCJDQSIpLCBpbmRpY2F0b3IgPSBjKCJOWS5HRFAuUENBUC5DRCIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIlNQLkRZTi5MRTAwLklOIiksIHN0YXJ0X2RhdGU9MTkwMCwgZW5kX2RhdGU9MjAyNSkNCnN1bW1hcnkoTUVHQVBJQikNCg0KIyBIZXRlcm9nZW5laWRhZCANCiMgVmFyaWFjacOzbiBlbnRyZSBpbmRpdmlkdW9zDQpwbG90bWVhbnMoTlkuR0RQLlBDQVAuQ0QgfiBjb3VudHJ5LCBtYWluID0gIkhldGVyb2dlbmVpZGFkIGVudHJlIHBhw61zZXMiLCB4bGFiID0gIlBhw61zIiwgeWxhYiA9ICJQSUIgcGVyIEPDoXBpdGEiLCBkYXRhPU1FR0FQSUIpDQojIEludGVycHJldGFjacOzbjogDQojIEFsdGEgSGV0ZXJvZ2VuZWlkYWQ6IFNpIGxvcyBwdW50b3MgKG1lZGlhcykgZXN0w6FuIG11eSBzZXBhcmFkb3MgZW50cmUgcGHDrXNlcy4NCiMgQmFqYSBIZXRlcm9nZW5laWRhZDogU2kgbG9zIHB1bnRvcyAobWVkaWFzKSBlc3TDoW4gY2VyY2EgdW5vIGRlIG90cm9zLg0KIyBFbiBlc3RlIGNhc28sIEVVQSB5IENhbmFkw6EgdGllbmVuIHVuIFBJQiBwZXIgQ8OhcGl0YSBtYXlvciBxdWUgTcOpeGljbywgbW9zdHJhbmRvIA0KIyBhbHRhIGhldGVyb2dlbmVpZGFkIGVudHJlIHBhw61zZXMuDQoNCg0KIyBNb2RlbG9zIGRlIEVmZWN0b3MgRmlqb3MgeSBBbGVhdG9yaW9zDQoNCiMgUGFzbyAxLiBDb252ZXJ0aXIgbGEgYmFzZSBkZSBkYXRvcyBhIGZvcm1hdG8gZGUgcGFuZWwNCmRhdG9zX3BhbmVsIDwtIHBkYXRhLmZyYW1lKFBJQl9QQU5FTCwgaW5kZXggPSBjKCJjb3VudHJ5IiwgImRhdGUiKSkNCg0KIyBNb2RlbG8gZGUgRWZlY3RvcyBGaWpvcyANCm1vZGVsb19lZmVjdG9zX2Zpam9zIDwtIHBsbShOWS5HRFAuUENBUC5DRCB+IGRhdGUsIGRhdGE9ZGF0b3NfcGFuZWwsIA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgIG1vZGVsID0gIndpdGhpbiIpDQpzdW1tYXJ5KG1vZGVsb19lZmVjdG9zX2Zpam9zKQ0KDQojIE1vZGVsbyBkZSBFZmVjdG9zIEFsZWF0b3Jpb3MgDQptb2RlbG9fZWZlY3Rvc19hbGVhdG9yaW9zIDwtIHBsbShOWS5HRFAuUENBUC5DRCB+IGRhdGUsIGRhdGE9ZGF0b3NfcGFuZWwsIA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgIG1vZGVsID0gInJhbmRvbSIpDQpzdW1tYXJ5KG1vZGVsb19lZmVjdG9zX2FsZWF0b3Jpb3MpDQoNCiMgUHJ1ZWJhIGRlIEhhdXNtYW4NCnBodGVzdChtb2RlbG9fZWZlY3Rvc19maWpvcywgbW9kZWxvX2VmZWN0b3NfYWxlYXRvcmlvcykNCiMgQ29tbyBlbCBwLXZhbHVlIGVzIG1heW9yIGEgMC4wNSwgdXNhbW9zIGVsIG1vZGVsbyBkZSBFZmVjdG9zIEFsZWF0b3Jpb3MuDQoNCmBgYA0KDQojIEFwbGljYWNpw7NuIGRlIFNoaW55IChFamVtcGxvIGVuIENsYXNlIHkgRWplcmNpY2lvIFNlc2nDs24gMyBwb3IgTWVzYXMpDQpbRGFyIGNsaWNrIHBhcmEgaXIgYSBsYSBhcGxpY2FjacOzbiBkZSBTaGlueV0oaHR0cHM6Ly9yYXVsY2FudHUuc2hpbnlhcHBzLmlvL0FwbGljYWNpb25lcy8pDQoNCiMgQWN0aXZpZGFkIFBhdGVudGVzDQoNCiMjIEluc3RhbGFyIFBhcXVldGVzIHkgTGxhbWFyIExpYnJlcsOtYXMNCmBgYHtyfQ0KI2luc3RhbGwucGFja2FnZXMoIldESSIpDQpsaWJyYXJ5KFdESSkNCiNpbnN0YWxsLnBhY2thZ2VzKCJ3YnN0YXRzIikNCmxpYnJhcnkod2JzdGF0cykNCiNpbnN0YWxsLnBhY2thZ2VzKCJ0aWR5dmVyc2UiKQ0KbGlicmFyeShnZ3Bsb3QyKQ0KI2luc3RhbGwucGFja2FnZXMoImdwbG90cyIpDQpsaWJyYXJ5KGdwbG90cykNCiNpbnN0YWxsLnBhY2thZ2VzKCJwbG0iKQ0KbGlicmFyeShwbG0pDQojaW5zdGFsbC5wYWNrYWdlcygicmVhZHhsIikNCmxpYnJhcnkocmVhZHhsKQ0KI2luc3RhbGwucGFja2FnZXMoImxtdGVzdCIpDQpsaWJyYXJ5KGxtdGVzdCkNCiNpbnN0YWxsLnBhY2thZ2VzKCJwZ2xtIikNCmxpYnJhcnkocGdsbSkNCmBgYA0KDQojIyBJbXBvcnRhciBsYSBCYXNlIGRlIERhdG9zDQpgYGB7cn0NCiNmaWxlLmNob29zZSgpDQpwYXRlbnRlcyA8LSByZWFkX2V4Y2VsKCJEOlxcUEFURU5UIDMgKDMpLnhscyIpDQpgYGANCg0KIyMgRW50ZW5kZXIgbGEgQmFzZSBkZSBEYXRvcw0KYGBge3J9DQpzdW1tYXJ5KHBhdGVudGVzKQ0Kc3VtKGlzLm5hKHBhdGVudGVzKSkgIyBDb250YXIgTkEncw0Kc2FwcGx5KHBhdGVudGVzLCBmdW5jdGlvbih4KSBzdW0oaXMubmEoeCkpKSAjIE5BJ3MgcG9yIHZhcmlhYmxlDQpwYXRlbnRlczEgPC0gbmEub21pdChwYXRlbnRlcykNCmBgYA0KDQojIyAxLiBDb25zdHJ1Y2Npw7NuIGRlbCBtb2RlbG8gZGUgZGF0b3MgZW4gcGFuZWwNCmBgYHtyfQ0KcGFuZWxfcGF0ZW50ZXMgPC0gcGRhdGEuZnJhbWUocGF0ZW50ZXMxLCBpbmRleCA9IGMoImN1c2lwIiwgInllYXIiKSkNCmBgYA0KDQojIyAyLiBNb2RlbG8gZGUgRWZlY3RvcyBGaWpvcyB5IEFsZWF0b3Jpb3MNCmBgYHtyfQ0KIyBNb2RlbG8gZGUgRWZlY3RvcyBGaWpvcyANCm1vZGVsb19lZmVjdG9zX2Zpam9zX3BhdGVudGVzIDwtIHBsbShwYXRlbnRzIH4gbWVyZ2VyICsgZW1wbG95ICsgcmV0dXJuICsgcGF0ZW50c2cgKyBzdGNrcHIgKyBybmQgKyBybmRlZmx0ICsgcm5kc3RjayArIHNhbGVzICsgc2ljLCBkYXRhPXBhbmVsX3BhdGVudGVzLCBtb2RlbCA9ICJ3aXRoaW4iKQ0Kc3VtbWFyeShtb2RlbG9fZWZlY3Rvc19maWpvc19wYXRlbnRlcykNCg0KIyBNb2RlbG8gZGUgRWZlY3RvcyBBbGVhdG9yaW9zIA0KbW9kZWxvX2VmZWN0b3NfYWxlYXRvcmlvc19wYXRlbnRlcyA8LSBwbG0ocGF0ZW50cyB+IG1lcmdlciArIGVtcGxveSArIHJldHVybiArIHBhdGVudHNnICsgc3Rja3ByICsgcm5kICsgcm5kZWZsdCArIHJuZHN0Y2sgKyBzYWxlcyArIHNpYywgZGF0YSA9IHBhbmVsX3BhdGVudGVzLCBtb2RlbCA9ICJyYW5kb20iKQ0Kc3VtbWFyeShtb2RlbG9fZWZlY3Rvc19hbGVhdG9yaW9zX3BhdGVudGVzKQ0KDQojIFBydWViYSBkZSBIYXVzbWFuDQpwaHRlc3QobW9kZWxvX2VmZWN0b3NfZmlqb3NfcGF0ZW50ZXMsIG1vZGVsb19lZmVjdG9zX2FsZWF0b3Jpb3NfcGF0ZW50ZXMpDQojIENvbW8gZWwgcC12YWx1ZSBlcyA8IDAuMDUsIHVzYXJlbW9zIGVsIE1vZGVsbyBkZSBFZmVjdG9zIEZpam9zLg0KYGBgDQoNCiMjIDMuIFBydWViYXMgZGUgSGV0ZXJvY2VkYXN0aWNpZGFkIHkgQXV0b2NvcnJlbGFjacOzbiBTZXJpYWwNCmBgYHtyfQ0KIyBQcnVlYmEgZGUgSGV0ZXJvY2VkYXN0aWNpZGFkIHBhcmEgZWwgTW9kZWxvIGRlIEVmZWN0b3MgRmlqb3MNCmJwdGVzdChtb2RlbG9fZWZlY3Rvc19maWpvc19wYXRlbnRlcykNCiMgQ29tbyBlbCBwLXZhbHVlIGVzIDwgMC4wNSwgaGF5IGhldGVyb2NlZGFzdGljaWRhZCBlbiBsb3MgcmVzaWR1b3MgKHByb2JsZW1hIGRldGVjdGFkbykNCg0KIyBQcnVlYmEgZGUgSGV0ZXJvY2VkYXN0aWNpZGFkIHBhcmEgZWwgTW9kZWxvIGRlIEVmZWN0b3MgQWxlYXRvcmlvcw0KYnB0ZXN0KG1vZGVsb19lZmVjdG9zX2FsZWF0b3Jpb3NfcGF0ZW50ZXMpDQojIENvbW8gZWwgcC12YWx1ZSBlcyA8IDAuMDUsIGhheSBoZXRlcm9jZWRhc3RpY2lkYWQgZW4gbG9zIHJlc2lkdW9zIChwcm9ibGVtYSBkZXRlY3RhZG8pDQoNCiMgUHJ1ZWJhIGRlIEF1dG9jb3JyZWxhY2nDs24gU2VyaWFsIHBhcmEgZWwgTW9kZWxvIGRlIEVmZWN0b3MgRmlqb3MNCnB3YXJ0ZXN0KG1vZGVsb19lZmVjdG9zX2Zpam9zX3BhdGVudGVzKQ0KIyBDb21vIGVsIHAtdmFsdWUgPCAwLjA1LCBoYXkgYXV0b2NvcnJlbGFjacOzbiBzZXJpYWwgZW4gZXJyb3Jlcw0KDQojIFBydWViYSBkZSBBdXRvY29ycmVsYWNpw7NuIFNlcmlhbCBwYXJhIGVsIE1vZGVsbyBkZSBFZmVjdG9zIEFsZWF0b3Jpb3MNCnBibmZ0ZXN0KG1vZGVsb19lZmVjdG9zX2FsZWF0b3Jpb3NfcGF0ZW50ZXMpDQojIENvbW8gZWwgdmFsb3IgZXMgPCAxLjUgaGF5IGF1dG9jb3JyZWxhY2nDs24gcG9zaXRpdmEgc2lnbmlmaWNhdGl2YQ0KDQojIENvcnJlY2Npw7NuIGRlbCBNb2RlbG8gY29uIEVycm9yZXMgRXN0w6FuZGFyIFJvYnVzdG9zDQpjb2VmaWNpZW50ZXNfY29ycmVnaWRvcyA8LSBjb2VmdGVzdChtb2RlbG9fZWZlY3Rvc19maWpvc19wYXRlbnRlcywgdmNvdj12Y292SEMobW9kZWxvX2VmZWN0b3NfZmlqb3NfcGF0ZW50ZXMsIHR5cGUgPSAiSEMwIikpDQpzb2xvX2NvZWZpY2llbnRlcyA8LSBjb2VmaWNpZW50ZXNfY29ycmVnaWRvc1ssMV0NCmBgYA0KDQojIyA0LiBHZW5lcmFyIFByb27Ds3N0aXZvcyB5IEV2YWx1YXIgTW9kZWxvDQpgYGB7cn0NCmRhdG9zX2RlX3BydWViYSA8LSBkYXRhLmZyYW1lKG1lcmdlcj0wLCBlbXBsb3k9MTAsIHJldHVybj02ICwgcGF0ZW50c2cgPSAyNCwgc3Rja3ByID0gNDgsIHJuZCA9IDMsIHJuZGVmbHQgPSAzLCBybmRzdGNrID0gMTYsc2FsZXMNCj0gMzQ0KQ0KDQpwcmVkaWNjaW9uIDwtIHN1bShzb2xvX2NvZWZpY2llbnRlcypjKGRhdG9zX2RlX3BydWViYSRtZXJnZXIsZGF0b3NfZGVfcHJ1ZWJhJGVtcGxveSwgZGF0b3NfZGVfcHJ1ZWJhJHJldHVybixkYXRvc19kZV9wcnVlYmEkcGF0ZW50c2csZGF0b3NfZGVfcHJ1ZWJhJHN0Y2twcixkYXRvc19kZV9wcnVlYmEkcm5kLGRhdG9zX2RlX3BydWViYSRybmRlZmx0LGRhdG9zX2RlX3BydWViYSRybmRzdGNrLGRhdG9zX2RlX3BydWViYSRzYWxlcykpDQpwcmVkaWNjaW9uDQojIEVsIHZhbG9yIGVzcGVyYWRvIGRlIGxhIHByZWRpY2Npw7NuIGVzIDIyLCB5IGVsIHJlc3VsdGFkbyBmdWUgNC4yLCBwb3IgbG8gcXVlIHRlbmVtb3MgdW5hIGRpZmVyZW5jaWEgc2lnbmlmaWNhdGl2YS4NCmBgYA0KDQo=