library(tidyverse)
## Warning: package 'tidyverse' was built under R version 4.1.3
## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --
## v ggplot2 3.3.5     v purrr   0.3.4
## v tibble  3.1.5     v dplyr   1.0.7
## v tidyr   1.1.4     v stringr 1.4.0
## v readr   2.1.2     v forcats 0.5.1
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
library(lubridate)
## 
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union
library(car)
## Warning: package 'car' was built under R version 4.1.3
## Loading required package: carData
## 
## Attaching package: 'car'
## The following object is masked from 'package:dplyr':
## 
##     recode
## The following object is masked from 'package:purrr':
## 
##     some
library(urca)
library(tseries)
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
library(aTSA)
## 
## Attaching package: 'aTSA'
## The following objects are masked from 'package:tseries':
## 
##     adf.test, kpss.test, pp.test
## The following object is masked from 'package:graphics':
## 
##     identify
library(forecast)
## Warning: package 'forecast' was built under R version 4.1.3
## 
## Attaching package: 'forecast'
## The following object is masked from 'package:aTSA':
## 
##     forecast
library(foreign)
library(timsac)
library(vars)
## Warning: package 'vars' was built under R version 4.1.3
## Loading required package: MASS
## 
## Attaching package: 'MASS'
## The following object is masked from 'package:dplyr':
## 
##     select
## Loading required package: strucchange
## Loading required package: zoo
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
## Loading required package: sandwich
## 
## Attaching package: 'strucchange'
## The following object is masked from 'package:stringr':
## 
##     boundary
## Loading required package: lmtest
## 
## Attaching package: 'vars'
## The following object is masked from 'package:aTSA':
## 
##     arch.test
library(mFilter)
## Warning: package 'mFilter' was built under R version 4.1.3
library(dynlm)
## Warning: package 'dynlm' was built under R version 4.1.3
library(readxl)
## Warning: package 'readxl' was built under R version 4.1.3
coint<-read_excel(file.choose())
Cointegración_en_R <- read_excel(file.choose())
View(Cointegración_en_R)

coint=as.data.frame(coint)
attach(coint)
class(coint)
## [1] "data.frame"
plot(coint)

plot(PCE)

names(coint)
## [1] "Year"     "Quarter"  "tiempo"   "DPI"      "GDP"      "PCE"      "CP"      
## [8] "DIVIDEND"
class(coint)
## [1] "data.frame"
#Generar logaritmos
lnPCE = log(PCE)
lnDPI = log(DPI)

#Crear variables de series de tiempo
DPI.ts = ts(lnDPI, start=c(1974,1), end=c(2007,4), frequency = 4)
PCE.ts = ts(lnPCE, start=c(1974,1), end=c(2007,4), frequency = 4)

ts.plot(DPI.ts)

ts.plot(PCE.ts)

datos1=cbind(DPI.ts, PCE.ts)
plot(cbind(DPI.ts, PCE.ts))

##Cointegracion

#Generar modelo

cor(PCE,DPI)
## [1] 0.9984923
datos1 <- cbind(PCE,DPI)
colnames(datos1) <- cbind( "PCE", "DPI")
lagselect <- VARselect(datos1, lag.max = 8, type = "both")
lagselect$selection
## AIC(n)  HQ(n)  SC(n) FPE(n) 
##      4      2      2      4
lagselect$criteria
##                   1            2            3            4            5
## AIC(n)     13.45290     13.31812     13.32334     13.30588     13.32914
## HQ(n)      13.50023     13.38911     13.41800     13.42421     13.47114
## SC(n)      13.57032     13.49424     13.55818     13.59942     13.68140
## FPE(n) 695859.79225 608126.06456 611329.67769 600776.74404 614962.65296
##                   6            7            8
## AIC(n)     13.34504     13.36627     13.39234
## HQ(n)      13.51070     13.55560     13.60533
## SC(n)      13.75600     13.83594     13.92072
## FPE(n) 624879.96422 638379.79493 655353.77622
modelo1 <- VAR(datos1, p = 2, season = NULL, exog = NULL, type = "const")


