Replication of results from the literature using the spINAR package

Application

This file provides reproduced results from the literature for each provided functionality of the package.

First, we reproduce the Tables 8, 9 and part of Table 10 published in Jentsch and Weiß (2017) who analyze a time series of length \(n=1632\) containing counts concerning the Lufthansa stock traded in the XETRA system of Deutsche Börse. This data set was first analyzed by Jung and Tremayne (2011). For reproducing the results of the stated Tables, we use the functions , and , where the latter implicitly makes additionally use of .

# Load the package
library(spINAR)

The following data were read from Figure 3 in Jung and Tremayne (2011).

ice <- c(0, 0, 0, 1, 1, 1, 2, 1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 2, 1, 0, 0,
         0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1,
         0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 1, 2,
         3, 2, 1, 0, 1, 1, 0, 2, 0, 0, 1, 2, 2, 1, 1, 1, 0, 0, 0, 0, 0, 2, 2, 0,
         0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 1, 2, 1, 1, 2, 2, 2, 1,
         2, 2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 2, 0, 0, 0, 0, 0, 0,
         0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 2, 1, 1,
         0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 2, 0, 5, 1, 2, 0, 0, 0,
         1, 2, 0, 1, 1, 3, 2, 3, 1, 2, 3, 2, 1, 1, 1, 1, 2, 0, 1, 0, 0, 1, 1, 1,
         2, 3, 1, 1, 1, 2, 2, 1, 1, 0, 1, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1,
         2, 1, 1, 1, 2, 2, 2, 0, 1, 0, 0, 0, 0, 1, 2, 0, 0, 0, 0, 0, 0, 1, 1, 1, 
         1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 2, 1, 0, 1, 0, 0, 1,
         0, 2, 1, 1, 2, 0, 1, 0, 0, 2, 0, 1, 1, 0, 1, 1, 0, 1, 0, 3, 1, 1, 2, 0,
         0, 2, 1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0,
         1, 0, 0, 0, 0, 0, 1, 1, 2, 2, 1, 0, 1, 0, 1, 1, 0, 0, 0, 0, 1, 1, 0, 2,
         2, 2, 2, 2, 0, 2, 2, 0, 2, 2, 2, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 
         1, 1, 1, 1, 0, 0, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0,
         0, 1, 1, 2, 2, 1, 0, 0, 0, 0, 0, 0, 0, 3, 4, 4, 4, 3, 3, 3, 2, 1, 2, 2,
         2, 2, 1, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0,
         0, 0, 1, 2, 1, 0, 0, 0, 0, 0, 0, 1, 0, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 
         0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 0, 0, 0, 1, 
         1, 0, 0, 0, 1, 0, 1, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1, 1, 2, 0, 1, 2, 
         2, 1, 1, 1, 0, 2, 1, 1, 2, 3, 3, 2, 1, 1, 2, 1, 1, 0, 1, 1, 2, 3, 2, 2,
         2, 1, 2, 1, 0, 1, 1, 1, 0, 0, 4, 3, 2, 1, 3, 1, 0, 1, 0, 0, 1, 0, 0, 0, 
         1, 0, 0, 0, 1, 1, 2, 2, 3, 3, 2, 2, 1, 1, 1, 1, 2, 1, 0, 0, 0, 0, 0, 1, 
         2, 2, 2, 0, 0, 0, 1, 3, 1, 2, 1, 0, 1, 1, 1, 2, 2, 1, 2, 1, 1, 1, 0, 1, 
         0, 0, 1, 0, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1,
         1, 1, 1, 1, 2, 3, 2, 0, 1, 1, 1, 1, 2, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2, 1,
         0, 0, 1, 1, 2, 2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 2, 1, 1, 1, 1,
         1, 0, 1, 1, 2, 2, 2, 1, 1, 0, 1, 0, 1, 0, 1, 2, 3, 2, 1, 0, 1, 0, 0, 0,
         0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0,
         0, 0, 0, 2, 0, 1, 2, 2, 0, 1, 0, 0, 1, 0, 1, 2, 1, 1, 1, 0, 0, 2, 0, 1,
         1, 3, 2, 2, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 0, 2,
         1, 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 3, 3, 5,
         1, 2, 2, 2, 2, 3, 2, 3, 3, 2, 3, 3, 1, 1, 1, 1, 1, 1, 1, 0, 1, 0, 0, 1,
         1, 1, 0, 1, 1, 1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 3,
         1, 0, 0, 1, 0, 1, 1, 0, 0, 1, 3, 3, 3, 2, 1, 2, 1, 0, 1, 2, 1, 2, 1, 1,
         1, 2, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2, 0, 2, 2, 4, 3, 2, 0, 2,
         2, 2, 0, 2, 2, 2, 2, 0, 1, 2, 4, 2, 1, 0, 1, 3, 1, 0, 1, 0, 0, 0, 0, 1,
         1, 0, 1, 0, 1, 1, 2, 1, 1, 1, 1, 0, 1, 0, 0, 0, 0, 2, 1, 1, 2, 2, 2, 0,
         2, 1, 2, 0, 2, 2, 0, 0, 0, 2, 2, 1, 2, 2, 0, 0, 0, 1, 0, 0, 1, 1, 0, 0,
         1, 2, 3, 2, 2, 0, 2, 1, 1, 2, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0,
         0, 1, 2, 1, 1, 1, 1, 0, 2, 1, 1, 1, 1, 2, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1,
         1, 0, 0, 0, 0, 0, 1, 2, 1, 2, 0, 0, 0, 0, 1, 1, 1, 1, 1, 2, 3, 2, 2, 0,
         0, 1, 1, 0, 2, 0, 1, 0, 1, 1, 2, 0, 1, 0, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1,
         0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1,
         0, 0, 0, 1, 1, 0, 1, 2, 1, 0, 1, 0, 0, 0, 0, 1, 0, 0, 4, 1, 2, 1, 1, 3,
         2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0,
         0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0,
         0, 0, 0, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0,
         0, 0, 0, 0, 1, 1, 1, 1, 4, 0, 2, 2, 3, 1, 1, 1, 1, 2, 0, 3, 3, 2, 1, 1,
         1, 1, 0, 2, 2, 2, 1, 0, 1, 0, 0, 1, 2, 1, 2, 0, 1, 1, 1, 1, 1, 1, 0, 1,
         1, 0, 1, 0, 0, 0, 0, 1, 1, 0, 0, 0, 1, 1, 1, 0, 1, 0, 1, 0, 1, 1, 2, 0,
         0, 2, 0, 4, 2, 2, 0, 1, 3, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1,
         3, 4, 5, 4, 4, 3, 2, 2, 2, 2, 2, 1, 1, 2, 1, 2, 1, 1, 0, 0, 0, 0, 0, 0,
         0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 1, 1, 1, 1, 2, 1, 1, 1, 0, 0, 1,
         0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 1, 1, 1, 1, 1, 0, 2, 0, 0, 0, 1,
         1, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2, 1,
         0, 3, 1, 2, 3, 3, 1, 1, 0, 0, 2, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 2,
         0, 0, 0, 1, 1, 1, 1, 1, 1, 3, 1, 1, 2, 0, 0, 2, 1, 1, 2, 3, 2, 7, 3, 6,
         5, 0, 1, 1, 1, 1, 2, 1, 0, 1, 1, 0, 0, 1, 0, 1, 1, 0, 0, 1, 1, 1, 1, 0,
         2, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2, 0, 0,
         2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 2, 2, 2, 1, 2, 0, 1, 1, 1, 1, 1, 1, 2,
         0, 1, 2, 1, 1, 2, 0, 1, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
         0, 0, 1, 1, 1, 1, 1, 1, 2, 2, 1, 2, 1, 2, 3, 1, 1, 1, 0, 1, 1, 1, 2, 1,
         2, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1,
         2, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
         0, 0, 0, 0, 1, 0, 1, 1, 2, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0)

