Exercise 9.13

data <- read.table("http://www.principlesofeconometrics.com/poe4/data/dat/ex9_13.dat", 
    header = FALSE, sep = "", na.strings = "NA", dec = ".", strip.white = TRUE)
names(data)[c(1, 2)] <- c("sales", "adv")

attach(data)
adv0 = ts(adv)
plot(adv0)

adv1 = lag(adv0, -1)
adv2 = lag(adv0, -2)
adv3 = lag(adv0, -3)
A = cbind(adv0, adv1, adv2, adv3)
A = A[6:157, ]
A = data.frame(A)
s = sales[6:157]
detach(data)

model = lm(s ~ adv0 + adv1 + adv2 + adv3, data = A)
summary(model)

## 
## Call:
## lm(formula = s ~ adv0 + adv1 + adv2 + adv3, data = A)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -4.003 -0.774  0.013  0.718  3.083 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   19.216      0.689   27.90   <2e-16 ***
## adv0           2.756      0.805    3.42   0.0008 ***
## adv1           2.473      0.998    2.48   0.0143 *  
## adv2           1.527      1.019    1.50   0.1364    
## adv3           1.878      0.820    2.29   0.0234 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 
## 
## Residual standard error: 1.13 on 147 degrees of freedom
## Multiple R-squared: 0.553,   Adjusted R-squared: 0.541 
## F-statistic: 45.5 on 4 and 147 DF,  p-value: <2e-16

# Data for scenario i
data.lines <- "adv0  adv1  adv2  adv3\n0 0.998 0.681 0.889\n0 0.000 0.998 0.681\n0 0.000 0.000 0.998\n0 0.000 0.000 0.000\n"
scenario.i.data = data.frame(read.table(textConnection(data.lines), header = TRUE, 
    sep = ""))

# For a given value of x, the interval estimate of the dependent variable
# y is called the prediction interval.
sc.i.pred = data.frame(predict(model, scenario.i.data, level = 0.95, interval = "prediction"))
sc.i.pred

##     fit   lwr   upr
## 1 24.39 21.60 27.19
## 2 22.02 19.18 24.86
## 3 21.09 18.30 23.88
## 4 19.22 16.60 21.83

# For a given value of x, the interval estimate for the mean of the
# dependent variable, is called the confidence interval.
sc.i.confid = data.frame(predict(model, scenario.i.data, level = 0.95, interval = "confidence"))
sc.i.confid

##     fit   lwr   upr
## 1 24.39 22.71 26.08
## 2 22.02 20.26 23.78
## 3 21.09 19.41 22.77
## 4 19.22 17.85 20.58

i.mean = ts(sc.i.confid$fit, start = 158)
i.lwr = ts(sc.i.confid$lwr, start = 158)
i.upr = ts(sc.i.confid$upr, start = 158)

ts.plot(i.mean, i.lwr, i.upr, ylab = "mean prediction", lwd = 2, col = c(2, 
    3, 3))

# Data for scenario ii
data.lines <- "adv0  adv1  adv2  adv3\n6 0.998 0.681 0.889\n0 6.000 0.998 0.681\n0 0.000 6.000 0.998\n0 0.000 0.000 6.000\n"
scenario.ii.data = data.frame(read.table(textConnection(data.lines), header = TRUE, 
    sep = ""))

sc.ii.confid = data.frame(predict(model, scenario.ii.data, level = 0.95, interval = "prediction"))
sc.ii.confid

##     fit   lwr   upr
## 1 40.93 32.64 49.23
## 2 36.86 25.68 48.04
## 3 30.25 18.89 41.61
## 4 30.48 20.92 40.04

ii.mean = ts(sc.ii.confid$fit, start = 158)
ii.lwr = ts(sc.ii.confid$lwr, start = 158)
ii.upr = ts(sc.ii.confid$upr, start = 158)

ts.plot(ii.mean, ii.lwr, ii.upr, ylab = "mean prediction", lwd = 2, col = c(2, 
    3, 3))

# Data for scenario iii
data.lines <- "adv0  adv1  adv2  adv3\n1 0.998 0.681 0.889\n1 1.000 0.998 0.681\n1 1.000 1.000 1.998\n1 1.000 1.000 1.000\n"
scenario.iii.data = data.frame(read.table(textConnection(data.lines), header = TRUE, 
    sep = ""))

sc.iii.confid = data.frame(predict(model, scenario.iii.data, level = 0.95, interval = "prediction"))
sc.iii.confid

##     fit   lwr   upr
## 1 27.15 24.84 29.46
## 2 27.25 24.95 29.55
## 3 29.72 26.97 32.47
## 4 27.85 25.61 30.09

iii.mean = ts(sc.iii.confid$fit, start = 158)
iii.lwr = ts(sc.iii.confid$lwr, start = 158)
iii.upr = ts(sc.iii.confid$upr, start = 158)

ts.plot(iii.mean, iii.lwr, iii.upr, ylab = "mean prediction", lwd = 2, col = c(2, 
    3, 3))

Finally a plot with all three scenarios in:

ts.plot(i.mean, i.lwr, i.upr, ii.mean, ii.lwr, ii.upr, iii.mean, iii.lwr, iii.upr, 
    ylab = "mean prediction", lwd = 2, col = c(2, 5, 5, 2, 3, 3, 2, 4, 4))

Data definition file: http://www.principlesofeconometrics.com/poe4/data/def/ex9_13.def

ex9-13.def

sales adv

OBS: 157

sales = weekly sales revenue in millions of dollars
adv = weekly advertising expenditure in millions of dollars

Observation period: DEC 28, 2004 to DEC 25, 2007.

Data Source: Courtesy of Mid-West Department Store