tests/00SetarAndFriends.R

In tsDyn: Nonlinear Time Series Models with Regime Switching

library(tsDyn)
suppressMessages(library(dplyr))
library(tidyr)

###SETAR

mod.setar <- setar(log10(lynx), m=2, thDelay=1, th=3.25)
mod.setar
summary(mod.setar)

set0 <- setar(lynx,m=2)
set1 <- setar(lynx,m=2, th=1426,trace=TRUE,thDelay=1)
set2 <- setar(lynx,m=2, th=c(600,1426),trace=TRUE)
set3 <- setar(lynx,m=2, trace=TRUE,nthresh=1)
set4 <- setar(lynx,m=2, trace=TRUE,nthresh=2, trim=0.05)
set5 <- setar(lynx,m=2, th=c(600,1426),include="trend")
set6 <- setar(lynx,m=2, th=c(600,1426),include="both")
set7 <- setar(lynx,m=2, th=c(600,1426),include="none")

set_all <- list(set0=set0, set1=set1, set2=set2, set3=set3, set4=set4,
                set5=set5, set6=set6, set7=set7)

set_all
sapply(set_all, function(x) c(AIC=AIC(x), BIC=BIC(x), deviance=deviance(x)))
lapply(set_all, summary)
sapply(set_all, function(x) tail(coef(x),4))
sapply(set_all, function(x) tail(coef(x, hyperCo=FALSE),4))
lapply(set_all, function(x) round(vcov(x),9))

lapply(set_all, function(x) window(residuals(x), end=c(1830)))
lapply(set_all, function(x) window(fitted(x), end=c(1830)))

lapply(set_all, function(x) window(regime(x), end=c(1830)))
lapply(set_all, function(x) window(regime(x, initVal=FALSE), end=c(1830)))
sapply(set_all, function(x) head(regime(x, time=FALSE),10))
sapply(set_all, function(x) head(regime(x, initVal=FALSE, time=FALSE),10))

sapply(set_all, function(x) head(x$model,2))

lapply(set_all[c(1,2,4)], toLatex)

## coefs
sapply(set_all, function(x) tail(coef(x, regime = "L"),4))
sapply(set_all, function(x) tail(coef(x, regime = "H"),4))


###SelectSetar
selectSETAR(lynx, m=2, d=1,  trace=TRUE, include = "const", common="none", model="TAR", nthresh=1,trim=0.15,criterion = "SSR", plot=FALSE,max.iter=2)
selectSETAR(lynx, m=2, d=1,  trace=TRUE, include = "const", common="none", model="TAR", nthresh=2,trim=0.15,criterion = "SSR", plot=FALSE,max.iter=3)
selectSETAR(lynx, m=2, d=1, th=MakeThSpec(ngrid="Half"), common="none",trim=0.15,criterion = "SSR", plot=FALSE)
selectSETAR(lynx, m=2, d=1, th=MakeThSpec(ngrid=20), common="none",trim=0.15,criterion = "SSR", plot=FALSE)
selectSETAR(lynx, m=2, d=1, th=MakeThSpec(exact=1388), common="none",trim=0.15,criterion = "SSR", plot=FALSE)
selectSETAR(lynx, m=2, d=1, th=MakeThSpec(around=1388, ngrid=20), common="none",criterion = "SSR", plot=FALSE)
selectSETAR(lynx, m=2, d=1, th=MakeThSpec(int=c(957, 1824)), common="none",criterion = "SSR", plot=FALSE)
selectSETAR(lynx, m=2, d=1, th=MakeThSpec(int=c(957, 1824), ngrid=5), common="none",criterion = "SSR", plot=FALSE)
selectSETAR(lynx, m=2, d=1, th=MakeThSpec(int=c(957, 1824), ngrid="Half"), common="none",criterion = "SSR", plot=FALSE)


## setar.sim
set_all_boot <- lapply(set_all, function(x) setar.boot(x, boot.scheme = "check", returnStarting = TRUE, round_digits=10))
set_all_boot_check <-  sapply(set_all_boot, function(x) all.equal(x, as.numeric(lynx)))

vals_df <- bind_cols(set_all_boot) %>%  
  mutate(n_row = 1:n()) %>% 
  gather(model, value, -n_row) %>% 
  mutate(original = rep(as.numeric(lynx), length(set_all_boot)),
         diff = abs(value-original) < 1e-010)

if(FALSE) {
  vals_df %>% 
    filter(value!=original) %>% 
    group_by(model) %>%
    mutate(rmse = sqrt(mean(value-original)^2)) %>% 
    filter(n_row ==min(n_row)) %>% 
    select(-rmse)
}