Semi-parametric INAR(\(p\)) estimates for iceberg counts (Table 8):

# p=1
xmax <- max(ice)
est_sp_1 <- spinar_est(ice,1)
mu_e_sp_1 <- sum(est_sp_1[-1]*(0:xmax))
sigma2_e_sp_1 <- sum(est_sp_1[-1]*(0:xmax)^2) - mu_e_sp_1^2
c(est_sp_1, mu_e_sp_1,sigma2_e_sp_1)
#>  [1] 5.272320e-01 6.974124e-01 2.500813e-01 4.383088e-02 4.942549e-03
#>  [6] 2.395474e-03 1.337384e-03 1.137424e-08 5.075722e-09 3.688396e-01
#> [11] 4.056079e-01

# p=2
est_sp_2 <- spinar_est(ice,2)
mu_e_sp_2 <- sum(est_sp_2[-(1:2)]*(0:xmax))
sigma2_e_sp_2 <- sum(est_sp_2[-(1:2)]*(0:xmax)^2) - mu_e_sp_2^2
c(est_sp_1, mu_e_sp_2,sigma2_e_sp_2)
#>  [1] 5.272320e-01 6.974124e-01 2.500813e-01 4.383088e-02 4.942549e-03
#>  [6] 2.395474e-03 1.337384e-03 1.137424e-08 5.075722e-09 2.830096e-01
#> [11] 3.139332e-01

Parametric INAR(\(p\)) estimates for iceberg counts (Table 9)

# p=1
est_p_1 <- spinar_est_param(ice,1,"mom","poi")
est_p_1_v <- c(est_p_1[1],dpois(0:xmax,est_p_1[2]))
unname(c(est_p_1_v, est_p_1[2], est_p_1[2]))
#>  [1] 5.071281e-01 6.816465e-01 2.612370e-01 5.005878e-02 6.394911e-03
#>  [6] 6.127031e-04 4.696298e-05 2.999714e-06 1.642319e-07 3.832442e-01
#> [11] 3.832442e-01

