Method 1: Time Naive Approach (most recent value method)

Question 1: Consider the following time series data. Using the naive method (most recent value) as the forecast for the next week, compute the following measures of forecast accuracy. a. Mean absolute error. b. Mean squared error. c. Mean absolute percentage error. d. What is the forecast for week 7?

##Week 1 2 3 4 5 6 ## Value 17 13 15 11 17 14

Step 1: Establish our Value

# Time Series Data
week <- 1:6 # independant variable
values <- c(17, 13, 15, 11, 17, 14) # dependant variable

Step 2: Most Recet Value as Forecast

forecast <- values[-length(values)]
actual <- values[-1]

Step 3: Calculate Meaan Absolute Error

mae <- mean(abs(actual - forecast))
mae

## [1] 3.8

Step 4: Calculate Mean Squared Error

mse <- mean((actual - forecast)^2)
mse

## [1] 16.2

Step 5: Calculate Mean Absolute Percentage Error

errors <- (abs(actual - forecast) / actual) * 100
mape <- mean(errors)
mape

## [1] 27.43778

Step 6: Forecast the Values for Week 7

forcast_week7 <- tail(values, 1)
forcast_week7

## [1] 14

Method 2: Moving Average and Exponential Smoothing

Queston 2:The values of Alabama building contracts (in $ millions) for a 12-month period is as follows: 240, 352, 230, 260, 280, 322, 220, 310, 240, 310, 240, 230. Use this data to answer question 2A and 2B below. A) Construct a time series plot. What type of pattern exists in the data? Upload a screenshot of your time series plot. B) Compare the three-month moving average approach with the exponential smoothing forecast using alpha = 0.2. Which provides more accurate forecasts based on MSE?

Step 1: Install & Library Packages

library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(zoo)

## Warning: package 'zoo' was built under R version 4.4.2

## 
## Attaching package: 'zoo'

## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric

Step 2: Establish our Values

# Time Series Data #

df <- data.frame(month = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12),
                 mdollars = c(240, 352, 230, 260, 280, 322, 220, 310, 240, 310, 240, 230))

Step 3: Descriptive Statistics

summary(df)

##      month          mdollars    
##  Min.   : 1.00   Min.   :220.0  
##  1st Qu.: 3.75   1st Qu.:237.5  
##  Median : 6.50   Median :250.0  
##  Mean   : 6.50   Mean   :269.5  
##  3rd Qu.: 9.25   3rd Qu.:310.0  
##  Max.   :12.00   Max.   :352.0

Step 4: Create Time Series Plot

plot(df$month, df$mdollars, type = "o", col = "red", xlab = "Month", ylab =
       "Millions of Dollars", main = "Alabama Building Contracts")

## Interpretation

The Time Series Plot exhibits a horizontal Pattern around the mean.

PART A: Moving Average

Step 1: Calculate the 3-Month Moving Average

df$avg_mdollars3 <- c(NA, NA, NA,
                      (df$mdollars[1] + df$mdollars[2] + df$mdollars[3])/3,
                      (df$mdollars[2] + df$mdollars[3] + df$mdollars[4])/3,
                      (df$mdollars[3] + df$mdollars[4] + df$mdollars[5])/3,
                      (df$mdollars[4] + df$mdollars[5] + df$mdollars[6])/3,
                      (df$mdollars[5] + df$mdollars[6] + df$mdollars[7])/3,
                      (df$mdollars[6] + df$mdollars[7] + df$mdollars[8])/3,
                      (df$mdollars[7] + df$mdollars[8] + df$mdollars[9])/3,
                      (df$mdollars[8] + df$mdollars[9] + df$mdollars[10])/3,
                      (df$mdollars[9] + df$mdollars[10] + df$mdollars[11])/3)

Step 2: Calculate the Squared Errors (only for months where the moving avergae is available)

df <- df %>%
  mutate(
    squared_error = ifelse(is.na(avg_mdollars3), NA, (mdollars - avg_mdollars3)^2)
  )

Step 3: Compute MSE (excluding the initial months)

mse <- mean(df$squared_error, na.rm = TRUE)
mse # Our MSE is 2040.44

## [1] 2040.444

PART B: Exponential Smoothing Approach

Step 1: Construct Function (using the same variables)

