Description of DiffuseKalmanSmootherH3corr

0001 function [alphahat,epsilonhat,etahat,a1] = DiffuseKalmanSmootherH3corr(T,R,Q,H,Pinf1,Pstar1,Y,trend,pp,mm,smpl,mf)
0002 % stephane.adjemian@cepremap.cnrs.fr [09-16-2004]
0003 %
0004 %   See "Fast Filtering and Smoothing for Multivariate State Space
0005 %   Models", S.J. Koopman and J. Durbin (2000, in Journal of Time Series
0006 %   Analysis, vol. 21(3), pp. 281-296).
0007 
0008 global options_;
0009 
0010 rr = size(Q,1);
0011 T  = cat(1,cat(2,T,zeros(mm,pp)),zeros(pp,mm+pp));
0012 R  = cat(1,cat(2,R,zeros(mm,pp)),cat(2,zeros(pp,rr),eye(pp)));
0013 Q  = cat(1,cat(2,Q,zeros(rr,pp)),cat(2,zeros(pp,rr),H));
0014 if size(Pinf1,1) % Otherwise Pinf = 0 (no unit root)
0015     Pinf1 = cat(1,cat(2,Pinf1,zeros(mm,pp)),zeros(pp,mm+pp));
0016 end
0017 Pstar1   = cat(1,cat(2,Pstar1,zeros(mm,pp)),cat(2,zeros(pp,mm),H));
0018 spinf    = size(Pinf1);
0019 spstar   = size(Pstar1);
0020 Pstar    = zeros(spstar(1),spstar(2),smpl+1); Pstar(:,:,1) = Pstar1;
0021 Pinf     = zeros(spinf(1),spinf(2),smpl+1); Pinf(:,:,1) = Pinf1;
0022 Pstar1      = Pstar;
0023 Pinf1       = Pinf;
0024 v           = zeros(pp,smpl);
0025 a           = zeros(mm+pp,smpl+1);
0026 a1         = a;
0027 Fstar      = zeros(pp,smpl);
0028 Finf     = zeros(pp,smpl);
0029 Fi         = zeros(pp,smpl);
0030 Ki          = zeros(mm+pp,pp,smpl);
0031 Li          = zeros(mm+pp,mm+pp,pp,smpl);
0032 Linf        = zeros(mm+pp,mm+pp,pp,smpl);
0033 L0          = zeros(mm+pp,mm+pp,pp,smpl);
0034 Kstar       = zeros(mm+pp,pp,smpl);
0035 Kinf     = zeros(mm+pp,pp,smpl);
0036 P           = zeros(mm+pp,mm+pp,smpl+1);
0037 P1         = zeros(mm+pp,mm+pp,smpl+1);
0038 crit        = options_.kalman_tol;
0039 steady      = smpl;
0040 QQ          = R*Q*transpose(R);
0041 QRt         = Q*transpose(R);
0042 alphahat     = zeros(mm+pp,smpl);
0043 etahat         = zeros(rr,smpl);
0044 epsilonhat     = zeros(pp,smpl);
0045 r              = zeros(mm+pp,smpl);
0046 Z = zeros(pp,mm+pp);
0047 for i=1:pp;
0048     Z(i,mf(i)) = 1;
0049     Z(i,mm+i)  = 1;
0050 end
0051 %% [1] Kalman filter...
0052 t = 0;
0053 newRank      = rank(Pinf(:,:,1),crit);
0054 while newRank & t < smpl
0055     t = t+1;
0056     a1(:,t) = a(:,t);
0057     Pstar1(:,:,t) = Pstar(:,:,t);
0058     Pinf1(:,:,t) = Pinf(:,:,t);
0059     for i=1:pp
0060         v(i,t)     = Y(i,t)-a(mf(i),t)-a(mm+i,t)-trend(i,t);
0061         Fstar(i,t)      = Pstar(mf(i),mf(i),t)+Pstar(mm+i,mm+i,t);
0062         Finf(i,t)     = Pinf(mf(i),mf(i),t);
0063         Kstar(:,i,t) = Pstar(:,mf(i),t)+Pstar(:,mm+i,t);
0064         if Finf(i,t) > crit
0065             Kinf(:,i,t)    = Pinf(:,mf(i),t);
0066             Linf(:,:,i,t)      = eye(mm+pp) - Kinf(:,i,t)*Z(i,:)/Finf(i,t);
0067             L0(:,:,i,t)      = (Kinf(:,i,t)*Fstar(i,t)/Finf(i,t) - Kstar(:,i,t))*Z(i,:)/Finf(i,t);
0068             a(:,t)        = a(:,t) + Kinf(:,i,t)*v(i,t)/Finf(i,t);
0069             Pstar(:,:,t)    = Pstar(:,:,t) + ...
0070                 Kinf(:,i,t)*transpose(Kinf(:,i,t))*Fstar(i,t)/(Finf(i,t)*Finf(i,t)) - ...
0071                 (Kstar(:,i,t)*transpose(Kinf(:,i,t)) +...
0072                 Kinf(:,i,t)*transpose(Kstar(:,i,t)))/Finf(i,t);
0073             Pinf(:,:,t)    = Pinf(:,:,t) - Kinf(:,i,t)*transpose(Kinf(:,i,t))/Finf(i,t);
0074         else %% Note that : (1) rank(Pinf)=0 implies that Finf = 0, (2) outside this loop (when for some i and t the condition
0075              %% rank(Pinf)=0 is satisfied we have P = Pstar and F = Fstar and (3) Finf = 0 does not imply that
0076              %% rank(Pinf)=0. [stphane,11-03-2004].
0077             a(:,t)         = a(:,t) + Kstar(:,i,t)*v(i,t)/Fstar(i,t);
0078             Pstar(:,:,t)    = Pstar(:,:,t) - Kstar(:,i,t)*transpose(Kstar(:,i,t))/Fstar(i,t);
0079         end
0080     end
0081     a(:,t+1)          = T*a(:,t);
0082     Pstar(:,:,t+1)    = T*Pstar(:,:,t)*transpose(T)+ QQ;
0083     Pinf(:,:,t+1)    = T*Pinf(:,:,t)*transpose(T);
0084     P0=Pinf(:,:,t+1);
0085     newRank = ~all(abs(P0(:))<crit);
0086 end
0087 d = t;
0088 P(:,:,d+1) = Pstar(:,:,d+1);
0089 Linf  = Linf(:,:,:,1:d);
0090 L0  = L0(:,:,:,1:d);
0091 Fstar = Fstar(:,1:d);
0092 Finf = Finf(:,1:d);
0093 Kstar = Kstar(:,:,1:d);
0094 Pstar = Pstar(:,:,1:d);
0095 Pinf  = Pinf(:,:,1:d);
0096 Pstar1 = Pstar1(:,:,1:d);
0097 Pinf1  = Pinf1(:,:,1:d);
0098 notsteady = 1;
0099 while notsteady & t<smpl
0100     t = t+1;
0101     a1(:,t) = a(:,t);
0102     P(:,:,t)=tril(P(:,:,t))+transpose(tril(P(:,:,t),-1));
0103     P1(:,:,t) = P(:,:,t);
0104     for i=1:pp
0105         v(i,t)    = Y(i,t) - a(mf(i),t) - a(mm+i,t) - trend(i,t);
0106         Fi(i,t)   = P(mf(i),mf(i),t)+P(mm+i,mm+i,t);
0107         Ki(:,i,t) = P(:,mf(i),t)+P(:,mm+i,t);
0108         if Fi(i,t) > crit
0109             Li(:,:,i,t)    = eye(mm+pp)-Ki(:,i,t)*Z(i,:)/Fi(i,t);
0110             a(:,t) = a(:,t) + Ki(:,i,t)*v(i,t)/Fi(i,t);
0111             P(:,:,t) = P(:,:,t) - Ki(:,i,t)*transpose(Ki(:,i,t))/Fi(i,t);
0112             P(:,:,t)=tril(P(:,:,t))+transpose(tril(P(:,:,t),-1));
0113         end
0114     end
0115     a(:,t+1) = T*a(:,t);
0116     P(:,:,t+1) = T*P(:,:,t)*transpose(T) + QQ;
0117     notsteady   = ~(max(max(abs(P(:,:,t+1)-P(:,:,t))))<crit);
0118 end
0119 P_s=tril(P(:,:,t))+transpose(tril(P(:,:,t),-1));
0120 Fi_s = Fi(:,t);
0121 Ki_s = Ki(:,:,t);
0122 L_s  =Li(:,:,:,t);
0123 if t<smpl
0124     t_steady = t+1;
0125     P  = cat(3,P(:,:,1:t),repmat(P(:,:,t),[1 1 smpl-t_steady+1]));
0126     Fi = cat(2,Fi(:,1:t),repmat(Fi_s,[1 1 smpl-t_steady+1]));
0127     Li  = cat(4,Li(:,:,:,1:t),repmat(L_s,[1 1 smpl-t_steady+1]));
0128     Ki  = cat(3,Ki(:,:,1:t),repmat(Ki_s,[1 1 smpl-t_steady+1]));
0129 end
0130 while t<smpl
0131     t=t+1;
0132     a1(:,t) = a(:,t);
0133     for i=1:pp
0134         v(i,t)      = Y(i,t) - a(mf(i),t) - a(mm+i,t) - trend(i,t);
0135         if Fi_s(i) > crit
0136             a(:,t) = a(:,t) + Ki_s(:,i)*v(i,t)/Fi_s(i);
0137         end
0138     end
0139     a(:,t+1) = T*a(:,t);
0140 end
0141 a1(:,t+1) = a(:,t+1);
0142 %% [2] Kalman smoother...
0143 ri=r;
0144 t = smpl+1;
0145 while t>d+1 & t>2,
0146     t = t-1;
0147     for i=pp:-1:1
0148         if Fi(i,t) > crit
0149             ri(:,t)=transpose(Z(i,:))/Fi(i,t)*v(i,t)+transpose(Li(:,:,i,t))*ri(:,t);
0150         end
0151     end
0152     r(:,t-1) = ri(:,t);
0153     alphahat(:,t)    = a1(:,t) + P1(:,:,t)*r(:,t-1);
0154     tmp                = QRt*r(:,t);
0155     etahat(:,t)        = tmp(1:rr);
0156     epsilonhat(:,t)    = tmp(rr+1:rr+pp);
0157     ri(:,t-1) = transpose(T)*ri(:,t);
0158 end
0159 if d
0160     r0 = zeros(mm+pp,d); r0(:,d) = ri(:,d);
0161     r1 = zeros(mm+pp,d);
0162     for t = d:-1:2
0163         for i=pp:-1:1
0164             if Finf(i,t) > crit
0165                  r1(:,t) = transpose(Z)*v(:,t)/Finf(i,t) + ...
0166                     transpose(L0(:,:,i,t))*r0(:,t) + transpose(Linf(:,:,i,t))*r1(:,t);
0167                 r0(:,t) = transpose(Linf(:,:,i,t))*r0(:,t);
0168             end
0169         end
0170         alphahat(:,t)    = a1(:,t) + Pstar1(:,:,t)*r0(:,t) + Pinf1(:,:,t)*r1(:,t);
0171         r(:,t-1)        = r0(:,t);
0172         tmp                = QRt*r(:,t);
0173         etahat(:,t)        = tmp(1:rr);
0174         epsilonhat(:,t)    = tmp(rr+1:rr+pp);
0175         r0(:,t-1) = transpose(T)*r0(:,t);
0176         r1(:,t-1) = transpose(T)*r1(:,t);
0177     end
0178     r0_0 = r0(:,1);
0179     r1_0 = r1(:,1);
0180     for i=pp:-1:1
0181         if Finf(i,1) > crit,
0182             r1_0 = transpose(Z)*v(:,1)/Finf(i,1) + ...
0183                 transpose(L0(:,:,i,1))*r0_0 + transpose(Linf(:,:,i,1))*r1_0;
0184             r0_0 = transpose(Linf(:,:,i,1))*r0_0;
0185         end
0186     end
0187     alphahat(:,1)      = a(:,1) + Pstar(:,:,1)*r0_0 + Pinf(:,:,1)*r1_0;
0188     tmp                = QRt*r(:,1);
0189     etahat(:,1)        = tmp(1:rr);
0190     epsilonhat(:,1)    = tmp(rr+1:rr+pp);
0191 else
0192     r0 = ri(:,1);
0193     for i=pp:-1:1
0194         if Fi(i,1) > crit
0195             r0=transpose(Z(i,:))/Fi(i,1)*v(i,1)+transpose(Li(:,:,i,1))*r0;
0196         end
0197     end 
0198     alphahat(:,1)    = a(:,1) + P(:,:,1)*r0;
0199     tmp             = QRt*r(:,1);        
0200     etahat(:,1)        = tmp(1:rr);
0201     epsilonhat(:,1)    = tmp(rr+1:rr+pp);
0202 end
0203 alphahat = alphahat(1:mm,:);
DiffuseKalmanSmootherH3corr

PURPOSE

SYNOPSIS

DESCRIPTION

CROSS-REFERENCE INFORMATION

SOURCE CODE
