Using mlrv to anaylze data

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(10/7*n^(4/15)) - setting$neighbour 
setting$ub = max(floor(25/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
# print(rule_of_thumb(y= hk$y, x = hk$x))
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.2992"
## [1] "RS"
## [1] "p-value 0.2974"
## [1] "VS"
## [1] "p-value 0.0954"
## [1] "KS"
## [1] "p-value 0.3432"

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.5072"
## [1] "RS"
## [1] "p-value 0.8988"
## [1] "VS"
## [1] "p-value 0.7328"
## [1] "KS"
## [1] "p-value 0.8114"

Output

rownames(pvmatrix) = c("plug","diff")
colnames(pvmatrix) = c("KPSS","RS","VS","KS")
knitr::kable(pvmatrix,type="latex")

	KPSS	RS	VS	KS
plug	0.2992	0.2974	0.0954	0.3432
diff	0.5072	0.8988	0.7328	0.8114

xtable::xtable(pvmatrix, digits = 3)

## % latex table generated in R 4.4.2 by xtable 1.8-4 package
## % Tue Jan 28 07:47:07 2025
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrr}
##   \hline
##  & KPSS & RS & VS & KS \\ 
##   \hline
## plug & 0.299 & 0.297 & 0.095 & 0.343 \\ 
##   diff & 0.507 & 0.899 & 0.733 & 0.811 \\ 
##    \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.4536"
## [1] "RS"
## [1] "p-value 0.373"
## [1] "VS"
## [1] "p-value 0.1318"
## [1] "KS"
## [1] "p-value 0.5916"

Shift = 1.2 with debias difference-based estimator. Choosing verbose_dist = TRUE can print more intermediate results, the exact values of smoothing parameters, the test statistic, the summary of bootstrap distribution and the p-value.

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.193398841583897"
## [1] "m 8 tau_n 0.382134206312301"
## [1] "test statistic: 141.654657280932"
## [1] "Bootstrap distribution"
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   10.58   67.80  135.12  222.40  274.71 2261.59 
## [1] "p-value 0.4812"
## [1] "RS"
## [1] "gcv 0.193398841583897"
## [1] "m 15 tau_n 0.382134206312301"
## [1] "test statistic: 1067.76713443354"
## [1] "Bootstrap distribution"
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   565.1  1010.4  1221.6  1291.2  1501.7  3068.0 
## [1] "p-value 0.6824"
## [1] "VS"
## [1] "gcv 0.193398841583897"
## [1] "m 8 tau_n 0.382134206312301"
## [1] "test statistic: 103.342038019402"
## [1] "Bootstrap distribution"
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   10.30   42.38   67.17   98.79  122.14  897.82 
## [1] "p-value 0.3078"
## [1] "KS"
## [1] "gcv 0.193398841583897"
## [1] "m 16 tau_n 0.382134206312301"
## [1] "test statistic: 671.676091515896"
## [1] "Bootstrap distribution"
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   316.9   698.0   913.0  1000.6  1224.0  3043.6 
## [1] "p-value 0.7834"

Results of shift = 1.2

rownames(pvmatrix) = c("plug","diff")
colnames(pvmatrix) = c("KPSS","RS","VS","KS")
knitr::kable(pvmatrix,type="latex")

	KPSS	RS	VS	KS
plug	0.4536	0.3730	0.1318	0.5916
diff	0.4812	0.6824	0.3078	0.7834

xtable::xtable(pvmatrix, digits = 3)

## % latex table generated in R 4.4.2 by xtable 1.8-4 package
## % Tue Jan 28 07:47:42 2025
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrr}
##   \hline
##  & KPSS & RS & VS & KS \\ 
##   \hline
## plug & 0.454 & 0.373 & 0.132 & 0.592 \\ 
##   diff & 0.481 & 0.682 & 0.308 & 0.783 \\ 
##    \hline
## \end{tabular}
## \end{table}

Shift = 0.8 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 = 0.8)
  print(paste("p-value",result_reg))
  pvmatrix[1,i] = result_reg
  i = i + 1
}

## [1] "KPSS"
## [1] "p-value 0.2202"
## [1] "RS"
## [1] "p-value 0.1608"
## [1] "VS"
## [1] "p-value 0.1176"
## [1] "KS"
## [1] "p-value 0.2646"

Shift = 0.8 with the debias difference-based estimator.

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 = 0.8)
  print(paste("p-value",result_reg))
  pvmatrix[2,i] = result_reg
  i = i + 1
}

## [1] "KPSS"
## [1] "gcv 0.128932561055931"
## [1] "m 18 tau_n 0.382134206312301"
## [1] "test statistic: 166.543448031108"
## [1] "Bootstrap distribution"
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   29.21  155.31  297.23  488.79  615.55 4887.19 
## [1] "p-value 0.7256"
## [1] "RS"
## [1] "gcv 0.128932561055931"
## [1] "m 17 tau_n 0.332134206312301"
## [1] "test statistic: 998.08124125936"
## [1] "Bootstrap distribution"
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   647.7  1207.7  1454.5  1523.0  1760.9  3967.4 
## [1] "p-value 0.9274"
## [1] "VS"
## [1] "gcv 0.128932561055931"
## [1] "m 18 tau_n 0.382134206312301"
## [1] "test statistic: 78.0587445148257"
## [1] "Bootstrap distribution"
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   24.72   99.34  163.07  225.88  286.42 2274.16 
## [1] "p-value 0.8514"
## [1] "KS"
## [1] "gcv 0.128932561055931"
## [1] "m 9 tau_n 0.382134206312301"
## [1] "test statistic: 709.345279801765"
## [1] "Bootstrap distribution"
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   294.8   704.2   921.7   986.6  1194.4  3354.8 
## [1] "p-value 0.7432"

Results of shift = 0.8

rownames(pvmatrix) = c("plug","diff")
colnames(pvmatrix) = c("KPSS","RS","VS","KS")
knitr::kable(pvmatrix,type="latex")

	KPSS	RS	VS	KS
plug	0.2202	0.1608	0.1176	0.2646
diff	0.7256	0.9274	0.8514	0.7432

xtable::xtable(pvmatrix, digits = 3)

## % latex table generated in R 4.4.2 by xtable 1.8-4 package
## % Tue Jan 28 07:48:13 2025
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrr}
##   \hline
##  & KPSS & RS & VS & KS \\ 
##   \hline
## plug & 0.220 & 0.161 & 0.118 & 0.265 \\ 
##   diff & 0.726 & 0.927 & 0.851 & 0.743 \\ 
##    \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  = 15
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 11 tau_n 0.414293094094381"
## [1] 10464.35
##        V1       
##  Min.   : 1469  
##  1st Qu.: 3380  
##  Median : 4339  
##  Mean   : 4705  
##  3rd Qu.: 5679  
##  Max.   :13033

p1

## [1] 0.0084