In this notebook we will fit several \(AR\), \(MA\) and \(ARMA\) models to inflation data. Let us begin by pulling CPI inflation data into R and taking first differences (we will see that the first differences appear to be more stationary than levels).

library(Ecdat)
data(Mishkin)
inflation = Mishkin[,1]
diffInflation = diff(inflation)

To get a sense of the data, let’s plot the time series of inflation and first differences of inflation.

par(mfrow=c(2,1))
plot(inflation, ylab="Inflation rate", main="(a)")
abline(h=0)
plot(diffInflation, ylab="Change in inflation rate", main="(b)")
abline(h=0)

Inflation levels do not appear to have a stationary mean, however the first differences do. The autocorrelations of first differences are depicted below.

acf(as.numeric(diffInflation))

The ACF plot suggests that an \(MA(1)\) model might be appropriate for this data. We will begin, however, by fitting an \(AR(1)\) and examining the residuals.

ar1Fit = arima(diffInflation, order=c(1,0,0));
layout(matrix(c(1,1,2,3), 2, 2, byrow = TRUE))
plot(ar1Fit$resid)
abline(h=0)
acf(as.numeric(ar1Fit$resid))
qqnorm(ar1Fit$resid, datax=TRUE)
qqline(ar1Fit$resid, datax=TRUE)

The time series and ACF plots of the residuals look decent, although the negative autocorrelations at lags 2 and 3 might suggest that we still haven’t appropriately modeled the time dynamics of the data. The next code block fits an \(AR(p)\) model for \(p = 1,2,\ldots,20\) and plots both the AIC and BIC values for each fit.

#install.packages("forecast"); # run this if 'forecast' not installed
library(forecast)
pMax = 20
aicAR = bicAR = rep(0, length=pMax)
for(p in 1:pMax){
    out = arima(diffInflation, order=c(p,0,0))
    aicAR[p] = out$aic
    bicAR[p] = out$aic - 2*(2+p) + log(length(diffInflation))*(2+p)
}
yMin = min(min(aicAR), min(bicAR))
yMax = max(max(aicAR), max(bicAR))
plot(aicAR, xlab="p", ylab="Criterion", pch=8, ylim=c(yMin,yMax),
    main="AR Fits to Changes in Inflation Rate")
points(bicAR)
legend("topright", legend=c("AIC", "BIC"), pch=c(8,1))

The plot shows that BIC is minimized at \(p = 6\) while AIC is minimized at \(p = 16\). We can also use the auto.arima function to automatically fit and select the best \(AR\) model using AIC or BIC. The following code does this and then examines the residuals for the best fit model.

out = auto.arima(diffInflation, max.p=10, max.q=0, ic="bic")
layout(matrix(c(1,1,2,3), 2, 2, byrow = TRUE))
plot(out$resid)
abline(h=0)
acf(out$resid)
qqnorm(out$resid, datax=TRUE)
qqline(out$resid, datax=TRUE)

The ACF of the residuals looks good. Let’s now repeat the analysis above, fitting an \(MA(1)\) and then plotting the AIC and BIC for a sequence of \(MA(q)\) models, for \(q = 1,2,\ldots,10\).

ma1Fit = arima(diffInflation, order=c(0,0,1))
layout(matrix(c(1,1,2,3), 2, 2, byrow = TRUE))
plot(ma1Fit$resid)
abline(h=0)
acf(ma1Fit$resid)
qqnorm(ma1Fit$resid, datax=TRUE)
qqline(ma1Fit$resid, datax=TRUE)

qMax = 10
aicMA = bicMA = rep(0, length=qMax)
for(q in 1:qMax){
    out = arima(diffInflation, order=c(0,0,q))
    aicMA[q] = out$aic
    bicMA[q] = out$aic - 2*(2+q) + log(length(diffInflation))*(2+q)
}
yMin = min(min(aicMA), min(bicMA))
yMax = max(max(aicMA), max(bicMA))
plot(aicMA, xlab="q", ylab="Criterion", pch=8, ylim=c(yMin,yMax),
    main="MA Fits to Changes in Inflation Rate")
