# Cut-and-Paste Code Below into Window above and Run
#
# FR18 Small Country Model France
#
# W18 World Input Model
#
merge.forecast <- function (fx,n=1) {
x <- splice(fx$pred,fx$forecast[[n]])
colnames(x) <- seriesNames(fx$data$output)
return(x)
}
AIC <- function(model) {informationTestsCalculations(model)[3]}
require(dse)
require(matlab)
#
# Measurement Matrix # overall, Q-N, N-L
# Q N L T
#[1,] 0.499 0.500 0.501 -0.501
#[2,] 0.837 -0.491 -0.171 0.171
#[3,] 0.227 0.713 -0.469 0.469
#
# Fraction of Variance
#[1] 0.996 1.000 1.000 1.000
#
f <- matrix( c( 0.9990146949, 0.04503518, -0.05464643, 0.065548536,
-0.0042486908, 1.04226953, -0.04676536, -0.002528148,
0.0004986095, 0.03266194, 0.95871578, -0.001858812,
0.00000000, 0.0000000, 0.0000000, 1.0000000000
),byrow=TRUE,nrow=4,ncol=4)
#
#
# To Stabilize, Uncomment next line
# f[2,2] <- 0.90
#
h <- eye(3,4)
k <- (f[,1:3,drop=FALSE])
W18 <- SS(F=f,H=h,K=k,z0=c(0.065548536, -0.002528148, -0.001858812, 1.0000000000),
output.names=c("W1","W2","W3"))
stability(m <- SS(F=f[1:3,1:3,drop=FALSE],Q=eye(3),R=eye(3),H=eye(3)))
W18.data <- simulate(W18,sampleT=100,noise=matrix(0,100,3),start=1700)
W18.f <- forecast(l(W18,W18.data),horizon=150)
W18.fx <- merge.forecast(W18.f)
#
# FR18 Small Country Model
#
#
# Measurement Matrix Growth-U, U, N-L, Q-HOURS, Q-N
#
# Q N U HOURS L
#[1,] 0.4719 0.460 -0.3528 0.470 0.470
#[2,] 0.0757 0.315 0.9208 0.153 0.153
#[3,] 0.1284 0.735 -0.1075 -0.465 -0.465
#[4,] 0.4025 -0.179 0.0589 -0.719 0.534
#[5,] 0.7701 -0.342 0.1128 0.150 -0.505
#
# Fraction of Variance
#[1] 0.895 1.000 1.000 1.000 1.000
#
f <- matrix( c( 0, 0, 0, 0, 0, 0, 0.000000e+00,
0, 0, 0, 0, 0, 0, 0.000000e+00,
0 , 0, 0, 0, 0, 0, 0.000000e+00,
1, 0, 0, 0, 0, 0, -7.587550e-16,
0, 1, 0, 0 , 0, 0, 1.561096e-15,
0 , 0 , 1, 0, 0, 0, 3.685050e-16,
0, 0, 0, 0, 0, 0, 1.000000e+00
),byrow=TRUE,nrow=7,ncol=7)
g <- matrix(c(0.000000e+00, 0.000000000, 0.00000000,
0.000000e+00, 0.000000000, 0.00000000,
0.000000e+00, 0.000000000, 0.00000000,
1.055547e+00, 1.629068538, 0.07177623,
3.274613e-02, -6.126715766, -0.40579977,
1.185859e-05, -0.006665559, 0.94773216,
0.000000e+00, 0.000000000, 0.00000000
),byrow=TRUE,nrow=7,ncol=3)
h <- matrix(c(0, 0, 0, 1, 0, 0, 0,
0, 0, 0, 0, 1, 0, 0,
0 , 0 , 0, 0, 0, 1, 0
),byrow=TRUE,nrow=3,ncol=7)
k <- matrix(0,7,3)
FR18 <- SS(F=f,H=h,K=k,G=g,z0=c(0.0000000, 0.0000000, 0.0000000,
-3.7110837, 0.5863033, 0.1148695, 1.0000000000),
output.names=c("FR1","FR2","FR3"),input.names= c("W1","W2","W3"))
stability(m <- SS(F=f[1:6,1:6,drop=FALSE],Q=eye(6),R=eye(6),H=eye(6)))
FR18.data <- simulate(FR18,sampleT=100,noise=matrix(0,100,3),start=1700,input=W18.fx)
FR18.f <- forecast(l(FR18,FR18.data),conditioning.inputs=W18.fx)
tfplot(FR18.f)