Time series data

Project Objective

Using the Naive Approach, Smoothing Apporach, and Linear Trend Approach for Time Series Forecasting

Question 1: Compute measures of forecast accuracy using the naive method

Step 1: Load the data

#Time Series Data
#This is the independent variable - time
week <- 1:6 #This is the independent variable - time
sales <- c(17,13,15,11,17,14)

Step 2: Compute the values based on the data

#Part A. Most Recent Value as Forecast 
forecast_a <- sales[-length(sales)] #Exclude the last value
actual_a <- sales[-1] #Exclude the first sale
mse_a <- mean((actual_a - forecast_a)^2)
mse_a <- mean((actual_a - forecast_a)^2)
mse_a #Mean Squared Error is 16.2

## [1] 16.2

#Forecast the sales for week 7
forecast_week7_a <- tail(sales, 1)
forecast_week7_a

## [1] 14

#Interpretation: The sale value for week 7 is projected to be 14

Question 2: Use the smoothing approach to create a time series plot and use the three month moving approach

#Load the libraries
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

# Times Series Data

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

Step 2: Create a time series plot and calculate the MSE

plot(df$month, df$ContractValues, type = "o", col = "blue", xlab = "Month", ylab = "ContractValues", 
     main = "Alabama building contract Values")

#Interpretation: The time series plot shows the contract values rapidly increasing and declining over the 12 month period"
 
#Manually calculate the Three-Week Moving Average
df$avg_ContractValues3<- c(NA, NA, NA, 
                           (df$ContractValues[1] + df$ContractValues[2] + df$ContractValues[3]) / 3,
                           (df$ContractValues[2] + df$ContractValues[3] + df$ContractValues[4]) / 3,
                           (df$ContractValues[3] + df$ContractValues[4] + df$ContractValues[5]) / 3,
                           (df$ContractValues[4] + df$ContractValues[5] + df$ContractValues[6]) / 3,
                           (df$ContractValues[5] + df$ContractValues[6] + df$ContractValues[7]) / 3,
                           (df$ContractValues[6] + df$ContractValues[7] + df$ContractValues[8]) / 3,
                           (df$ContractValues[7] + df$ContractValues[8] + df$ContractValues[9]) / 3,
                           (df$ContractValues[8] + df$ContractValues[9] + df$ContractValues[10]) / 3,
                           (df$ContractValues[9] + df$ContractValues[10] + df$ContractValues[11]) / 3
                           )
                          
df <- df %>%
  mutate( 
    squared_error = ifelse(is.na(avg_ContractValues3), NA, (ContractValues - avg_ContractValues3)^2)
  )

# Compute MSE (excluding the initial weeks NA)
mse <- mean(df$squared_error, na.rm = TRUE)
mse #Output the MSE = 2040.44

## [1] 2040.444

###Step 3: Use the exponential smoothing forecast with alpha =0.2 and compare forecasts with the three month moving average approach

# Part B. Exponential Smoothing
# Note: We're using the same data set

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

## [1] 2593.762

# Comparison 
better_method <- ifelse(mse < mse_exp_smooth, "Three-Month Contract Value 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 Contract Value Average"

###Questions 3-5: Use the Linear Trend Approach to analyze data for a 30 year fixed rate mortgage over a 20 year period.

##Question 3: Construct a time series plot and analyze the pattern

#load the libraries
library(ggplot2)
library(readxl)

#Descriptive Statistics
#summary(Mortgage)
# On average the mortgage is 5.084

# Construct a time series plot
#ggplot(Mortgage, aes(x = Period, y = Interest_Rate)) +
#  geom_line() + 
#  geom_point() + 
#  xlab("Period") + 
# ylab("Interest_Rate") + 
#  ggtitle("Time Series Plot of Plumbing Repair Jobs")

# Interpretation: We observe an decreasing trend or pattern in the data, and then an increase at the final years in the period.

##Question 4: Develop the linear trend equation for this time series

#Develop a linear trend equation
#model <- lm(Interest_Rate ~ Period, data = Mortgage)
#summary(model)

# Result - estimated linear trend equation: Interest_Rate = 6.70 - 0.13*Period or
# T_hat = 6.70 - 0.13*t
# The R-square is 0.45(Moderately fits the data)
# The overall model is significant as p-value <0.05 

##Question 5: Use the linear trend equation to forecast the average interest rate for period 25

#Mortgage$predicted_Interest_Rate <- predict(model)

# Calculate the residuals
#Mortgage$residuals <- Mortgage$Interest_Rate - Mortgage$predicted_Interest_Rate

#Calculate the Mean Squared Error (MSE)
#mse <- mean(Mortgage$residuals^2)
#cat("Mean Squared Error(MSE):", mse, "\n")

#Bonus Section: Calculate Mean Absolute Percentage Error (MAPE)
#Mortgage$percentage_error <- abs(Mortgage$residuals / Mortgage$Interest_Rate) *100
#mape <- mean(Mortgage$percentage_error)
#cat("Mean Absolute Percentage Error (MAPE):", mape, "%n")
 
#Forecast the number of jobs in period 25
#forecast_period_25 <- predict(model,newdata = data.frame(Period = 25))
#forecast_period_25