#-*- S -*-  

# Chapter 15   Time Series

library(MASS)
postscript(file="ch15.ps", width=8, height=6, pointsize=9)
options(width=65, digits=5)

lh
deaths
tspar(deaths)
start(deaths)
end(deaths)
frequency(deaths)
units(deaths)
cycle(deaths)
ts.plot(lh)
ts.plot(deaths, mdeaths, fdeaths, lty=c(1,3,4), xlab="year",
     ylab="deaths")
aggregate(deaths, 4, sum)
aggregate(deaths, 1, mean)


# 15.1  Second-order summaries

acf(lh)
acf(lh, type="covariance")
acf(deaths)
acf(ts.union(mdeaths, fdeaths))
spectrum(lh)
spectrum(deaths)
spectrum(lh)
spectrum(lh, spans=3)
spectrum(lh, spans=c(3,3))
spectrum(lh, spans=c(3,5))

spectrum(deaths)
spectrum(deaths, spans=c(3,3))
spectrum(deaths, spans=c(3,5))
spectrum(deaths, spans=c(5,7))
spectrum(deaths)
deaths.spc <- spec.pgram(deaths, taper=0)
lines(deaths.spc$freq, deaths.spc$spec, lty=3)

par(mfrow=c(1,2))
cpgram(lh)
cpgram(deaths)
par(mfrow=c(1,1))


# 15.2  ARIMA models

ts.sim <- arima.sim(list(order=c(1,1,0), ar=0.7), n=200)

acf(lh, type="partial")
acf(deaths, type="partial")
lh.ar1 <- ar(lh, F, 1)
cpgram(lh.ar1$resid, main="AR(1) fit to lh")
lh.ar <- ar(lh, order.max=9)
lh.ar$order
lh.ar$aic
cpgram(lh.ar$resid, main="AR(3) fit to lh")
lh1 <- lh - mean(lh)
lh.arima1 <- arima.mle(lh1, model=list(order=c(1,0,0)),
      n.cond=3)
arima.diag(lh.arima1)
lh.arima3 <- arima.mle(lh1, model=list(order=c(3,0,0)),
      n.cond=3)
arima.diag(lh.arima3)
lh.arima11 <- arima.mle(lh1, model=list(order=c(1,0,1)),
      n.cond=3)
arima.diag(lh.arima11)
lh.fore <- arima.forecast(lh1, n=12, model=lh.arima3$model)
lh.fore$mean <- lh.fore$mean + mean(lh)
ts.plot(lh, lh.fore$mean, lh.fore$mean+2*lh.fore$std.err,
   lh.fore$mean-2*lh.fore$std.err)


# 15.3  Seasonality

deaths.stl <- stl(deaths, "periodic")
ts.plot(deaths, deaths.stl$sea, deaths.stl$rem)
dsd <- deaths.stl$rem
ts.plot(dsd)
acf(dsd)
acf(dsd, type="partial")
spectrum(dsd, span=c(3,3))
cpgram(dsd)
dsd.ar <- ar(dsd)
dsd.ar$order
dsd.ar$aic
dsd.ar$ar
cpgram(dsd.ar$resid, main="AR(1) residuals")
dsd.rar <- ar.gm(dsd)
dsd.rar$ar
deaths.diff <- diff(deaths, 12)
acf(deaths.diff, 30)
acf(deaths.diff, 30, type="partial")
ar(deaths.diff)
# this suggests the seasonal effect is still present.
deaths.arima1 <- arima.mle(deaths, model=list(
     list(order=c(2,0,0)), list(order=c(0,1,0), period=12)) )
deaths.arima1$aic
deaths.arima1$model[[1]]$ar  # the non-seasonal part
sqrt(diag(deaths.arima1$var.coef))
arima.diag(deaths.arima1, gof.lag=24)
# suggests need a seasonal AR term
deaths1 <- deaths - mean(deaths)
deaths.arima2 <- arima.mle(deaths1, model=list(
     list(order=c(2,0,0)),  list(order=c(1,0,0), period=12)) )
