library(KFAS)
#Example of local level model
#Using the Nile observations
data(Nile)
yt<-t(data.matrix(Nile))
s2_eps<-15099
s2_eta<-1469.1
f.out<-kf(yt = yt, Zt = 1, Tt=1, Rt=1, Ht= s2_eps, Qt=s2_eta, a1 =
0, P1=1e7)
#a1 and P1 are not really estimated,
#should actually use exact diffuse initialisation:
fd.out<-kf(yt = yt, Zt = 1, Tt=1, Rt=1, Ht=s2_eps, Qt=s2_eta, a1 =
0, P1=0, P1inf=1)
#No stationary elements, P1=0, P1inf=1
#Plotting observations, non-diffuse and diffuse at, not plotting the a1=0:
ts.plot(Nile, ts(f.out$at[1,2:length(Nile)], start=1872, end=1970),
ts(fd.out$at[1,2:length(Nile)], start=1872, end=1970), col=c(1,2,3))
#Looks identical. Actually start of series differs little bit:
f.out$at[1,1:20]
fd.out$at[1,1:20]
#Example of multivariate local level model
#Two series of average global temperature deviations for years 1880-1987
#See Shumway and Stoffer (2006), p. 327 for details
data(GlobalTemp)
yt<-array(GlobalTemp,c(2,108))
#Estimating the variance parameters
likfn<-function(par, yt, a1, P1, P1inf) #Function to optim
{
L<-matrix(c(par[1],par[2],0,par[3]),ncol=2)
H<-L%*%t(L)
q11<-exp(par[4])
lik<-kf(yt = yt, Zt = matrix(1,nrow=2), Tt=1, Rt=1, Ht=H, Qt=q11, a1 =
a1, P1=P1, P1inf=P1inf, optcal=c(FALSE,FALSE,FALSE,FALSE))
lik$lik
}
#Diffuse initialisation
#Notice that diffuse initialisation without univariate approach does not
#work here because Finf is non-singular and non-zero
est<-optim(par=c(.1,0,.1,.1), likfn, method="BFGS",
control=list(fnscale=-1), hessian=TRUE, yt=yt, a1=0, P1=0, P1inf=1)
pars<-est$par
L<-matrix(c(pars[1],pars[2],0,pars[3]),ncol=2)
H<-L%*%t(L)
q11<-exp(pars[4])
kfd<-kf(yt = yt, Zt = matrix(1,nrow=2), Tt=1, Rt=1,
Ht=H, Qt=q11, a1 = 0, P1=0, P1inf=1)
#Same as non-diffuse, initial values from Shumway and Stoffer (2006):
est<-optim(par=c(.1,0,.1,.1), likfn, method="BFGS",
control=list(fnscale=-1), hessian=TRUE, yt=yt, a1=-0.35, P1=0.01, P1inf=0)
pars<-est$par
L<-matrix(c(pars[1],pars[2],0,pars[3]),ncol=2)
H<-L%*%t(L)
q11<-exp(pars[4])
kfnd<-kf(yt = yt, Zt = matrix(1,nrow=2), Tt=1, Rt=1, Ht=H, Qt=q11,
a1 = -0.35, P1=0.01, P1inf=0)
kfd$Qt
kfnd$Qt
kfd$Ht
kfnd$Ht
#Estimated Qt and Ht differs
ts.plot(ts(yt[1,],start=1880),ts(yt[2,],start=1880),ts(kfd$at[1,],start=1880),ts(kfnd$at[1,],start=1880),col=c(1,2,3,4))
#differs at start
#Example of stationary ARMA(1,1)
n<-1000
ar1<-0.8
ma1<-0.3
sigma<-0.5
yt<-arima.sim(model=list(ar=ar1,ma=ma1), n=n, sd=sigma)
dt <- matrix(0, nrow = 2)
Zt<-matrix(c(1,0),ncol=2)
Tt<-matrix(c(ar1,0,1,0),ncol=2)
Rt<-matrix(c(1,ma1),ncol=1)
a1<-matrix(c(0,0),ncol=1)
P1<-matrix(0,ncol=2,nrow=2)
P1[1,1]<-1/(1-ar1^2)*(1+ma1^2+2*ar1*ma1)
P1[1,2]<-ma1
P1[2,1]<-ma1
P1[2,2]<-ma1^2
f.out<-kf(yt = array(yt,dim=c(1,n)), Zt = Zt, Tt=Tt, Rt=Rt, Ht= 0,
Qt=sigma^2, a1 = a1, P1=P1)
Run the code above in your browser using DataLab