Tải dữ liệu

library(tsDyn)
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
data(lynx)
head(lynx)
## Time Series:
## Start = 1821 
## End = 1826 
## Frequency = 1 
## [1]  269  321  585  871 1475 2821

Test of linearity against ( TÌm số ngưỡng)

kiemtra1 <- setarTest(lynx, m=1,thDelay=0, test=c("1vs"))
summary(kiemtra1)
## Test of linearity against setar(2) and setar(3)
## 
##          Test Pval
## 1vs2 20.05733    0
## 1vs3 42.81466    0
## 
## Critical values:
##           0.9     0.95    0.975     0.99
## 1vs2 11.53407 12.08120 12.35476 12.51890
## 1vs3 17.03573 17.67661 17.99706 18.18933
## 
## SSR of original series:
##                SSR
## AR       137160013
## SETAR(2) 116484232
## SETAR(3)  99471266
## 
## Threshold of original series:
##           th1  th2
## SETAR(2) 3465   NA
## SETAR(3) 1676 3465
## 
## Number of bootstrap replications:  10
kiemtra2 <- setarTest(lynx, m=1,thDelay=0, test=c("2vs3"))
## Warning: Possible unit root in the regime. Roots are: 0.9425
## Warning: Possible unit root in the regime. Roots are: 0.9443
## Warning: Possible unit root in the regime. Roots are: 0.9425
summary(kiemtra2)
## Test of setar(2) against  setar(3)
## 
##          Test Pval
## 2vs3 19.32684    0
## 
## Critical values:
##           0.9     0.95    0.975     0.99
## 2vs3 9.992291 10.79291 11.19322 11.43341
## 
## SSR of original series:
##                SSR
## AR       137160013
## SETAR(2) 116484232
## SETAR(3)  99471266
## 
## Threshold of original series:
##           th1  th2
## SETAR(2) 3465   NA
## SETAR(3) 1676 3465
## 
## Number of bootstrap replications:  10

Tìm giá trị ngưỡng

grid <- selectSETAR(lynx, m=1, thDelay=0,trim= 0.15, criterion="SSR", nthresh=2)
## Using maximum autoregressive order for low regime: mL = 1 
## Using maximum autoregressive order for high regime: mH = 1 
## Using maximum autoregressive order for middle regime: mM = 1 
## Searching on 75 possible threshold values within regimes with sufficient ( 15% ) number of observations
## Searching on 75 combinations of thresholds (75) and thDelay (1) 
## Result of the one threshold search:
##  -Thresh:  1388  -Delay:  0  - SSR 123102676 
## Second best: 2577 (conditionnal on th= 1388 and Delay= 0 )    SSR/AIC: 114452658
## Second best: 1000 (conditionnal on th= 2577 and Delay= 0 )    SSR/AIC: 113310032

summary(grid)
##            Length Class      Mode     
## res          3    data.frame list     
## res2         3    data.frame list     
## bests        4    -none-     numeric  
## th           2    -none-     numeric  
## nthresh      1    -none-     numeric  
## allTh      225    -none-     numeric  
## criterion    1    -none-     character
## firstBests   3    -none-     numeric  
## bests2th     3    -none-     numeric  
## ML           1    -none-     numeric  
## MM           1    -none-     numeric  
## MH           1    -none-     numeric  
## same.lags    1    -none-     logical
grid
## Results of the grid search for 1 threshold
##   Conditional on m=  1 
##   thDelay   th       SSR
## 1       0 1388 123102676
## 2       0 1307 123951941
## 3       0 1475 124388924
## 4       0 1676 124516444
## 5       0 1638 124557228
## 
## Results of the grid search for 2 thresholds
##       Conditional on thDelay =  0  and m = 1 
##    th1  th2       SSR
## 1 1000 2577 113310032
## 
## Overall best results:
##   thDelay       th1       th2       SSR 
##         0      1000      2577 113310032 
## With lags:
##  -ML: 1 
##  -MM: 1 
##  -MH: 1

Ước lượng ngưỡng

