Class Exercise 16

Question 1: Using the naive method (most recent value) as the forecast for the next week, compute the following measures of forecast accuracy

Naive Approach

weeks <- 1:6 
values <- c(17, 13, 15, 11, 17, 14)

# Part A: Most recent value as forecast
# Compute MSE using the most recent value as the forecast for the next period
forecasts_a <- values[-length(values)] # exclude the last value
actual_a <- values[-1] # Exclude the first value
mse_a <- mean((actual_a - forecasts_a)^2)
mse_a 

## [1] 16.2

MSE = 16.2

# Compute MAE
absolute_error <- abs(forecasts_a - actual_a)
mae <- mean(absolute_error)
print(mae)

## [1] 3.8

MAE = 3.8

# Step 2: Calculate the percentage error for each observation
percentage_error <- (absolute_error / actual_a) * 100

# Step 3: Calculate the mean of the absolute percentage errors
mean_absolute_percentage_error <- mean(percentage_error, na.rm = TRUE)

# Print the mean absolute percentage error
print(mean_absolute_percentage_error)

## [1] 27.43778

MAPE = 27.44

# Forecast for week 7

forecast_week_7_a <- mean(values) # average of all months as forecast for month 8
forecast_week_7_a 

## [1] 14.5

value = 14.5

Question 2: Construct time series plot

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)

## 
## Attaching package: 'zoo'

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

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

Part A: Time series plot

plot(df$month, df$data, type = "o", col = "blue", xlab = "Month", ylab = "Contract prices (in $ millions)",
     main = "Monthly Percentage of All Building Contracts")

# Interpretation: the time-series plot exhibits a horizontal pattern

Part B: Three-month moving average

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

# Calculate the square errors (only for the months where moving average is available)
df <- df %>%
  mutate(
    squared_error = ifelse(is.na(avg_contract), NA, (data - avg_contract)^2)
  )

# Compute MSE (excluding the initial months with NA)

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

## [1] 2040.444

Exponential smoothing

alpha = 0.2
exp_smooth <- rep(NA, length(df$data))
exp_smooth[1] <- df$data[1] # starting point
for(i in 2:length(df$data)) {
  exp_smooth[i] <- alpha * df$data[i-1] + (1 - alpha) * exp_smooth[i-1]
}
mse_exp_smooth <- mean((df$data[2:12] - exp_smooth[2:12])^2)
mse_exp_smooth # 2593.76

## [1] 2593.762

Question 3: Construct a Time Series Plot

library(readxl)

data <- read_excel("Mortgage.xlsx")

# Part A: Time series plot
plot(data$Period, data$Interest_Rate, type = "o", col = "blue", xlab = "Period", ylab = "Interest Rates",
     main = "Annual Percentage of All Mortgages")

Interpretation: the time-series plot exhibits a trend pattern (decreasing over time)

Question 4: Develop the linear trend equation

# Fit a linear regression model
model <- lm(Interest_Rate ~ Period, data = data)

# Extract coefficients
intercept <- coef(model)[1]
slope <- coef(model)[2]

# Print the equation of the linear trend
cat("Linear trend equation: y =", round(intercept, 2), "+", round(slope, 2), "* x\n")

## Linear trend equation: y = 6.7 + -0.13 * x

Linear trend equation: y = 6.7 + -0.13 * x

Question 5: Forecast the average interest rate for period 25

Interest_Rate = 25

# Time period for forecasting
period_25 <- 25

# Forecast the average interest rate for period 25 using the linear trend equation
forecast_interest_rate <- intercept + slope * period_25

# Print the forecasted average interest rate for period 25
cat("Forecasted average interest rate for period 25 (2024):", round(forecast_interest_rate, 2))

## Forecasted average interest rate for period 25 (2024): 3.47

 the average interest rate for period 25 = 3.47%