library(readr)
library(forecast)
Sept11.data <- read_csv('data/Sept11Travel.csv')
Sept11.ts <- ts(Sept11.data[,2:4],
start = c(1990,1), end = c(2004,4), frequency = 12 )
Sept11.ts <- window(Sept11.ts,
start = c(1990,1), end = c(2001,8))
plot(Sept11.ts,
oma.multi = c(6, 0, 5, 0),
mar.multi = c(1.5, 5.1, 0, 2.1), nc = 1,
main = "Travel Data before Sept 11th Attacks")
In addition to level and white-noise (random fluctuations), the time-series plot for air travel shows both an overall increasing trend and yearly seasonality. It appears that each year air-travel is highest in the middle of the year (summer). The plot for rail travel appears to show a slight decreasing trend overall, but it is not constant. It appears that rail travel may be starting to increase from 1999 through 2001. As with air travel, rail travel also shows strong seasonality (peak travel in summer), especially from 1995 onwards. Automobile (VMT) travel shows an overall increasing trend and seasonality with peak travel in the summer.
Let’s take a look at the overall trend in the time-series:
AirTravel.ts <- Sept11.ts[, "Air"]
linear <- tslm(AirTravel.ts ~ trend)
quad <- tslm(AirTravel.ts ~ trend + I(trend^2))
plot(AirTravel.ts, ylab = "Air Passenger Miles",
main = "Air Travel Trends")
lines(linear$fitted.values, lwd = 2, col = 'green')
lines(quad$fitted.values, lwd = 2, col = 'blue', lty = 2)
There appears to be a strong positive linear trend in air passenger miles. The green line shows a linear trendline for the air travel time-series while the blue dashed-line shows a quadratic trend line. The quadratic trend line doesn’t appear much better (just from eye-balling) than the the linear trend. We can examine this trend with seasonality removed by using a lag of 12 months (the seasonality period is 1 year or 12 months).
linear <- tslm(diff(AirTravel.ts, 12) ~ trend)
plot(diff(AirTravel.ts, 12), ylab = "Air Passenger Miles",
main = "Air Travel Trends: 12 Month Lag")
lines(linear$fitted.values, lwd = 2, col = 'green')
When we look at the difference in air travel between the same months of successive years (the plot above), the majority of the values are positive indicating that there is a positive trend in air travel. Additionally, it seems that this trend may be increasing as shown by the upward sloping green trend line.
ggsubseriesplot(AirTravel.ts,
main = "Air Travel Monthly Subseries Plot",
ylab = "Air Passenger Miles")
The subseries plot above shows the air travel time-series broken down by month. Here it is clear that for every month, there is a strong positive trend in travel from 1990 to 2001 (except for a small dip in the early 90s).
ggseasonplot(AirTravel.ts,
main = "Air Travel Season Plot",
ylab = "Air Passenger Miles")
The plot aboves shows that each year shows similar seasonal patterns. Air travel increases from April through August (peaking between July and August). Air travel then decreases significantly.
Let’s take a look at the overall trend in the time-series:
RailTravel.ts <- Sept11.ts[, "Rail"]
linear <- tslm(RailTravel.ts ~ trend)
quad <- tslm(RailTravel.ts ~ trend + I(trend^2))
cube <- tslm(RailTravel.ts ~ trend + I(trend^2) + I(trend^3))
plot(RailTravel.ts, ylab = "Rail Passenger Miles",
main = "Rail Travel Trends")
lines(linear$fitted.values, lwd = 2, col = 'green')
lines(quad$fitted.values, lwd = 2, col = 'blue', lty = 2)
lines(cube$fitted.values, lwd = 2, col = 'red', lty = 3)
Overall from 1990 through 2001 rail travel decreased but not by much and not constantly. Neither the linear, quadratic, or third-degree polynomial trend lines (green, blue, and red respectively in the above plot) fit the time series closely. The decreasing trend is not very strong and there is a lot of seasonal variation. There also appears to be more white noise in the rail travel time-series than in the air travel time-series.
plot(diff(RailTravel.ts, 12), ylab = "Rail Passenger Miles",
main = "Rail Travel Trends: 12 Month Lag")
mean(diff(RailTravel.ts, 12))
## [1] -6517047
When we look at the difference in rail travel between the same months of successive years (the plot above), the fluctuations vary greatly. Often they are postive but the mean difference is negative (-6517047) indicating that there is indeed a negative overal trend.
ggsubseriesplot(RailTravel.ts,
main = "Rail Travel Monthly Subseries Plot",
ylab = "Rail Passenger Miles")
The subseries plot above shows the rail travel time-series broken down by month. For most months, rail travel actually increased slightly during the early 90s before drasticly decreasing. However rail travel then seemed to bounce back during the late 90s.
ggseasonplot(RailTravel.ts,
main = "Rail Travel Season Plot",
ylab = "Rail Passenger Miles")
The plot aboves shows the seasonal trend each year. While the seasonality is less obvious in the early 90s, overall travel tends to increase from spring through summer (peaking around July and August), and then drops off.
Let’s take a look at the overall trend in the time-series:
VMTTravel.ts <- Sept11.ts[, "VMT"]
linear <- tslm(VMTTravel.ts ~ trend)
plot(VMTTravel.ts, ylab = "Automobile Passenger Miles",
main = "Automobile Travel Trends")
lines(linear$fitted.values, lwd = 2, col = 'green')
lines(quad$fitted.values, lwd = 2, col = 'blue', lty = 2)
lines(cube$fitted.values, lwd = 2, col = 'red', lty = 3)
The appears to be a strong positive linear trend in automobile travel from 1990 through 2001.
plot(diff(VMTTravel.ts, 12), ylab = "Automobile Passenger Miles",
main = "Automobile Travel Trends: 12 Month Lag")
When we look at the difference in automobile travel between the same months of successive years (the plot above), the changes are mostly positive indicating a positive trend in automobile travel.
ggsubseriesplot(VMTTravel.ts,
main = "Automobile Travel Monthly Subseries Plot",
ylab = "Automobile Passenger Miles")
The subseries plot above shows the automobile travel time-series broken down by month. For all months, automobile travel increased from 1990 through 2001. This increase was steady for most months except for January, which exhibited some more variation.
ggseasonplot(VMTTravel.ts,
main = "Automobile Travel Season Plot",
ylab = "Automobile Passenger Miles")
The plot aboves shows the seasonal trend each year. Seasonality remained pretty constant from 1990 through 2001. Travel increased from February through the summer, peaking around July and August before dropping off.
Appliances.data <- read_csv('data/ApplianceShipments.csv')
Appliances.ts <- ts(Appliances.data[,2],
start = c(1985,1), end = c(1989,4), frequency = 4)
linear <- tslm(Appliances.ts ~ trend)
plot(Appliances.ts,
xlab = 'Date',
ylab = 'Quarterly Sales (units)',
main = 'Appliance Sales Time-Series')
lines(linear$fitted.values, lwd = 2, col = 'darkgreen')
paste("Time-series level is: ", mean(Appliances.ts), sep = '')
## [1] "Time-series level is: 4424.85"
This time-series has level because all time-series do (level is the average value of the series, in this case it is 4424.85 shipments per quarter). The time series also has noise since there is unaccounted for variation. In addition to level and noise, the time-series has a positive trend and seasonality. For most years, the first and fourth quarters saw the least sales and for every year the most sales were either in the second or third quarter.
Shampoo.data <- read_csv('data/ShampooSales.csv')
Shampoo.ts <- ts(Shampoo.data[,2],
start = c(1995,1), end = c(1997,12), frequency = 12)
linear <- tslm(Shampoo.ts ~ trend)
plot(Shampoo.ts,
xlab = 'Date',
ylab = 'Monthly Sales (units)',
main = 'Shampoo Sales Time-Series')
lines(linear$fitted.values, lwd = 2, col = 'darkgreen')
paste("Time-series level is: ", mean(Shampoo.ts), sep = '')
## [1] "Time-series level is: 312.6"
This time-series has level because all time-series do (in this case it is 312.6). The time series also has noise since there is unaccounted for variation. In addition to level and noise, the time-series has a positive trend. Unlike the travel and appliances sales time-series, the shampoo sales time-series does not show any seasonality. This is not surprising to me. I would not expect to see seasonality in sales of shampoo since peoples’ need to shampoo their hair is pretty constant from month to month.