set <-setar(lynx, m=1,thDelay=0, th=grid$th)
## Warning: Possible unit root in the low regime. Roots are: 0.7924
summary(set)
## 
## Non linear autoregressive model
## 
## SETAR model ( 3 regimes)
## Coefficients:
## Low regime:
##   const.L    phiL.1 
## 84.715767  1.261983 
## 
## Mid regime:
##      const.M       phiM.1 
## 3612.9339667   -0.8987912 
## 
## High regime:
##      const.H       phiH.1 
## 2098.6793167    0.3328867 
## 
## Threshold:
## -Variable: Z(t) = + (1) X(t)
## -Value: 1000 2577 (fixed)
## Proportion of points in low regime: 54.87%    Middle regime: 21.24%   High regime: 23.89% 
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -2827.779  -376.600   -27.809   347.588  3738.868 
## 
## Fit:
## residuals variance = 993948,  AIC = 1586, MAPE = 105.3%
## 
## Coefficient(s):
## 
##           Estimate  Std. Error  t value  Pr(>|t|)    
## const.L   84.71577   241.77064   0.3504  0.726723    
## phiL.1     1.26198     0.52230   2.4162  0.017361 *  
## const.M 3612.93397   856.55362   4.2180 5.144e-05 ***
## phiM.1    -0.89879     0.46090  -1.9501  0.053760 .  
## const.H 2098.67932   644.49843   3.2563  0.001508 ** 
## phiH.1     0.33289     0.15855   2.0996  0.038097 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Threshold
## Variable: Z(t) = + (1) X(t) 
## 
## Value: 1000 2577 (fixed)

Chạy tìm số ngưỡng và giá trị TỰ ĐỘNG

mod.star <- star(log10(lynx), mTh=c(0,1), control=list(maxit=3000))
## Testing linearity...   p-Value =  0.0001831653 
## The series is nonlinear. Incremental building procedure:
## Building a 2 regime STAR.
## Performing grid search for starting values...
## Starting values fixed: gamma =  11.15385 , th =  3.337486 ; SSE =  4.337664 
## Optimization algorithm converged
## Optimized values fixed for regime 2  : gamma =  11.15383 , th =  3.339199 ; SSE =  4.337643 
## 
## Testing for addition of regime 3.
##   Estimating gradient matrix...
##   Done. Computing the test statistic...
##   Done. Regime 3 is NOT accepted (p-Value =  0.9843362 ).
## 
## Finished building a MRSTAR with  2  regimes
mod.star
## 
## Non linear autoregressive model
## 
## Multiple regime STAR model
## 
## Regime  1 :
##     Linear parameters: 0.4891014, 1.2465399, -0.3664328 
## 
## Regime  2 :
##     Linear parameters: -1.0240758, 0.4232669, -0.2546088 
##     Non-linear parameters:
## 11.1538344, 3.3391985
summary(mod.star)
## 
## Non linear autoregressive model
## 
## Multiple regime STAR model
## 
## Regime  1 :
##     Linear parameters: 0.4891014, 1.2465399, -0.3664328 
## 
## Regime  2 :
##     Linear parameters: -1.0240758, 0.4232669, -0.2546088 
##     Non-linear parameters:
## 11.1538344, 3.3391985
## 
## Residuals:
##         Min          1Q      Median          3Q         Max 
## -0.59482018 -0.10735988  0.01430922  0.11109839  0.51034240 
## 
## Fit:
## residuals variance = 0.03805,  AIC = -357, MAPE = 5.58%
addRegime(mod.star)
## 
## Non linear autoregressive model
## 
## Multiple regime STAR model
## 
## Regime  1 :
##     Linear parameters: 0.4891014, 1.2465399, -0.3664328 
## 
## Regime  2 :
##     Linear parameters: -1.0240758, 0.4232669, -0.2546088 
##     Non-linear parameters:
## 11.1538344, 3.3391985
## Regime  3 :
##     Linear parameters: -0.9388364, 1.3367467, -0.0239093 
##     Non-linear parameters:
## 0, 0

Multivariate Threshold Vector Autoregressive model

