knitr::opts_chunk$set(echo = TRUE)

Assignment 1, Problem 1

September 11th Impact on Travel

library(dplyr)
library(tidyr)
library(knitr)
library(forecast)

#Read in .csv file

BTS_all<-read.csv("data files/Sept11Travel.csv")
# Format data for useful plot presentation

#names(BTS_all)
BTS_all$Air_Miles <-BTS_all$Air/1000000
BTS_all$Rail_Miles <-BTS_all$Rail/1000000
#str(BTS_all)
BTS_all <-select(BTS_all,1,5,6,4)
#str(BTS_all)
BTS_all.ts<-ts(BTS_all$Air_Miles,BTS_all$Rail_Miles, BTS_all$VMT, start=c(1990,1),end=c(2004,4), frequency = 12)
BTS_air_only<-select(BTS_all,1:2)
BTS_rail_only<-select(BTS_all,1,3)
BTS_VMT_only<-select(BTS_all,1,4)
BTS_air.ts<-ts(BTS_air_only$Air_Miles, start=c(1990,1),end=c(2004,4), frequency = 12)
BTS_air_lm<-tslm(BTS_air.ts ~ trend+I(trend^2))
BTS_rail.ts<-ts(BTS_rail_only$Rail_Miles, start=c(1990,1),end=c(2004,4), frequency = 12)
BTS_rail_lm<-tslm(BTS_rail.ts ~ trend+I(trend^2))
BTS_VMT.ts<-ts(BTS_VMT_only$VMT, start=c(1990,1),end=c(2004,4), frequency = 12)
BTS_VMT_lm<-tslm(BTS_VMT.ts ~ trend+I(trend^2))
#  Generate plots
par(mfrow = c(1,1))
plot(BTS_air.ts, col=4, main="Air Travel - Miles/Month", xlab="Month", ylab="Miles Traveled (millions)", type="l")
lines(BTS_air_lm$fitted, col=2, lwd=2)

plot(BTS_rail.ts, col=4, main="Rail Travel - Miles/Month", xlab="Month", ylab="Miles Traveled (millions)", type="l")
lines(BTS_rail_lm$fitted, col=2, lwd=2)

plot(BTS_VMT.ts, col=4, main="Car Travel - Miles/Month", xlab="Month", ylab="Miles Traveled", type="l")
lines(BTS_VMT_lm$fitted, col=2, lwd=2)

Analysis of US Air, Train, and Automobile travel from Janary 1990 to April 2004, looking for any impact in miles traveled for each mode of transportation following the September 11th attacks.

Looking at the graphs, all three, Air, Rail, and VMT, have have a 12 month seasonality. All are lower in the winter months and peak in the summer. This is reflective of summer being the traditional vacation time, with children being off from school, and most everyone wanting to enjoy the summer weather.

Assessing the impact of September 11, 2001 on Air, Rail, and VMT, only Air seems to be impacted. And even by April of 2004 Air travel had not recovered to pre-911 volumes. From 1990 to September 11, 2001, the trend was increasing miles traveled. Even after the “correction” of September 11, the trend returned to increasing through April of 2004.

Rail, also indicating strong seasonal trends, did not seem to be impacted at all by September 11, 2001. However, it appears that some change in traveler trends occured in 1995 that caused overall miles traveled to decline. The trend for miles traveled remained steady until 1995. Along with the decline there seems to be an increase in seasonal variation, but again, the trend year to year is static.

Vehicle (car) miles traveled per month is considerably lower than Air or Rail, but it seems that the measurement is per car (or driver), where Air and Rail appear to be totaled across the industry. Never the less, car travel is also seasonal and the trend is steadily increasing.

Assignment 1, Problem 3

Shipments of Household Appliances

#Read in .csv file

shipments<-read.csv("data files/ApplianceShipments.csv")
#str(shipments)
#names(shipments)
#print(shipments)
shipments.ts<-ts(shipments$Shipments, start=c(1985,1),end=c(1989,4), frequency = 4)
shipments_lm<-tslm(shipments.ts ~ trend+I(trend^2))
#print(shipments.ts)
#  Generate plots
par(mfrow = c(1,1))
plot(shipments.ts, col=4, main="Appliance Shipments per Quarter (in Millions)", xlab="Quarter", ylab="Shipments (millions)", type="l")
lines(shipments_lm$fitted, col=2, lwd=2)

Appliance shipments during the five year period, 1985 through 1989, showed a seasonal pattern of a peak in the Q1 followed by a slow decline, bottoming out in Q4, then ramping back up in Q1. There was an overall growth trend during the five years. The slight variations to this pattern can be the result of noise.

Assignment 1, Problem 6

Forecasting Shampoo Sales

#Read in .csv file

Shampoo<-read.csv("data files/ShampooSales.csv")
#str(Shampoo)
#names(Shampoo)
#print(Shampoo)
Shampoo.ts<-ts(Shampoo$Shampoo.Sales, start=c(1986,9),end=c(1997,12), frequency = 12)
Shampoo_lm<-tslm(Shampoo.ts ~ trend+I(trend^2))
#print(Shampoo.ts)
#  Generate plots
par(mfrow = c(1,1))
plot(Shampoo.ts, col=3, main="Monthly Shampoo Sales", xlab="Month", ylab="Volume", type="l")
lines(Shampoo_lm$fitted, col=2, lwd=2)

Oddly enough, shampoo sales have a seasonal component. One guess might be that people are more active in the warmer weather and as a result bath more frequently. The trend is pretty static with sales peaking in what looks to be summer and sharply dropping back towards late fall. I don’t know what the unit of measure is in this data, but my guess would be some measure of units sold and not dollars. This pattern seems very predictable with little or no noise.