BayArea Interest Rate Case Study

---

MARR section 9.3, pp. 319-325

BayArea <- read_csv("BayArea.csv")
#summary(BayArea)
#str(BayArea)
BayArea

## # A tibble: 19 x 5
##    Month MonthName InterestRate LoansClosed VacancyIndex
##    <dbl> <chr>            <dbl>       <dbl>        <dbl>
##  1     1 June              6.25       128.          3.03
##  2     2 July              6.3        114.          3.14
##  3     3 August            6.3         99           3.25
##  4     4 September         6.31        87.1         3.08
##  5     5 October           6.31        85.9         2.9 
##  6     6 November          6.34        88.9         2.73
##  7     7 December          6.32        95           2.55
##  8     8 January           6.37        70.8         2.55
##  9     9 February          6.37        69.8         2.54
## 10    10 March             6.37        95.7         2.54
## 11    11 April             6.56        65           2.54
## 12    12 May               6.69        35.7         2.59
## 13    13 June              6.8         25.4         2.65
## 14    14 July              6.92        21.5         2.7 
## 15    15 August            7.04        28.2         2.76
## 16    16 September         6.96        29.8         2.57
## 17    17 October           7.08        31.2         2.37
## 18    18 November          7.08        28.3         2.17
## 19    19 December          7.12        38.9         1.96

attach(BayArea)

Figure 9.12 on page 321

pairs(InterestRate~LoansClosed+VacancyIndex)

Figure 9.13 on page 322

m1 <- lm(InterestRate~LoansClosed+VacancyIndex)
summary(m1)

## 
## Call:
## lm(formula = InterestRate ~ LoansClosed + VacancyIndex)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.22079 -0.08295 -0.01989  0.13077  0.19638 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   7.580687   0.312308   24.27 4.74e-14 ***
## LoansClosed  -0.007756   0.001249   -6.21 1.25e-05 ***
## VacancyIndex -0.176577   0.132733   -1.33    0.202    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.1432 on 16 degrees of freedom
## Multiple R-squared:  0.8344, Adjusted R-squared:  0.8137 
## F-statistic: 40.31 on 2 and 16 DF,  p-value: 5.651e-07

StanRes1 <- rstandard(m1)

mres1 <- lm(StanRes1~LoansClosed+I(LoansClosed^2))
a1 <- mres1$coeff[1]
a2 <- mres1$coeff[2]
a3 <- mres1$coeff[3]

mres2 <- lm(StanRes1~m1$fitted.values+I(m1$fitted.values^2))
b1 <- mres2$coeff[1]
b2 <- mres2$coeff[2]
b3 <- mres2$coeff[3]

par(mfrow=c(2,2))
#
plot(LoansClosed,StanRes1,ylab="Standardized Residuals")
curve(a1 + a2*x + a3*x^2, add = TRUE, col = "blue",lty=2)
#
plot(VacancyIndex,StanRes1,ylab="Standardized Residuals")
#
plot(m1$fitted.values,StanRes1,ylab="Standardized Residuals",xlab="Fitted Values")
curve(b1 + b2*x + b3*x^2, add = TRUE, col = "blue",lty=2)
#
acf(m1$residuals,main="Standardized LS Residuals")

R output on page 323 (top)

library(nlme)
m1 <- gls(InterestRate~LoansClosed+VacancyIndex,
          correlation=corAR1(form=~Month),
          data=BayArea,
          method="ML")
acf(m1$residuals,main="GLS Residuals")

summary(m1)

## Generalized least squares fit by maximum likelihood
##   Model: InterestRate ~ LoansClosed + VacancyIndex 
##   Data: BayArea 
##         AIC       BIC   logLik
##   -35.30833 -30.58613 22.65416
## 
## Correlation Structure: AR(1)
##  Formula: ~Month 
##  Parameter estimate(s):
##       Phi 
## 0.9572093 
## 
## Coefficients:
##                  Value Std.Error   t-value p-value
## (Intercept)   7.122990 0.4182065 17.032232  0.0000
## LoansClosed  -0.003432 0.0011940 -2.874452  0.0110
## VacancyIndex -0.076340 0.1307842 -0.583710  0.5676
## 
##  Correlation: 
##              (Intr) LnsCls
## LoansClosed  -0.316       
## VacancyIndex -0.822  0.117
## 
## Standardized residuals:
##        Min         Q1        Med         Q3        Max 
## -1.3439744 -1.1533069 -0.8047658  0.4467079  1.1783687 
## 
## Residual standard error: 0.2377426 
## Degrees of freedom: 19 total; 16 residual

intervals(m1)

## Approximate 95% confidence intervals
## 
##  Coefficients:
##                     lower         est.         upper
## (Intercept)   6.236431638  7.122989795  8.0095479516
## LoansClosed  -0.005963412 -0.003432182 -0.0009009516
## VacancyIndex -0.353590009 -0.076339971  0.2009100658
## attr(,"label")
## [1] "Coefficients:"
## 
##  Correlation structure:
##         lower      est.     upper
## Phi 0.5284235 0.9572093 0.9969063
## attr(,"label")
## [1] "Correlation structure:"
## 
##  Residual standard error:
##      lower       est.      upper 
## 0.06868792 0.23774259 0.82287451

R output on page 323 (bottom)

g <- lm(InterestRate~LoansClosed+VacancyIndex,data=BayArea)
rho <- 0.9572093
x <- model.matrix(g)
Sigma <- diag(length(InterestRate))
Sigma <- rho^abs(row(Sigma)-col(Sigma))
sm <- chol(Sigma)
smi <- solve(t(sm))
xstar <- smi %*% x
ystar <- smi %*% InterestRate
m1tls <- lm(ystar ~ xstar-1) 
summary(m1tls)

## 
## Call:
## lm(formula = ystar ~ xstar - 1)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.27439 -0.12946  0.00934  0.25772  0.52132 
## 
## Coefficients:
##                    Estimate Std. Error t value Pr(>|t|)    
## xstar(Intercept)   7.122990   0.418207  17.032 1.12e-11 ***
## xstarLoansClosed  -0.003432   0.001194  -2.874    0.011 *  
## xstarVacancyIndex -0.076340   0.130784  -0.584    0.568    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.2591 on 16 degrees of freedom
## Multiple R-squared:  0.9831, Adjusted R-squared:  0.9799 
## F-statistic: 309.8 on 3 and 16 DF,  p-value: 2.227e-14

Figure 9.14 on page 324

par(mfrow=c(2,2))
plot(xstar[,1],ystar,xlab="Intercept*",ylab="InterestRate*")

plot(xstar[,2],ystar,xlab="LoansClosed*",ylab="InterestRate*")

plot(xstar[,3],ystar,xlab="VacancyIndex*",ylab="InterestRate*")

plot(xstar[,2],xstar[,3],xlab="LoansClosed*",ylab="VacancyIndex*")

Figure 9.15 on page 325

StanRes1 <- rstandard(m1tls)
par(mfrow=c(2,2))

acf(StanRes1,main="Standardized LSResiduals")

plot(xstar[,2],StanRes1,ylab="Standardized LS Residuals",xlab="LoansClosed*")

plot(xstar[,3],StanRes1,ylab="Standardized LS Residuals",xlab="VacancyIndex*")

plot(m1tls$fitted.values,StanRes1,ylab="Standardized Residuals",xlab="Fitted Values*")

detach(BayArea)