data(zeroyld)
head(zeroyld)
##   short.run long.run
## 1     2.183    1.575
## 2     2.246    1.545
## 3     2.308    1.762
## 4     2.401    1.773
## 5     2.558    1.808
## 6     2.507    1.810
tv <- TVAR(zeroyld, lag=2, nthresh=2, thDelay=1, trim=0.1, mTh=1, plot=FALSE)
## Best unique threshold 10.653 
## Second best: 8.124 (conditionnal on th= 10.653 and Delay= 1 )     SSR/AIC: 164.1456
## Second best: 10.653 (conditionnal on th= 8.124 and Delay= 1 )     SSR/AIC: 164.1456
## 
## Second step best thresholds 8.124 10.653          SSR: 164.1456
print(tv)
## Model TVAR with  2  thresholds
## 
## $Bdown
##                      Intercept short.run -1 long.run -1 short.run -2
## Equation short.run  0.01496509    1.0061051  0.03855754 -0.007405335
## Equation long.run  -0.03467035    0.3622364  1.02090855 -0.287156749
##                    long.run -2
## Equation short.run -0.03455587
## Equation long.run  -0.09201102
## 
## $Bmiddle
##                     Intercept short.run -1 long.run -1 short.run -2 long.run -2
## Equation short.run -0.2169119   0.83059144   0.0127026   0.13505057  0.04939883
## Equation long.run  -0.1386902  -0.02142815   0.8490303   0.02085644  0.16932567
## 
## $Bup
##                    Intercept short.run -1 long.run -1 short.run -2 long.run -2
## Equation short.run  1.561918    1.1780904 -0.03076567   -0.3468208  0.06986963
## Equation long.run   2.037192    0.7989221  0.81823826   -0.8562527  0.05771228
## 
## 
## Threshold value[1] "8.124 10.653"
summary(tv)
## Model TVAR with  2  thresholds
## 
## Full sample size: 482    End sample size: 480
## Number of variables: 2   Number of estimated parameters: 30 + 2
## AIC -2155.439    BIC -2021.878    SSR 164.1456 
## 
## [[1]]
##                    Intercept        short.run -1      long.run -1      
## Equation short.run 0.0150(0.0491)   1.0061(0.0990)*** 0.0386(0.0595)   
## Equation long.run  -0.0347(0.0836)  0.3622(0.1685)*   1.0209(0.1014)***
##                    short.run -2     long.run -2     
## Equation short.run -0.0074(0.0969)  -0.0346(0.0589) 
## Equation long.run  -0.2872(0.1650). -0.0920(0.1003) 
## 
## [[2]]
##                    Intercept        short.run -1      long.run -1      
## Equation short.run -0.2169(0.4479)  0.8306(0.1566)*** 0.0127(0.1005)   
## Equation long.run  -0.1387(0.7625)  -0.0214(0.2666)   0.8490(0.1711)***
##                    short.run -2    long.run -2    
## Equation short.run 0.1351(0.1459)  0.0494(0.1013) 
## Equation long.run  0.0209(0.2483)  0.1693(0.1724) 
## 
## [[3]]
##                    Intercept        short.run -1      long.run -1      
## Equation short.run 1.5619(0.5115)** 1.1781(0.1349)*** -0.0308(0.0657)  
## Equation long.run  2.0372(0.8707)*  0.7989(0.2297)*** 0.8182(0.1118)***
##                    short.run -2       long.run -2    
## Equation short.run -0.3468(0.1249)**  0.0699(0.0640) 
## Equation long.run  -0.8563(0.2127)*** 0.0577(0.1089) 
## 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 
## 
## Threshold value: 8.124 10.653
## Percentage of Observations in each regime: 71.5% 16.5% 12.1%
# Test
data<-zeroyld
TVAR.LRtest(data, lag=2, mTh=1,thDelay=1:2, nboot=3, plot=FALSE, trim=0.1, test="1vs")
## Warning: the thDelay values do not correspond to the univariate implementation in tsdyn
## $bestDelay
## Var1 
##    1 
## 
## $LRtest.val
##     1vs2     1vs3 
## 30.27935 42.97058 
## 
## $Pvalueboot
##      1vs2      1vs3 
## 0.0000000 0.3333333 
## 
## $CriticalValBoot
##           90%      95%    97.5%      99%
## 1vs2 22.44646 23.07519 23.38956 23.57818
## 1vs3 45.30365 46.27353 46.75847 47.04944
## 
## $type
## [1] "1vs"
## 
## attr(,"class")
## [1] "TVARtest"

