MKF.Full.RB: Full Information Propagation Step under Mixture Kalman Filter
In ConvFuncTimeSeries/test_t: Nonlinear time series analysis

Description Usage Arguments Value References Examples

This function implements the full information propagation step under mixture Kalman filter with full information proposal distribution and Rao-Blackwellization, no delay.

1 2	MKF.Full.RB(MKFstep.Full.RB, nobs, yy, mm, par, II.init, mu.init, SS.init, xdim, ydim, resample.sch)

`MKFstep.Full.RB`	a function that performs one step propagation under mixture Kalman filter, with full information proposal distribution. Its input includes `(mm,II,mu,SS,logww,yyy,par,xdim,ydim)`, where `II`, `mu`, and `SS` are the indicators and its corresponding mean and variance matrix of the Kalman filter components in the last iterations. `logww` is the log weight of the last iteration. `yyy` is the observation at current time step. It should return the Rao-Blackwellization estimation of the mean and variance.
`nobs`	the number of observations `T`.
`yy`	the observations with `T` columns and `ydim` rows.
`mm`	the Monte Carlo sample size `m`.
`par`	a list of parameter values to pass to `Sstep`.
`II.init`	the initial indicators.
`mu.init`	the initial mean.
`SS.init`	the initial variance.
`xdim`	the dimension of the state varible `x_t`.
`ydim`	the dimension of the observation `y_t`.
`resample.sch`	a binary vector of length `nobs`, reflecting the resampling schedule. resample.sch[i]= 1 indicating resample should be carried out at step `i`.

The function returns a list with components:

`xhat`	the fitted value.
`xhatRB`	the fitted value using Rao-Blackwellization.
`Iphat`	the estimated indicators.
`IphatRB`	the esitmated indicators using Rao-Blackwellization.

Tsay, R. and Chen, R. (2019). Nonlinear Time Series Analysis. Wiley, New Jersey.

HH <- matrix(c(2.37409, -1.92936, 0.53028,0,1,0,0,0,0,1,0,0,0,0,1,0),ncol=4,byrow=TRUE)
WW <- matrix(c(1,0,0,0),nrow=4)
GG <- matrix(0.01*c(0.89409,2.68227,2.68227,0.89409),nrow=1)
VV <- 1.3**15*0.001
par <- list(HH=HH,WW=WW,GG=GG,VV=VV)
set.seed(1)
simu <- simu_fading(200,par)
GG1 <- GG; GG2 <- -GG
xdim <- 4; ydim <- 1
nobs <- 10050
mm <- 100; resample.sch <- rep(1,nobs)
kk <- 5
SNR <- 1:kk; BER1 <- 1:kk; BER0 <- 1:kk; BER.known <- 1:kk
tt <- 50:(nobs-1)
for(i in 1:kk){
VV <- 1.3**i*0.001
par <- list(HH=HH,WW=WW,GG=GG,VV=VV)
par2 <- list(HH=HH,WW=WW,GG1=GG1,GG2=GG2,VV=VV)
set.seed(1)
simu <- simu_fading(nobs,par)
mu.init <- matrix(0,nrow=4,ncol=mm)
SS0 <- diag(c(1,1,1,1))
for(n0 in 1:20){
SS0 <- HH%*%SS0%*%t(HH)+WW%*%t(WW)
}
SS.init <- aperm(array(rep(SS0,mm),c(4,4,mm)),c(1,2,3))
II.init <- floor(runif(mm)+0.5)+1
out <- MKF.Full.RB(MKFstep.fading,nobs,simu$yy,mm,par2,II.init,
mu.init,SS.init,xdim,ydim,resample.sch)
SNR[i] <- 10*log(var(simu$yy)/VV**2-1)/log(10)
Strue <- simu$ss[2:nobs]*simu$ss[1:(nobs-1)]
Shat <- rep(-1,(nobs-1))
Shat[out$IphatRB[2:nobs]>0.5] <- 1
BER1[i] <- sum(abs(Strue[tt]-Shat[tt]))/(nobs-50)/2
Shat0 <- sign(simu$yy[1:(nobs-1)]*simu$yy[2:nobs])
BER0[i] <- sum(abs(Strue[tt]-Shat0[tt]))/(nobs-50)/2
S.known <- sign(simu$yy*simu$alpha)
Shat.known <- S.known[1:(nobs-1)]*S.known[2:nobs]
BER.known[i] <- sum(abs(Strue[tt]-Shat.known[tt]))/(nobs-50)/2
}