examples of first-order polynomial time series
rfirst.order <- function ( n, V, W, start ) {
### n: length of time series
### V: observational variances
### W: evolution variances
### start: starting level
mu _ start + cumsum ( rnorm ( n, sd=sqrt(W) ) )
return ( list ( level=mu, observation = mu + rnorm ( n, sd=sqrt(V) ) ) )
}
examp1 _ rfirst.ord ( 200, 1, .05, 25 )
examp2 _ rfirst.ord ( 200, 1, .5, 25 )
examp3 _ rfirst.ord ( 200, 1, 5, 25 )
par ( mfrow=c(3,1) )
tsplot ( examp1$obs, examp1$level, lty=1:2 )
tsplot ( examp2$obs, examp2$level, lty=1:2 )
tsplot ( examp3$obs, examp3$level, lty=1:2 )
some examples of time series
par ( mfrow=c(3,2) )
tsplot ( bonds.yield[,1], main="daily bond yields", xlab="day",
ylab="yield" )
tsplot( co2, main="Mauna Loa CO2 concentration", xlab="Year",
ylab="concentration" )
tsplot ( tsmatrix ( corn.rain, corn.yield ),
main="Rainfall and Corn Yield", xlab="Year",
ylab="rain (inches), yield (bushels per acre)" )
tsplot ( lynx, main="Annual Number of Lynx Trappings", xlab="Year",
ylab="Number of Lynx" )
tsplot ( ozone.median, main="Ozone levels",
sub="Median daily maxima for June to August", xlab="Day" )
tsplot ( sunspots, main="Monthly Mean Relative Sunspot Numbers",
xlab="Year" )
### which might be modeled by a first-order polynomial? ###
### bond yields, ozone levels and crop yields look like fluctuations
### around a slowly changing level. The others have cycles which
### cannot be modeled yet.
par ( mfrow=c(2,3) )
tsplot ( examp1$obs, main="V/W = 20" )
tsplot ( examp2$obs, main="V/W = 2" )
tsplot ( examp3$obs, main="V/W = 0.2" )
tsplot ( bonds.yield[,1], main="daily bond yields", xlab="day",
ylab="yield" )
tsplot ( tsmatrix ( corn.rain, corn.yield ),
main="Rainfall and Corn Yield", xlab="Year",
ylab="rain (inches), yield (bushels per acre)" )
tsplot ( ozone.median, main="Ozone levels",
sub="Median daily maxima for June to August", xlab="Day" )
### V/W=0.2 looks good for bond yields
### replot ;with different lengths for ozone and crop
tsplot ( examp1$obs[1:40], main="V/W = 20" )
tsplot ( examp2$obs[1:40], main="V/W = 2" )
tsplot ( examp3$obs[1:40], main="V/W = 0.2" )
tsplot ( bonds.yield[,1], main="daily bond yields", xlab="day",
ylab="yield" )
tsplot ( tsmatrix ( corn.yield ),
main="Corn Yield", xlab="Year",
ylab="rain (inches), yield (bushels per acre)" )
tsplot ( ozone.median, main="Ozone levels",
sub="Median daily maxima for June to August", xlab="Day" )
updating functions for 1st order polynomial model, known variance
update.dlm _ function ( Y, V, W, start ) {
n <- length(y)
m _ rep ( NA, length=n )
C _ rep ( NA, length=n )
R _ rep ( NA, length=n )
Q _ rep ( NA, length=n )
f _ rep ( NA, length=n )
A _ rep ( NA, length=n )
e _ rep ( NA, length=n )
Y _ c(NA,Y)
C[1] <- start$C
m[1] <- start$m
for ( t in 2:n ) {
R[t] <- C[t-1] + W[t]
f[t] <- m[t-1]
Q[t] <- R[t] + V[t]
A[t] <- R[t] / Q[t]
e[t] <- Y[t] - f[t]
m[t] <- m[t-1] + A[t]*e[t]
C[t] <- A[t]*V[t]
}
return ( list ( m=m, C=C, R=R, f=f, Q=Q ) )
}
### KURIT example
y _ c ( 150, 136, 143, 154, 135, 148, 128, 149, 146 )
V _ rep ( 100, length(y) )
W _ rep ( 5, length(y) )
start _ list ( m=130, C=400 )
result _ update.dlm ( y, V, W, start )
conjugate updating function for 1st order polynomial, variance unknown
conj.update.dlm _ function ( Y, W=NA, delta, m.0, C.0, n.0, S.0 ) {
N <- length(y)
m _ rep ( NA, length=N )
n _ rep ( NA, length=N )
C _ rep ( NA, length=N )
R _ rep ( NA, length=N )
Q _ rep ( NA, length=N )
S _ rep ( NA, length=N )
f _ rep ( NA, length=N )
A _ rep ( NA, length=N )
e _ rep ( NA, length=N )
Y _ c(NA,Y)
C[1] <- C.0
m[1] <- m.0
S[1] <- S.0
n[1] <- n.0
for ( t in 2:N ) {
n[t] <- n[t-1] + 1
### to specify the model via a discount factor instead of W
### we use the following line
if ( missing(W) & !missing(delta) ) W[t] _ C[t-1] * (1-delta) / delta
R[t] <- C[t-1] + W[t]
f[t] <- m[t-1]
Q[t] <- R[t] + S[t-1]
A[t] <- R[t] / Q[t]
e[t] <- Y[t] - f[t]
S[t] <- S[t-1] + ( S[t-1]/n[t] ) * ( e[t]^2/Q[t] - 1 )
m[t] <- m[t-1] + A[t]*e[t]
C[t] <- A[t]*S[t]
}
return ( list ( m=m, C=C, R=R, f=f, Q=Q, n=n, S=S ) )
}
Example from section 2.6: exchange rate
y _ c ( 1.35, 1.00, -1.96, -2.17, -1.78, -4.21,
-3.30, -1.43, -1.35, -0.34, -1.38, 0.30,
-0.10, -4.13, -5.12, -2.13, -1.17, -1.24,
-0.18, 0.29, 0.23, 0.00, 0.06, 0.17,
0.98, 0.17, 1.59, 2.62, 1.96, 4.28,
0.26, -1.66, -3.03, -1.80, 1.04, 3.06,
-0.05, 1.68, 1.70, -0.73, 2.59, 6.77,
-0.98, -1.71, -2.53, -0.61, 3.14, 2.96,
1.01, -3.69, 0.45, 3.89, 1.38, 1.57,
-0.08, 1.30, 0.62, -0.87, -2.11, 2.48,
-4.73, -2.70, -2.45, -4.17, -5.76, -5.09,
-2.92, -0.22, 1.42, 3.26, 0.05, -0.95,
-2.14, -2.19, -1.96, 2.18, -2.97, -1.89,
0.12, -0.76, -0.94, -3.90, -0.86, -2.88,
-2.58, -2.78, 3.30, 2.06, -1.54, -1.30,
-1.78, -0.13, -0.20, -1.35, -2.82, -1.97,
2.25, 1.17, -2.29, -2.49, -0.87, -4.15, -0.53 )
y _ ts ( y, start=1975, frequency=12 )
par(mfrow=c(1,1))
tsplot(y)
fit.low _ lowess ( time(y), y )
lines ( fit.low )
tsplot ( y, type="p", pch="*", main="Estimated level of exchange rate" )
for ( d in 1:4) {
lines ( time(y),
conj.update.dlm (y,delta=.6+.1*d,m.0=0,C.0=1,n.0=1,S.0=.01)$m,
lty=d )
}
legend ( 1981, 6, legend=paste(delta=.6+.1*(1:4)), lty=1:4, bty="n" )
text ( 1981, 6.5, "Discount factor", adj=0 )