Threshold Vector Error Correction model

tvec <- TVECM(zeroyld, nthresh=2,lag=1, ngridBeta=20, ngridTh=30, plot=TRUE,trim=0.05, common="All")
## 29 (4.8%) points of the grid lead to regimes with percentage of observations < trim and were not computed

## Best threshold from first search -1.312 
## Best cointegrating value 1.045747 
## Second best (conditionnal on the first one) -1.312 0.774      SSR 155.4941 
## Second step best thresholds -1.312 0.774              SSR 155.4941
print(tvec)
## Model TVECM with  2  thresholds
## 
## $Bdown
##                          ECT     Const short.run t -1 long.run t -1
## Equation short.run 0.2343191 0.5627267      0.2133872   -0.13045497
## Equation long.run  1.1492230 1.9445867      0.7652367    0.02490849
## 
## $Bmiddle
##                            ECT        Const short.run t -1 long.run t -1
## Equation short.run -0.01031875  0.007322243     0.09944158    0.06907443
## Equation long.run   0.01991474 -0.005735839     0.32699066    0.23687489
## 
## $Bup
##                            ECT       Const short.run t -1 long.run t -1
## Equation short.run -0.04920032  0.06691590    -0.11216037    0.04637838
## Equation long.run   0.10732160 -0.09079342     0.08524092   -0.02873180
## 
## 
## Threshold value[1] -1.312  0.774
summary(tvec)
## #############
## ###Model TVECM
## #############
## Full sample size: 482    End sample size: 480
## Number of variables: 2   Number of estimated parameters 24
## AIC -2223.223    BIC -2114.704   SSR 155.4941 
## 
## 
## Cointegrating vector: (1, - 1.045747 )
## $Bdown
##                    ECT                Const              short.run t -1  
## Equation short.run 0.2343(0.0207)*    0.5627(0.0041)**   0.2134(0.2238)  
## Equation long.run  1.1492(1.0e-11)*** 1.9446(2.1e-09)*** 0.7652(0.0077)**
##                    long.run t -1   
## Equation short.run -0.1305(0.1683) 
## Equation long.run  0.0249(0.8718)  
## 
## $Bmiddle
##                    ECT              Const            short.run t -1 
## Equation short.run -0.0103(0.7758)  0.0073(0.6884)   0.0994(0.3462) 
## Equation long.run  0.0199(0.7362)   -0.0057(0.8473)  0.3270(0.0580).
##                    long.run t -1   
## Equation short.run 0.0691(0.2101)  
## Equation long.run  0.2369(0.0086)**
## 
## $Bup
##                    ECT              Const            short.run t -1  
## Equation short.run -0.0492(0.4402)  0.0669(0.4232)   -0.1122(0.2911) 
## Equation long.run  0.1073(0.3022)   -0.0908(0.5053)  0.0852(0.6227)  
##                    long.run t -1   
## Equation short.run 0.0464(0.5256)  
## Equation long.run  -0.0287(0.8095) 
## 
## 
## Threshold
## Values: -1.312 0.774
## Percentage of Observations in each regime 6.7% 56.9% 36.5%
#test1<-TVECM.HStest(zeroyld, lag=1, intercept=TRUE, nboot=10)
#test1
#summary(test1)
#plot(test1)

#TVECM.SeoTest(zeroyld,lag=2, beta=1, trim=0.1,nboot=10, plot=FALSE,check=FALSE)

Chạy phản ứng xung

#data(barry)
#dulieu <-barry
## For VAR
#mod_var <- lineVar(dulieu, lag = 2)
#irf(mod_var, impulse = "dolcan", response = c("dolcan", "cpiUSA", "cpiCAN"), boot = FALSE)
## For VECM
#mod_VECM <- VECM(dulieu, lag = 2, estim="ML", r=2)
#irf(mod_VECM, impulse = "dolcan", response = c("dolcan", "cpiUSA", "cpiCAN"), boot =FALSE)