modelo1 = lm(PCE.ts ~ DPI.ts)
summary(modelo1)
## 
## Call:
## lm(formula = PCE.ts ~ DPI.ts)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.031067 -0.009396 -0.001756  0.007100  0.046117 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 0.194408   0.021496   9.044 1.51e-15 ***
## DPI.ts      0.960252   0.002806 342.210  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.0128 on 134 degrees of freedom
## Multiple R-squared:  0.9989, Adjusted R-squared:  0.9988 
## F-statistic: 1.171e+05 on 1 and 134 DF,  p-value: < 2.2e-16
residuales=modelo1$residuals
summary(residuales)
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -0.031067 -0.009396 -0.001756  0.000000  0.007100  0.046117
residualPlot(modelo1)

#prueba de raiz unitaria
adf.test(residuales)
## Augmented Dickey-Fuller Test 
## alternative: stationary 
##  
## Type 1: no drift no trend 
##      lag   ADF p.value
## [1,]   0 -6.05    0.01
## [2,]   1 -5.01    0.01
## [3,]   2 -4.90    0.01
## [4,]   3 -5.36    0.01
## [5,]   4 -4.10    0.01
## Type 2: with drift no trend 
##      lag   ADF p.value
## [1,]   0 -6.02    0.01
## [2,]   1 -5.00    0.01
## [3,]   2 -4.89    0.01
## [4,]   3 -5.36    0.01
## [5,]   4 -4.12    0.01
## Type 3: with drift and trend 
##      lag   ADF p.value
## [1,]   0 -6.00    0.01
## [2,]   1 -5.02    0.01
## [3,]   2 -4.93    0.01
## [4,]   3 -5.45    0.01
## [5,]   4 -4.26    0.01
## ---- 
## Note: in fact, p.value = 0.01 means p.value <= 0.01
y = ur.df(residuales, type = "trend", selectlags = "AIC")
summary(y)
## 
## ############################################### 
## # Augmented Dickey-Fuller Test Unit Root Test # 
## ############################################### 
## 
## Test regression trend 
## 
## 
## Call:
## lm(formula = z.diff ~ z.lag.1 + 1 + tt + z.diff.lag)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.038950 -0.005109  0.000418  0.004343  0.039482 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -1.662e-03  1.724e-03  -0.964   0.3369    
## z.lag.1     -3.753e-01  7.480e-02  -5.017 1.69e-06 ***
## tt           1.829e-05  2.192e-05   0.835   0.4055    
## z.diff.lag  -1.680e-01  8.090e-02  -2.077   0.0398 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.009808 on 130 degrees of freedom
## Multiple R-squared:  0.2775, Adjusted R-squared:  0.2608 
## F-statistic: 16.64 on 3 and 130 DF,  p-value: 3.279e-09
## 
## 
## Value of test-statistic is: -5.017 8.6193 12.8112 
## 
## Critical values for test statistics: 
##       1pct  5pct 10pct
## tau3 -3.99 -3.43 -3.13
## phi2  6.22  4.75  4.07
## phi3  8.43  6.49  5.47
y@teststat
##                tau3     phi2     phi3
## statistic -5.016975 8.619292 12.81124
y@cval
##       1pct  5pct 10pct
## tau3 -3.99 -3.43 -3.13
## phi2  6.22  4.75  4.07
## phi3  8.43  6.49  5.47
y2 = ur.df(residuales, type = "drift", selectlags = "AIC")
summary(y2)
## 
## ############################################### 
## # Augmented Dickey-Fuller Test Unit Root Test # 
## ############################################### 
## 
## Test regression drift 
## 
## 
## Call:
## lm(formula = z.diff ~ z.lag.1 + 1 + z.diff.lag)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.040038 -0.004852  0.000548  0.004892  0.038497 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -0.0004084  0.0008463  -0.483   0.6302    
## z.lag.1     -0.3732403  0.0746724  -4.998 1.82e-06 ***
## z.diff.lag  -0.1683817  0.0808055  -2.084   0.0391 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.009797 on 131 degrees of freedom
## Multiple R-squared:  0.2736, Adjusted R-squared:  0.2625 
## F-statistic: 24.67 on 2 and 131 DF,  p-value: 8.05e-10
## 
## 
## Value of test-statistic is: -4.9984 12.6098 
## 
## Critical values for test statistics: 
##       1pct  5pct 10pct
## tau2 -3.46 -2.88 -2.57
## phi1  6.52  4.63  3.81
#si el valor de t es menor en valor absoluto al valor critico del 
#los residuos son No estacionarios



