Using mlrv to anaylze data

{r, include = FALSE} #knitr::opts_chunk$set( # collapse = TRUE, # comment = "#>" #) #

Data analysis in the paper of Bai and Wu (2023b).

Loading data

Hong Kong circulatory and respiratory data.

library(mlrv)
library(foreach)
library(magrittr)


data(hk_data)
colnames(hk_data) = c("SO2","NO2","Dust","Ozone","Temperature",
                      "Humidity","num_circu","num_respir","Hospital Admission",
                      "w1","w2","w3","w4","w5","w6")
n = nrow(hk_data)
t = (1:n)/n
hk = list()

hk$x = as.matrix(cbind(rep(1,n), scale(hk_data[,1:3])))
hk$y = hk_data$`Hospital Admission`

Test for long memory

pvmatrix = matrix(nrow=2, ncol=4)
###inistialization
setting = list(B = 5000, gcv = 1, neighbour = 1)
setting$lb = floor(20/7*n^(4/15)) - setting$neighbour 
setting$ub = max(floor(24/7*n^(4/15))+ setting$neighbour,             
                  setting$lb+2*setting$neighbour+1)

Using the plug-in estimator for long-run covariance matrix function.

setting$lrvmethod =0. 

i=1
for(type in c("KPSS","RS","VS","KS")){
  setting$type = type
  print(type)
  result_reg = heter_covariate(list(y= hk$y, x = hk$x), setting, mvselect = -2)
  print(paste("p-value",result_reg))
  pvmatrix[1,i] = result_reg
  i = i + 1
}
## [1] "KPSS"
## [1] "p-value 0.3886"
## [1] "RS"
## [1] "p-value 0.3194"
## [1] "VS"
## [1] "p-value 0.1324"
## [1] "KS"
## [1] "p-value 0.4554"

Debias difference-based estimator for long-run covariance matrix function.

setting$lrvmethod =1

i=1
for(type in c("KPSS","RS","VS","KS"))
{
  setting$type = type
  print(type)
  result_reg = heter_covariate(list(y= hk$y, x = hk$x), setting, mvselect = -2)
  print(paste("p-value",result_reg))
  pvmatrix[2,i] = result_reg
  i = i + 1
}
## [1] "KPSS"
## [1] "p-value 0.676"
## [1] "RS"
## [1] "p-value 0.8642"
## [1] "VS"
## [1] "p-value 0.721"
## [1] "KS"
## [1] "p-value 0.83"

Output

rownames(pvmatrix) = c("plug","diff")
colnames(pvmatrix) = c("KPSS","RS","VS","KS")
knitr::kable(pvmatrix,type="latex")
KPSS RS VS KS
plug 0.3886 0.3194 0.1324 0.4554
diff 0.6760 0.8642 0.7210 0.8300 
xtable::xtable(pvmatrix, digits = 3)
## % latex table generated in R 4.1.2 by xtable 1.8-4 package
## % Wed Nov  8 09:55:56 2023
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrr}
##   \hline
##  & KPSS & RS & VS & KS \\ 
##   \hline
## plug & 0.389 & 0.319 & 0.132 & 0.455 \\ 
##   diff & 0.676 & 0.864 & 0.721 & 0.830 \\ 
##    \hline
## \end{tabular}
## \end{table}

Sensitivity Check