deaths.arima2$aic
deaths.arima2$model[[1]]$ar # non-seasonal part
deaths.arima2$model[[2]]$ar # seasonal part
sqrt(diag(deaths.arima2$var.coef))
arima.diag(deaths.arima2, gof.lag=24)
cpgram(arima.diag(deaths.arima2, plot=F, resid=T)$resid)
deaths.arima3 <- arima.mle(deaths, model=list(
     list(order=c(2,0,0)), list(order=c(1,1,0), period=12)) )
deaths.arima3$aic  # not comparable to those above
deaths.arima3$model[[1]]$ar
deaths.arima3$model[[2]]$ar
sqrt(diag(deaths.arima3$var.coef))
arima.diag(deaths.arima3, gof.lag=24)
arima.mle(deaths1, model=list(list(order=c(2,0,0)),
     list(order=c(1,0,0), period=12)), n.cond=26 )$aic
deaths.arima4 <- arima.mle(deaths1, model=list(
     list(order=c(2,0,0)), list(order=c(2,0,0), period=12)) )
deaths.arima4$aic
deaths.arima4$model[[1]]$ar
deaths.arima4$model[[2]]$ar
sqrt(diag(deaths.arima4$var.coef))

dacc <- diff(accdeaths, 12)
ts.plot(dacc)
acf(dacc, 30)
acf(dacc, 30, "partial")
ddacc <- diff(dacc)
ts.plot(ddacc)
acf(ddacc, 30)
acf(ddacc, 30, "partial")
ddacc.1 <- arima.mle(ddacc-mean(ddacc),
     model=list(list(order=c(0,0,1)),
     list(order=c(0,0,1), period=12)))
ddacc.1
sqrt(diag(ddacc.1$var.coef))
ddacc.2 <- arima.mle(ddacc-mean(ddacc),
      model=list(order=c(0,0,13),
      ma.opt=c(T,F,F,F,F,T,F,F,F,F,F,T,T)),
      max.iter=50, max.fcal=100)
ddacc.2
sqrt(diag(ddacc.2$var.coef))
dd.VI <- solve(ddacc.2$var.coef)
sqrt(diag(
     solve(dd.VI[ddacc.2$model$ma.opt,ddacc.2$model$ma.opt])
     ))


# 15.4  Multiple time series

spectrum(mdeaths, spans=c(3,3))
spectrum(fdeaths, spans=c(3,3))
mfdeaths.spc <- spec.pgram(ts.union(mdeaths, fdeaths), 
   spans=c(3,3))
plot(mfdeaths.spc$freq, mfdeaths.spc$coh, type="l", 
   ylim=c(0,1), xlab="coherency", ylab="")
gg <- 2/mfdeaths.spc$df
se <- sqrt(gg/2)
lines(mfdeaths.spc$freq, tanh(atanh(mfdeaths.spc$coh) + 
   1.96*se), lty=3)
lines(mfdeaths.spc$freq, tanh(atanh(mfdeaths.spc$coh) - 
   1.96*se), lty=3)
plot(mfdeaths.spc$freq, mfdeaths.spc$phase, type="l", 
   ylim=c(-pi, pi), xlab="phase spectrum", ylab="")
cl <- asin( pmin( 0.9999, qt(0.95, 2/gg-2)*
   sqrt(gg*(mfdeaths.spc$coh^{-2} - 1)/(2*(1-gg)) ) ) )
lines(mfdeaths.spc$freq, mfdeaths.spc$phase + cl, lty=3)
lines(mfdeaths.spc$freq, mfdeaths.spc$phase - cl, lty=3)
mfdeaths.spc <- spec.pgram(ts.union(mdeaths, lag(fdeaths, 4)),
   spans=c(3,3))
plot(mfdeaths.spc$freq, mfdeaths.spc$coh, type="l", 
   ylim=c(0,1), xlab="coherency", ylab="")