# p=2
est_p_2 <- spinar_est_param(ice,2,"mom","poi")
est_p_2_v <- c(est_p_2[1:2],dpois(0:xmax,est_p_2[3]))
unname(c(est_p_2_v, est_p_2[3], est_p_2[3]))
#>  [1] 4.118988e-01 1.877816e-01 7.325102e-01 2.280143e-01 3.548791e-02
#>  [6] 3.682202e-03 2.865470e-04 1.783916e-05 9.254893e-07 4.115492e-08
#> [11] 3.112780e-01 3.112780e-01

For Table 10, we focus on the reproducing of the confidence intervals of the observations’ mean.

# Setting of parametrizations (Jentsch and Weiß, 2017)
B <- 10^4
level <- 0.05
M <- 10

mu_est <- mean(ice)

95% confidence intervals for the observations’ mean using the parametric approach

# p=1
xstar_p <- spinar_boot(ice, 1, B, "p", "mom", "poi", progress = FALSE)$x_star
mu_est_star <- apply(xstar_p, 2, mean)
mu_est_star_cent <- mu_est_star - mu_est
srt <- sort(mu_est_star_cent)
c(mu_est - quantile(srt,1-level,names=FALSE), mu_est - quantile(srt,level,names=FALSE))
#> [1] 0.7132353 0.8394608

# p=2
xstar_p <- spinar_boot(ice, 2, B, "p", "mom", "poi", progress = FALSE)$x_star
mu_est_star <- apply(xstar_p, 2, mean)
mu_est_star_cent <- mu_est_star - mu_est
srt <- sort(mu_est_star_cent)
c(mu_est - quantile(srt,1-level,names=FALSE), mu_est - quantile(srt,level,names=FALSE))
#> [1] 0.6960784 0.8553922

95% confidence intervals for the observations’ mean using the semi-parametric approach

# p=1
mu_est_cent <- mu_e_sp_1/(1-est_sp_1[1])
xstar_sp <- spinar_boot(ice, 1, B, "sp", progress = FALSE)$x_star
mu_est_star <- apply(xstar_sp, 2, mean)
mu_est_star_cent <- mu_est_star - mu_est_cent
srt <- sort(mu_est_star_cent)
c(mu_est - quantile(srt,1-level,names=FALSE), mu_est - quantile(srt,level,names=FALSE))

# p=2
mu_est_cent <- mu_e_sp_2/(1-est_sp_2[1]-est_sp_2[2])
xstar_sp <- spinar_boot(ice, 2, B, "sp", progress = FALSE)$x_star
mu_est_star <- apply(xstar_sp, 2, mean)
mu_est_star_cent <- mu_est_star - mu_est_cent
srt <- sort(mu_est_star_cent)
c(mu_est - quantile(srt,1-level,names=FALSE), mu_est - quantile(srt,level,names=FALSE))

Next, we reproduce the results of Figure 10 published in Faymonville et al. (2022). They considered a time series of length \(n=51\) of the monthly demand of a car spare part from January 1998 to March 2002. The data set was first analyzed in Hyndman (2008) and is available in the R package . For reproducing, we use the function . A validation of the penalization parameters could be done with .

# Load the data set
data <- c(1,1,0,2,1,4,4,5,4,0,2,1,0,0,1,2,1,3,1,0,1,2,1,0,0,1,0,1,0,0,2,0,2,2,0,
2,1,0,1,2,1,1,0,0,0,0,0,0,1,2,2)

# Unpenalized estimation of the innovation distribution 
est_unpenal <- spinar_est(data,1)

# Penalized estimation of the innovation distribution
est_penal <- spinar_penal(data,1,0,1)

Plot of the unpenalized and penalized estimated innovation distribution (see https://github.com/MFaymon/spINAR/blob/main/vignettes/barplots.png)

par(mfrow=c(1,2))
barplot(est_unpenal[-1], ylim=c(0,1),names.arg=0:5,
main="Unpenalized estimated \n innovation distribution")
barplot(est_penal[-1], ylim=c(0,1),names.arg=0:5,
main="Penalized estimated \n innovation distribution")

### References

Faymonville, M., Jentsch, C., Weiß, C.H. and Aleksandrov, B. (2022). “Semiparametric Estimation of INAR Models using Roughness Penalization”. Statistical Methods & Applications. DOI
Hyndman, R., Koehler, A., Ord, K. and Snyder, R. (2008). “Forecasting with Exponential Smoothing”. Springer. DOI
Jentsch, C. and Weiß, C.H. (2017), “Bootstrapping INAR Models”. Bernoulli 25(3), pp. 2359-2408. DOI
Jung, R.C. and Tremayne, A.R. (2011), “Convolution-closed Models for Count Time Series with Applications”. Journal of Time Series Analysis 32, pp. 268-280. DOI