Using parameter `shift’ to multiply the GCV selected bandwidth by a factor. - Shift = 1.2 with plug-in estimator.

pvmatrix = matrix(nrow=2, ncol=4)
setting$lrvmethod = 0
i=1
for(type in c("KPSS","RS","VS","KS")){
  setting$type = type
  print(type)
  result_reg = heter_covariate(list(y= hk$y, x = hk$x),
                                             setting,
                                        mvselect = -2, shift = 1.2)
  print(paste("p-value",result_reg))
  pvmatrix[1,i] = result_reg
  i = i + 1
}
## [1] "KPSS"
## [1] "p-value 0.3304"
## [1] "RS"
## [1] "p-value 0.4788"
## [1] "VS"
## [1] "p-value 0.141"
## [1] "KS"
## [1] "p-value 0.4458"
setting$lrvmethod =1
i=1
for(type in c("KPSS","RS","VS","KS"))
{
  setting$type = type
  print(type)
  result_reg = heter_covariate(list(y= hk$y, x = hk$x),
                                             setting,
                                        mvselect = -2, verbose_dist = TRUE, shift = 1.2)
  print(paste("p-value",result_reg))
  pvmatrix[2,i] = result_reg
  i = i + 1
}
## [1] "KPSS"
## [1] "gcv 0.204349632243575"
## [1] "m 19 tau_n 0.287672928769368"
## [1] "test statistic: 226.396158777799"
## [1] "Bootstrap distribution"
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   28.01  135.15  250.06  400.76  505.98 4289.70 
## [1] "p-value 0.5414"
## [1] "RS"
## [1] "gcv 0.204349632243575"
## [1] "m 16 tau_n 0.287672928769368"
## [1] "test statistic: 1107.76023547171"
## [1] "Bootstrap distribution"
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   605.7  1083.6  1305.5  1372.8  1592.7  3268.2 
## [1] "p-value 0.7264"
## [1] "VS"
## [1] "gcv 0.204349632243575"
## [1] "m 16 tau_n 0.287672928769368"
## [1] "test statistic: 109.691082564479"
## [1] "Bootstrap distribution"
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   12.86   73.47  118.35  170.37  213.82 1419.70 
## [1] "p-value 0.539"
## [1] "KS"
## [1] "gcv 0.204349632243575"
## [1] "m 18 tau_n 0.287672928769368"
## [1] "test statistic: 810.027920792526"
## [1] "Bootstrap distribution"
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   342.8   775.2  1006.9  1086.6  1312.0  3540.3 
## [1] "p-value 0.7086"
rownames(pvmatrix) = c("plug","diff")
colnames(pvmatrix) = c("KPSS","RS","VS","KS")
knitr::kable(pvmatrix,type="latex")
KPSS RS VS KS
plug 0.3304 0.4788 0.141 0.4458
diff 0.5414 0.7264 0.539 0.7086 
xtable::xtable(pvmatrix, digits = 3)
## % latex table generated in R 4.1.2 by xtable 1.8-4 package
## % Wed Nov  8 09:56:56 2023
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrr}
##   \hline
##  & KPSS & RS & VS & KS \\ 
##   \hline
## plug & 0.330 & 0.479 & 0.141 & 0.446 \\ 
##   diff & 0.541 & 0.726 & 0.539 & 0.709 \\ 
##    \hline
## \end{tabular}
## \end{table}
pvmatrix = matrix(nrow=2, ncol=4)
setting$lrvmethod =0

i=1
for(type in c("KPSS","RS","VS","KS")){
  setting$type = type
  print(type)
  result_reg = heter_covariate(list(y= hk$y, x = hk$x),
                                             setting,
                                        mvselect = -2,  shift = 0.8)
  print(paste("p-value",result_reg))
  pvmatrix[1,i] = result_reg
  i = i + 1
}
## [1] "KPSS"
## [1] "p-value 0.29"
## [1] "RS"
## [1] "p-value 0.1104"
## [1] "VS"
## [1] "p-value 0.07"
## [1] "KS"
## [1] "p-value 0.3014"
setting$lrvmethod =1

i=1
for(type in c("KPSS","RS","VS","KS"))
{
  setting$type = type
  print(type)
  result_reg = heter_covariate(list(y= hk$y, x = hk$x),
                                             setting,
                                        mvselect = -1, verbose_dist = TRUE, shift = 0.8)
  print(paste("p-value",result_reg))
  pvmatrix[2,i] = result_reg
  i = i + 1
}
## [1] "KPSS"
## [1] "gcv 0.136233088162383"
## [1] "m 18 tau_n 0.337672928769368"
## [1] "test statistic: 130.641321978566"
## [1] "Bootstrap distribution"
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   20.26  147.09  273.58  422.03  534.58 4955.34 
## [1] "p-value 0.797"
## [1] "RS"
## [1] "gcv 0.136233088162383"
## [1] "m 18 tau_n 0.337672928769368"
## [1] "test statistic: 1007.54048839408"
## [1] "Bootstrap distribution"
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   687.2  1288.7  1531.5  1603.8  1856.1  4149.5 
## [1] "p-value 0.955"
## [1] "VS"
## [1] "gcv 0.136233088162383"
## [1] "m 18 tau_n 0.337672928769368"
## [1] "test statistic: 80.4446532439607"
## [1] "Bootstrap distribution"
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   27.52   96.29  155.80  204.17  254.66 1332.13 
## [1] "p-value 0.836"
## [1] "KS"
## [1] "gcv 0.136233088162383"
## [1] "m 18 tau_n 0.337672928769368"
## [1] "test statistic: 636.506734392362"
## [1] "Bootstrap distribution"
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   383.2   852.6  1104.3  1188.4  1429.7  3828.9 
## [1] "p-value 0.947"
rownames(pvmatrix) = c("plug","diff")
colnames(pvmatrix) = c("KPSS","RS","VS","KS")
knitr::kable(pvmatrix,type="latex")
KPSS RS VS KS
plug 0.290 0.1104 0.070 0.3014
diff 0.797 0.9550 0.836 0.9470 
xtable::xtable(pvmatrix, digits = 3)
## % latex table generated in R 4.1.2 by xtable 1.8-4 package
## % Wed Nov  8 09:57:46 2023
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrr}
##   \hline
##  & KPSS & RS & VS & KS \\ 
##   \hline
## plug & 0.290 & 0.110 & 0.070 & 0.301 \\ 
##   diff & 0.797 & 0.955 & 0.836 & 0.947 \\ 
##    \hline
## \end{tabular}
## \end{table}

Test for structure stability

Test if the coefficient function of “SO2”,“NO2”,“Dust” of the second year is constant.

hk$x = as.matrix(cbind(rep(1,n), (hk_data[,1:3])))
hk$y = hk_data$`Hospital Admission`
setting$type = 0
setting$bw_set = c(0.1, 0.35)
setting$eta = 0.2
setting$lrvmethod = 1
setting$lb  = 10
setting$ub  = 50
hk1 = list()
hk1$x = hk$x[366:730,]
hk1$y = hk$y[366:730]
p1 <- heter_gradient(hk1, setting, mvselect = -2, verbose = T)
## [1] "m 27 tau_n 0.374190823993618"
## [1] 10464.35
##        V1       
##  Min.   : 2745  
##  1st Qu.: 5815  
##  Median : 7326  
##  Mean   : 7765  
##  3rd Qu.: 9255  
##  Max.   :20901
p1
## [1] 0.149

One can also use another scheme of MV selection based on the volatility of the estimator by setting mvselect = -1.

p1 <- heter_gradient(hk1, setting, mvselect = -1)
p1
## [1] 0.0066