alpha <- 0.2
exp_smooth <- rep(NA, length(df$mdollars))
exp_smooth[1] <- df$mdollars[1]

for(i in 2: length(df$mdollars)) {
  exp_smooth[i] <-alpha * df$mdollars[i-1] + (1-alpha) * exp_smooth[i-1]
}
mse_exp_smooth <- mean((df$mdollars[2:12] - exp_smooth[2:12])^2)
mse_exp_smooth #Output for MSE is 2593.76

## [1] 2593.762

Step 2: Comparison

better_method <- ifelse(mse < mse_exp_smooth, "Three Month Moving Average", "Exponential Smoothing")

Results

list(
  MSE_Moving_Average = mse,
  MSE_Exponential_Smoothing = mse_exp_smooth,
  Better_Method = better_method
)

## $MSE_Moving_Average
## [1] 2040.444
## 
## $MSE_Exponential_Smoothing
## [1] 2593.762
## 
## $Better_Method
## [1] "Three Month Moving Average"

Method 3: Linear Trend Approach

Question 3: The following data shows the average interest rate (%) for a 30-year fixed-rate mortgage over a 20-year period (FreddieMac website). Construct a time series plot. What type of pattern exists in the data? Develop the linear trend equation for this time series. Using the linear trend equation from question 3B, forecast the average interest rate for period 25 (i.e., 2024).

Step 1: Library Packages and Load Data

library("readxl")
library(ggplot2)

df2 <- read_excel(file.choose())

Step 2: Descriptive Statistics

summary(df2)

##       Year                         Period           Rate      
##  Min.   :2000-01-01 00:00:00   Min.   : 1.00   Min.   :2.958  
##  1st Qu.:2005-10-01 18:00:00   1st Qu.: 6.75   1st Qu.:3.966  
##  Median :2011-07-02 12:00:00   Median :12.50   Median :4.863  
##  Mean   :2011-07-02 18:00:00   Mean   :12.50   Mean   :5.084  
##  3rd Qu.:2017-04-02 06:00:00   3rd Qu.:18.25   3rd Qu.:6.105  
##  Max.   :2023-01-01 00:00:00   Max.   :24.00   Max.   :8.053

Step 3: Develop Time Series Plot

ggplot(df2, aes(x = Period, y = Rate)) +
  geom_line() +
  geom_point() +
  xlab("Period") +
  ylab("Interest Rate") +
  ggtitle("Time Series Morgage Interest Rate Yearly")

## Interpretation

We observe a decreasing pattern in the Time Series Trend as seen in the plot

Step 4: Develop a Linear Tread Equation

model <- lm(Rate ~ Period, data = df2)
summary(model)

## 
## Call:
## lm(formula = Rate ~ Period, data = df2)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.3622 -0.7212 -0.2823  0.5015  3.1847 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  6.69541    0.43776  15.295 3.32e-13 ***
## Period      -0.12890    0.03064  -4.207 0.000364 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.039 on 22 degrees of freedom
## Multiple R-squared:  0.4459, Adjusted R-squared:  0.4207 
## F-statistic:  17.7 on 1 and 22 DF,  p-value: 0.0003637

Results

Regression Model: 6.70 + (-0.13)*Period
R-Squared: 0.45
The Overall Model is Significant as p-value (0.00) is less than 0.05

Step 5: Find the MSE and MAPE

df2$Predicted_Rate <- predict(model)

Step 6: Calculate the Residuals

df2$Residuals <- df2$Rate - df2$Predicted_Rate

Step 7: Calculate Mean-Squared Error

mse2 <- mean(df2$Residuals^2)
cat("Mean Squared Error (MSE):", mse2, "\n")

## Mean Squared Error (MSE): 0.989475

Step 8: Calculate Mean Absolute Percentage Error

df2$Percentage_Error <- abs(df2$Residuals / df2$Rate) * 100
mape2 <- mean(df2$Percentage_Error)
cat("Mean Absolute Percentage Error (MAPE):", mape2, "%\n")

## Mean Absolute Percentage Error (MAPE): 15.79088 %

Step 9: Forecast Interest Rate in Year 2025

forecast_period_25 <- predict(model, newdata = data.frame(Period = 25))
forecast_period_25

##        1 
## 3.472942

Result

In year 2025 the Mortgage Interest Rate will increase by 3.47.