y3 = ur.df(residuales, type = "none", selectlags = "AIC")
summary(y3)
## 
## ############################################### 
## # Augmented Dickey-Fuller Test Unit Root Test # 
## ############################################### 
## 
## Test regression none 
## 
## 
## Call:
## lm(formula = z.diff ~ z.lag.1 - 1 + z.diff.lag)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.040447 -0.005259  0.000139  0.004482  0.038084 
## 
## Coefficients:
##            Estimate Std. Error t value Pr(>|t|)    
## z.lag.1    -0.37326    0.07446  -5.013 1.69e-06 ***
## z.diff.lag -0.16819    0.08057  -2.088   0.0388 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.009768 on 132 degrees of freedom
## Multiple R-squared:  0.2732, Adjusted R-squared:  0.2622 
## F-statistic: 24.81 on 2 and 132 DF,  p-value: 7.139e-10
## 
## 
## Value of test-statistic is: -5.0133 
## 
## Critical values for test statistics: 
##       1pct  5pct 10pct
## tau1 -2.58 -1.95 -1.62
#Philips y Oularis
prueba.P0 = ca.po(datos1, type="Pz")
summary(prueba.P0)
## 
## ######################################## 
## # Phillips and Ouliaris Unit Root Test # 
## ######################################## 
## 
## Test of type Pz 
## detrending of series none 
## 
## Response PCE :
## 
## Call:
## lm(formula = PCE ~ zr - 1)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -105.869  -11.242    0.804   13.818   60.810 
## 
## Coefficients:
##       Estimate Std. Error t value Pr(>|t|)    
## zrPCE 0.995909   0.010760  92.559   <2e-16 ***
## zrDPI 0.011342   0.009885   1.147    0.252    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 22.5 on 241 degrees of freedom
## Multiple R-squared:      1,  Adjusted R-squared:      1 
## F-statistic: 4.157e+06 on 2 and 241 DF,  p-value: < 2.2e-16
## 
## 
## Response DPI :
## 
## Call:
## lm(formula = DPI ~ zr - 1)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -163.399  -13.419    4.837   19.280  143.173 
## 
## Coefficients:
##       Estimate Std. Error t value Pr(>|t|)    
## zrPCE  0.02016    0.01911   1.055    0.293    
## zrDPI  0.98901    0.01756  56.320   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 39.96 on 241 degrees of freedom
## Multiple R-squared:  0.9999, Adjusted R-squared:  0.9999 
## F-statistic: 1.558e+06 on 2 and 241 DF,  p-value: < 2.2e-16
## 
## 
## 
## Value of test-statistic is: 8.912 
## 
## Critical values of Pz are:
##                   10pct    5pct    1pct
## critical values 33.9267 40.8217 55.1911
prueba.P2 = ca.po(datos1, type="Pu")
summary(prueba.P2)
## 
## ######################################## 
## # Phillips and Ouliaris Unit Root Test # 
## ######################################## 
## 
## Test of type Pu 
## detrending of series none 
## 
## 
## Call:
## lm(formula = z[, 1] ~ z[, -1] - 1)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -292.36 -124.00  -42.27    2.22  395.85 
## 
## Coefficients:
##         Estimate Std. Error t value Pr(>|t|)    
## z[, -1] 0.918864   0.001929   476.3   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 136.1 on 243 degrees of freedom
## Multiple R-squared:  0.9989, Adjusted R-squared:  0.9989 
## F-statistic: 2.269e+05 on 1 and 243 DF,  p-value: < 2.2e-16
## 
## 
## Value of test-statistic is: 6.3268 
## 
## Critical values of Pu are:
##                   10pct    5pct    1pct
## critical values 20.3933 25.9711 38.3413
#Segun la prueba de Philips y Oularis el modelo presenta datos estacionales