gg <- 2/mfdeaths.spc$df
se <- sqrt(gg/2)
lines(mfdeaths.spc$freq, tanh(atanh(mfdeaths.spc$coh) + 
   1.96*se), lty=3)
lines(mfdeaths.spc$freq, tanh(atanh(mfdeaths.spc$coh) - 
   1.96*se), lty=3)
phase <- (mfdeaths.spc$phase + pi)%%(2*pi) - pi
plot(mfdeaths.spc$freq, phase, type="l", 
   ylim=c(-pi, pi), xlab="phase spectrum", ylab="")
cl <- asin( pmin( 0.9999, qt(0.95, 2/gg-2)*
   sqrt(gg*(mfdeaths.spc$coh^{-2} - 1)/(2*(1-gg)) ) ) )
lines(mfdeaths.spc$freq, phase + cl, lty=3)
lines(mfdeaths.spc$freq, phase - cl, lty=3)


# 15.5  Nottingham temperature data

par(mfrow=c(3,1))
nott <- window(nottem, end=c(1936,12))
ts.plot(nott)
nott.stl <- stl(nott, "period")
ts.plot(nott.stl$rem-49, nott.stl$sea, 
   ylim = c(-15, 15), lty=c(1,3))
nott.stl <- stl(nott, 5)
ts.plot(nott.stl$rem-49, nott.stl$sea, 
   ylim = c(-15, 15), lty=c(1,3))
par(mfrow=c(1,1))
boxplot(split(nott, cycle(nott)), names=month.abb)
nott[110] <- 35
nott.stl <- stl(nott, "period")
nott1 <- nott.stl$rem - mean(nott.stl$rem)
acf(nott1)
acf(nott1,, "partial")
cpgram(nott1)
ar(nott1)$aic
plot(0:23, ar(nott1)$aic, xlab="order", ylab="AIC",
     main="AIC for AR(p)")
nott1.ar1 <- arima.mle(nott1, model=list(order=c(1,0,0)))
nott1.ar1$model$ar
sqrt(nott1.ar1$var.coef)

nott1.fore <- arima.forecast(nott1, n=36,
     model=nott1.ar1$model)
nott1.fore$mean <- nott1.fore$mean + mean(nott.stl$rem) +
                        as.vector(nott.stl$sea[1:36])
ts.plot(window(nottem, 1937), nott1.fore$mean,
     nott1.fore$mean+2*nott1.fore$std.err,
     nott1.fore$mean-2*nott1.fore$std.err, lty=c(3,1,2,2))
title("via Seasonal Decomposition")
acf(diff(nott,12), 30)
acf(diff(nott,12), 30, "partial")
cpgram(diff(nott,12))
nott.arima1 <- arima.mle(nott,
      model=list(list(order=c(1,0,0)), list(order=c(2,1,0),
      period=12)))
nott.arima1
sqrt(diag(nott.arima1$var.coef))
arima.diag(nott.arima1, gof.lag=24)
nott.fore <- arima.forecast(nott, n=36,
     model=nott.arima1$model)
ts.plot(window(nottem, 1937), nott.fore$mean,
     nott.fore$mean+2*nott.fore$std.err,
     nott.fore$mean-2*nott.fore$std.err, lty=c(3,1,2,2))
title("via Seasonal ARIMA model")


# 15.6  Regression with autocorrelated errors

attach(beav1)
beav1 <- beav1
beav1$hours <- 24*(day-346) + trunc(time/100) + (time%%100)/60
detach()
attach(beav2)
beav2 <- beav2
beav2$hours <- 24*(day-307) + trunc(time/100) + (time%%100)/60
detach()
par(mfrow=c(2,2))
plot(beav1$hours, beav1$temp, type="l", xlab="time", 
   ylab="temperature", main="Beaver 1")
usr <- par("usr"); usr[3:4] <- c(-0.2, 8); par(usr=usr)
lines(beav1$hours, beav1$activ, type="s", lty=2)
plot(beav2$hours, beav2$temp, type="l", xlab="time", 
   ylab="temperature", main="Beaver 2")