points(bicMA)
legend("topright", legend=c("AIC", "BIC"), pch=c(8,1))

The BIC is minimized at \(q=3\) and the AIC is minimized at \(q=2\). We can now use the auto.arima function to automatically select the best \(MA\) model and to examine the corresponding residuals.

out = auto.arima(diffInflation, max.p=0, max.q=10, ic="bic")
layout(matrix(c(1,1,2,3), 2, 2, byrow = TRUE))
plot(out$resid)
abline(h=0)
acf(out$resid)
qqnorm(out$resid, datax=TRUE)
qqline(out$resid, datax=TRUE)

Finally, we use the auto.arima function to fit a sequence of \(ARMA(p,q)\) models for \(p=\{1,2,3,4,5\}\) and \(q=\{1,2,3,4,5\}\) and examine the residuals of the best fit model.

out = auto.arima(diffInflation, max.p=5, max.q=5, ic="bic")
layout(matrix(c(1,1,2,3), 2, 2, byrow = TRUE))
plot(out$resid)
abline(h=0)
acf(out$resid)
qqnorm(out$resid, datax=TRUE)
qqline(out$resid, datax=TRUE)

LS0tCnRpdGxlOiAiQVJNQSBFc3RpbWF0aW9uIEV4YW1wbGUiCm91dHB1dDogaHRtbF9ub3RlYm9vawotLS0KCkluIHRoaXMgbm90ZWJvb2sgd2Ugd2lsbCBmaXQgc2V2ZXJhbCAkQVIkLCAkTUEkIGFuZCAkQVJNQSQgbW9kZWxzIHRvIGluZmxhdGlvbiBkYXRhLiBMZXQgdXMgYmVnaW4gYnkgcHVsbGluZyBDUEkgaW5mbGF0aW9uIGRhdGEgaW50byBgUmAgYW5kIHRha2luZyBmaXJzdCBkaWZmZXJlbmNlcyAod2Ugd2lsbCBzZWUgdGhhdCB0aGUgZmlyc3QgZGlmZmVyZW5jZXMgYXBwZWFyIHRvIGJlIG1vcmUgc3RhdGlvbmFyeSB0aGFuIGxldmVscykuCmBgYHtyfQpsaWJyYXJ5KEVjZGF0KQpkYXRhKE1pc2hraW4pCmluZmxhdGlvbiA9IE1pc2hraW5bLDFdCmRpZmZJbmZsYXRpb24gPSBkaWZmKGluZmxhdGlvbikKYGBgClRvIGdldCBhIHNlbnNlIG9mIHRoZSBkYXRhLCBsZXQncyBwbG90IHRoZSB0aW1lIHNlcmllcyBvZiBpbmZsYXRpb24gYW5kIGZpcnN0IGRpZmZlcmVuY2VzIG9mIGluZmxhdGlvbi4KYGBge3IsZmlnLndpZHRoPTEwfQpwYXIobWZyb3c9YygyLDEpKQpwbG90KGluZmxhdGlvbiwgeWxhYj0iSW5mbGF0aW9uIHJhdGUiLCBtYWluPSIoYSkiKQphYmxpbmUoaD0wKQpwbG90KGRpZmZJbmZsYXRpb24sIHlsYWI9IkNoYW5nZSBpbiBpbmZsYXRpb24gcmF0ZSIsIG1haW49IihiKSIpCmFibGluZShoPTApCmBgYApJbmZsYXRpb24gbGV2ZWxzIGRvIG5vdCBhcHBlYXIgdG8gaGF2ZSBhIHN0YXRpb25hcnkgbWVhbiwgaG93ZXZlciB0aGUgZmlyc3QgZGlmZmVyZW5jZXMgZG8uIFRoZSBhdXRvY29ycmVsYXRpb25zIG9mIGZpcnN0IGRpZmZlcmVuY2VzIGFyZSBkZXBpY3RlZCBiZWxvdy4KYGBge3IsZmlnLndpZHRoPTEwfQphY2YoYXMubnVtZXJpYyhkaWZmSW5mbGF0aW9uKSkKYGBgClRoZSBBQ0YgcGxvdCBzdWdnZXN0cyB0aGF0IGFuICRNQSgxKSQgbW9kZWwgbWlnaHQgYmUgYXBwcm9wcmlhdGUgZm9yIHRoaXMgZGF0YS4gV2Ugd2lsbCBiZWdpbiwgaG93ZXZlciwgYnkgZml0dGluZyBhbiAkQVIoMSkkIGFuZCBleGFtaW5pbmcgdGhlIHJlc2lkdWFscy4KYGBge3IsZmlnLndpZHRoPTEwfQphcjFGaXQgPSBhcmltYShkaWZmSW5mbGF0aW9uLCBvcmRlcj1jKDEsMCwwKSkKbGF5b3V0KG1hdHJpeChjKDEsMSwyLDMpLCAyLCAyLCBieXJvdyA9IFRSVUUpKQpwbG90KGFyMUZpdCRyZXNpZCkKYWJsaW5lKGg9MCkKYWNmKGFzLm51bWVyaWMoYXIxRml0JHJlc2lkKSkKcXFub3JtKGFyMUZpdCRyZXNpZCwgZGF0YXg9VFJVRSkKcXFsaW5lKGFyMUZpdCRyZXNpZCwgZGF0YXg9VFJVRSkKYGBgClRoZSB0aW1lIHNlcmllcyBhbmQgQUNGIHBsb3RzIG9mIHRoZSByZXNpZHVhbHMgbG9vayBkZWNlbnQsIGFsdGhvdWdoIHRoZSBuZWdhdGl2ZSBhdXRvY29ycmVsYXRpb25zIGF0IGxhZ3MgMiBhbmQgMyBtaWdodCBzdWdnZXN0IHRoYXQgd2Ugc3RpbGwgaGF2ZW4ndCBhcHByb3ByaWF0ZWx5IG1vZGVsZWQgdGhlIHRpbWUgZHluYW1pY3Mgb2YgdGhlIGRhdGEuIFRoZSBuZXh0IGNvZGUgYmxvY2sgZml0cyBhbiAkQVIocCkkIG1vZGVsIGZvciAkcCA9IDEsMixcbGRvdHMsMjAkIGFuZCBwbG90cyBib3RoIHRoZSBBSUMgYW5kIEJJQyB2YWx1ZXMgZm9yIGVhY2ggZml0LgpgYGB7cixmaWcud2lkdGg9MTB9CiNpbnN0YWxsLnBhY2thZ2VzKCJmb3JlY2FzdCIpOyAjIHJ1biB0aGlzIGlmICdmb3JlY2FzdCcgbm90IGluc3RhbGxlZApsaWJyYXJ5KGZvcmVjYXN0KQpwTWF4ID0gMjAKYWljQVIgPSBiaWNBUiA9IHJlcCgwLCBsZW5ndGg9cE1heCkKZm9yKHAgaW4gMTpwTWF4KXsKCW91dCA9IGFyaW1hKGRpZmZJbmZsYXRpb24sIG9yZGVyPWMocCwwLDApKQoJYWljQVJbcF0gPSBvdXQkYWljCgliaWNBUltwXSA9IG91dCRhaWMgLSAyKigyK3ApICsgbG9nKGxlbmd0aChkaWZmSW5mbGF0aW9uKSkqKDIrcCkKfQp5TWluID0gbWluKG1pbihhaWNBUiksIG1pbihiaWNBUikpCnlNYXggPSBtYXgobWF4KGFpY0FSKSwgbWF4KGJpY0FSKSkKcGxvdChhaWNBUiwgeGxhYj0icCIsIHlsYWI9IkNyaXRlcmlvbiIsIHBjaD04LCB5bGltPWMoeU1pbix5TWF4KSwKCW1haW49IkFSIEZpdHMgdG8gQ2hhbmdlcyBpbiBJbmZsYXRpb24gUmF0ZSIpCnBvaW50cyhiaWNBUikKbGVnZW5kKCJ0b3ByaWdodCIsIGxlZ2VuZD1jKCJBSUMiLCAiQklDIiksIHBjaD1jKDgsMSkpCmBgYApUaGUgcGxvdCBzaG93cyB0aGF0IEJJQyBpcyBtaW5pbWl6ZWQgYXQgJHAgPSA2JCB3aGlsZSBBSUMgaXMgbWluaW1pemVkIGF0ICRwID0gMTYkLiBXZSBjYW4gYWxzbyB1c2UgdGhlIGBhdXRvLmFyaW1hYCBmdW5jdGlvbiB0byBhdXRvbWF0aWNhbGx5IGZpdCBhbmQgc2VsZWN0IHRoZSBiZXN0ICRBUiQgbW9kZWwgdXNpbmcgQUlDIG9yIEJJQy4gVGhlIGZvbGxvd2luZyBjb2RlIGRvZXMgdGhpcyBhbmQgdGhlbiBleGFtaW5lcyB0aGUgcmVzaWR1YWxzIGZvciB0aGUgYmVzdCBmaXQgbW9kZWwuCmBgYHtyLGZpZy53aWR0aD0xMH0Kb3V0ID0gYXV0by5hcmltYShkaWZmSW5mbGF0aW9uLCBtYXgucD0xMCwgbWF4LnE9MCwgaWM9ImJpYyIpCmxheW91dChtYXRyaXgoYygxLDEsMiwzKSwgMiwgMiwgYnlyb3cgPSBUUlVFKSkKcGxvdChvdXQkcmVzaWQpCmFibGluZShoPTApCmFjZihvdXQkcmVzaWQpCnFxbm9ybShvdXQkcmVzaWQsIGRhdGF4PVRSVUUpCnFxbGluZShvdXQkcmVzaWQsIGRhdGF4PVRSVUUpCmBgYApUaGUgQUNGIG9mIHRoZSByZXNpZHVhbHMgbG9va3MgZ29vZC4gTGV0J3Mgbm93IHJlcGVhdCB0aGUgYW5hbHlzaXMgYWJvdmUsIGZpdHRpbmcgYW4gJE1BKDEpJCBhbmQgdGhlbiBwbG90dGluZyB0aGUgQUlDIGFuZCBCSUMgZm9yIGEgc2VxdWVuY2Ugb2YgJE1BKHEpJCBtb2RlbHMsIGZvciAkcSA9IDEsMixcbGRvdHMsMTAkLgpgYGB7cixmaWcud2lkdGg9MTB9Cm1hMUZpdCA9IGFyaW1hKGRpZmZJbmZsYXRpb24sIG9yZGVyPWMoMCwwLDEpKQpsYXlvdXQobWF0cml4KGMoMSwxLDIsMyksIDIsIDIsIGJ5cm93ID0gVFJVRSkpCnBsb3QobWExRml0JHJlc2lkKQphYmxpbmUoaD0wKQphY2YobWExRml0JHJlc2lkKQpxcW5vcm0obWExRml0JHJlc2lkLCBkYXRheD1UUlVFKQpxcWxpbmUobWExRml0JHJlc2lkLCBkYXRheD1UUlVFKQpgYGAKYGBge3IsZmlnLndpZHRoPTEwfQpxTWF4ID0gMTAKYWljTUEgPSBiaWNNQSA9IHJlcCgwLCBsZW5ndGg9cU1heCkKZm9yKHEgaW4gMTpxTWF4KXsKCW91dCA9IGFyaW1hKGRpZmZJbmZsYXRpb24sIG9yZGVyPWMoMCwwLHEpKQoJYWljTUFbcV0gPSBvdXQkYWljCgliaWNNQVtxXSA9IG91dCRhaWMgLSAyKigyK3EpICsgbG9nKGxlbmd0aChkaWZmSW5mbGF0aW9uKSkqKDIrcSkKfQp5TWluID0gbWluKG1pbihhaWNNQSksIG1pbihiaWNNQSkpCnlNYXggPSBtYXgobWF4KGFpY01BKSwgbWF4KGJpY01BKSkKcGxvdChhaWNNQSwgeGxhYj0icSIsIHlsYWI9IkNyaXRlcmlvbiIsIHBjaD04LCB5bGltPWMoeU1pbix5TWF4KSwKCW1haW49Ik1BIEZpdHMgdG8gQ2hhbmdlcyBpbiBJbmZsYXRpb24gUmF0ZSIpCnBvaW50cyhiaWNNQSkKbGVnZW5kKCJ0b3ByaWdodCIsIGxlZ2VuZD1jKCJBSUMiLCAiQklDIiksIHBjaD1jKDgsMSkpCmBgYApUaGUgQklDIGlzIG1pbmltaXplZCBhdCAkcT0zJCBhbmQgdGhlIEFJQyBpcyBtaW5pbWl6ZWQgYXQgJHE9MiQuIFdlIGNhbiBub3cgdXNlIHRoZSBgYXV0by5hcmltYWAgZnVuY3Rpb24gdG8gYXV0b21hdGljYWxseSBzZWxlY3QgdGhlIGJlc3QgJE1BJCBtb2RlbCBhbmQgdG8gZXhhbWluZSB0aGUgY29ycmVzcG9uZGluZyByZXNpZHVhbHMuCmBgYHtyLGZpZy53aWR0aD0xMH0Kb3V0ID0gYXV0by5hcmltYShkaWZmSW5mbGF0aW9uLCBtYXgucD0wLCBtYXgucT0xMCwgaWM9ImJpYyIpCmxheW91dChtYXRyaXgoYygxLDEsMiwzKSwgMiwgMiwgYnlyb3cgPSBUUlVFKSkKcGxvdChvdXQkcmVzaWQpCmFibGluZShoPTApCmFjZihvdXQkcmVzaWQpCnFxbm9ybShvdXQkcmVzaWQsIGRhdGF4PVRSVUUpCnFxbGluZShvdXQkcmVzaWQsIGRhdGF4PVRSVUUpCmBgYApGaW5hbGx5LCB3ZSB1c2UgdGhlIGBhdXRvLmFyaW1hYCBmdW5jdGlvbiB0byBmaXQgYSBzZXF1ZW5jZSBvZiAkQVJNQShwLHEpJCBtb2RlbHMgZm9yICRwPVx7MSwyLDMsNCw1XH0kIGFuZCAkcT1cezEsMiwzLDQsNVx9JCBhbmQgZXhhbWluZSB0aGUgcmVzaWR1YWxzIG9mIHRoZSBiZXN0IGZpdCBtb2RlbC4KYGBge3IsZmlnLndpZHRoPTEwfQpvdXQgPSBhdXRvLmFyaW1hKGRpZmZJbmZsYXRpb24sIG1heC5wPTUsIG1heC5xPTUsIGljPSJiaWMiKQpsYXlvdXQobWF0cml4KGMoMSwxLDIsMyksIDIsIDIsIGJ5cm93ID0gVFJVRSkpCnBsb3Qob3V0JHJlc2lkKQphYmxpbmUoaD0wKQphY2Yob3V0JHJlc2lkKQpxcW5vcm0ob3V0JHJlc2lkLCBkYXRheD1UUlVFKQpxcWxpbmUob3V0JHJlc2lkLCBkYXRheD1UUlVFKQpgYGAKCg==