##Corrección de errores
#Generación de tendencia si no están cointegrados
tendencia=seq_along(PCE.ts)
print(tendencia)
##   [1]   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18
##  [19]  19  20  21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36
##  [37]  37  38  39  40  41  42  43  44  45  46  47  48  49  50  51  52  53  54
##  [55]  55  56  57  58  59  60  61  62  63  64  65  66  67  68  69  70  71  72
##  [73]  73  74  75  76  77  78  79  80  81  82  83  84  85  86  87  88  89  90
##  [91]  91  92  93  94  95  96  97  98  99 100 101 102 103 104 105 106 107 108
## [109] 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
## [127] 127 128 129 130 131 132 133 134 135 136
modelo2=lm(PCE.ts~tendencia+DPI.ts)
residuales2 = modelo2$residuals
residualPlot(modelo2)

DFresiduales2 = ur.df(residuales2, type = "trend", selectlags = "AIC")
summary(DFresiduales2)
## 
## ############################################### 
## # Augmented Dickey-Fuller Test Unit Root Test # 
## ############################################### 
## 
## Test regression trend 
## 
## 
## Call:
## lm(formula = z.diff ~ z.lag.1 + 1 + tt + z.diff.lag)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.033155 -0.005175 -0.000228  0.004714  0.040952 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -1.428e-03  1.616e-03  -0.884   0.3783    
## z.lag.1     -3.483e-01  7.237e-02  -4.813 4.06e-06 ***
## tt           1.423e-05  2.054e-05   0.693   0.4898    
## z.diff.lag  -1.844e-01  8.088e-02  -2.279   0.0243 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.009195 on 130 degrees of freedom
## Multiple R-squared:  0.2688, Adjusted R-squared:  0.2519 
## F-statistic: 15.93 on 3 and 130 DF,  p-value: 7.031e-09
## 
## 
## Value of test-statistic is: -4.8128 7.9497 11.7426 
## 
## Critical values for test statistics: 
##       1pct  5pct 10pct
## tau3 -3.99 -3.43 -3.13
## phi2  6.22  4.75  4.07
## phi3  8.43  6.49  5.47
dlnPCE = diff(PCE.ts)
dlnDPI = diff(DPI.ts)

modelo3 = lm(dlnPCE~dlnDPI)
summary(modelo3)
## 
## Call:
## lm(formula = dlnPCE ~ dlnDPI)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.039263 -0.004656  0.000486  0.004847  0.039199 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 0.005772   0.001040   5.552 1.48e-07 ***
## dlnDPI      0.336966   0.069578   4.843 3.50e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.009362 on 133 degrees of freedom
## Multiple R-squared:  0.1499, Adjusted R-squared:  0.1435 
## F-statistic: 23.45 on 1 and 133 DF,  p-value: 3.499e-06
res3=modelo3$residuals
res3_1 = lag(res3)

MCE = lm(dlnPCE ~ dlnDPI + res3_1)
summary(MCE)
## 
## Call:
## lm(formula = dlnPCE ~ dlnDPI + res3_1)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.035477 -0.005194  0.000119  0.005468  0.041716 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  0.004802   0.001045   4.593 1.01e-05 ***
## dlnDPI       0.423487   0.071830   5.896 2.99e-08 ***
## res3_1      -0.238421   0.087117  -2.737  0.00707 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.009041 on 131 degrees of freedom
##   (1 observation deleted due to missingness)
## Multiple R-squared:  0.216,  Adjusted R-squared:  0.204 
## F-statistic: 18.05 on 2 and 131 DF,  p-value: 1.195e-07
#res debe ser negativo y valor absoluto menor a 1