usr <- par("usr"); usr[3:4] <- c(-0.2, 8); par(usr=usr)
lines(beav2$hours, beav2$activ, type="s", lty=2)

attach(beav2)
temp <- rts(temp, start=8+2/3, frequency=6, units="hours")
activ <- rts(activ, start=8+2/3, frequency=6, units="hours")
acf(temp[activ==0]); acf(temp[activ==1]) # also look at PACFs
ar(temp[activ==0]); ar(temp[activ==1])
par(mfrow=c(1,1))

arima.mle(temp, xreg=rep(1, length(temp)), model=list(ar=0.75))
arima.mle(temp, xreg=cbind(1, activ), model=list(ar=0.75))

dreg <- cbind(sin(2*pi*hours/24), cos(2*pi*hours/24))
arima.mle(temp, xreg=cbind(1, activ,dreg), model=list(ar=0.75))


alpha <- 0.8255
stemp <- temp - alpha*lag(temp, -1) 
X <- cbind(1, activ); sX <- X[-1, ] - alpha*X[-100, ]
beav2.ls <- lm(stemp ~ -1 + sX)
beav2.sls <- summary(beav2.ls)
beav2.sls
sqrt(t(c(1,1)) %*% beav2.sls$cov %*% c(1,1)) * beav2.sls$sigma
plot(hours[-1], residuals(beav2.ls))
detach(); rm(temp, activ)

if(version$major==3 && version$minor < 4)  library(nlme)
beav2.lme <- lme(temp ~ activ, cluster = ~rep(1,100), 
     data=beav2,  serial.structure="ar1", est.method="ML")
summary(beav2.lme)
summary(lme(temp ~ activ, cluster = ~rep(1,95), 
	    data=beav2[6:100,], 
	    serial.structure="ar1", est.method="ML"))

attach(beav1)
temp <- rts(c(temp[1:82], NA, temp[83:114]), start=9.5, 
            frequency=6, units="hours")
activ <- rts(c(activ[1:82], NA, activ[83:114]), start=9.5,
             frequency=6, units="hours")
acf(temp[1:53]) # and also type="partial"
ar(temp[1:53])

act <- c(rep(0, 10), activ)
X <- cbind(1, act=act[11:125], act1 = act[10:124], 
          act2 = act[9:123], act3 = act[8:122])
arima.mle(temp, xreg=X, model=list(ar=0.82))

alpha <- 0.80
stemp <- temp - alpha*lag(temp, -1)
sX <- X[-1, ] - alpha * X[-115,]
beav1.ls <- lm(stemp ~ -1 + sX, na.action=na.omit)
summary(beav1.ls, cor=F)
detach(); rm(temp, activ)


# =========================================

# Chapter 15 Complements


# 15.1  Second-order summaries

library(lspec)
lh.ls <- lspec.fit(lh)
lspec.summary(lh.ls)

par(mfrow=c(2,2))
lspec.plot(lh.ls, log="y") 
lspec.plot(lh.ls, what="p")

par(mfcol=c(2,3))
deaths.ls <- lspec.fit(deaths)
lspec.plot(deaths.ls, log="y", main="deaths")
lspec.plot(deaths.ls, what="p")
accdeaths.ls <- lspec.fit(accdeaths)
lspec.plot(accdeaths.ls, log="y", main="accdeaths")
lspec.plot(accdeaths.ls, what="p")
nott.ls <- lspec.fit(window(nottem, end=c(1936,12)))
lspec.plot(nott.ls, log="y", main="nottem")
lspec.plot(nott.ls, what="p")

par(mfrow=c(1,3), pty="s")
lspec.plot(accdeaths.ls, log="y")
lspec.plot(lspec.fit(accdeaths, minmass=7000), log="y")
lspec.plot(lspec.fit(accdeaths, minmass=1000), log="y")


# End of ch15

