Actividad 1

Actividad 1. Modelo econometrico

Actividad 2 aplicacion shiny paises

Dar click aqui para ir a la aplicacion de shiny

Aplicacion de shiny (ejemplo y ejercicio sesion 3)

Dar click aqui para ir a la actividad en equipo en aplicacion de shiny

Actividad patentes

#Instalar librerias
library(WDI)
library(ggplot2)
library(gplots)

## 
## Adjuntando el paquete: 'gplots'

## The following object is masked from 'package:stats':
## 
##     lowess

library(plm)
library(readxl)

importar base de datos

#file.choose()
patentes = read_xls("C:\\Users\\Luis\\Documents\\TEC 8vo SEMESTRE\\Generación de escenarios futuros con analítica\\PATENT 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 de los 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. Construccion del modelo de datos en panel

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

2. Modelo de efectos fijos y aleatorios

#modelo efectos fijo
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

phtest(modelo_efectos_fijos_patentes,modelo_efectos_aleatorios_patentes) #Prueba de Hausman

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

#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

3. Pruebas de heterocedasticidad y autocorrelacion serial

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/

#Pruebas de heterocedasticidad para 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 heterocidad en los residuos (detectamos el problema)

bptest(modelo_efectos_aleatorios_patentes)

## 
##  studentized Breusch-Pagan test
## 
## data:  modelo_efectos_aleatorios_patentes
## BP = 617.25, df = 10, p-value < 2.2e-16

# 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]

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

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

# Prueba de Hausman(para conocer cual de los dos modelos utilizaremos) si el p-value es mayor a .05 usamos el de Efectos Aleatorios
#phtest(modeloef,modeloefa)

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