Class Exercise 16
Question 1: Naive Approach
Step 1: Time Series Data
week <- 1:6 #Independent variables - Time
value <- c(17, 13, 15, 11, 17, 14) #Dependent variable - Value
Step 2: Forecast and Actual
forecast <- value[-length(value)] #Exclude last value
actual <- value[-1] #Exclude last value
Step 3: Mean Absolute Error (Part A)
error <- actual - forecast
mae <- mean(abs(error))
mae
## [1] 3.8
mean absolute error is 3.8
Step 4: Mean Squared Error (Part B)
mse <- mean((actual - forecast)^2)
mse
## [1] 16.2
mean squared error is 16.2
Step 5: Mean Absolute Percentage Error (Part C)
mape <- mean(abs((actual - forecast)/ actual))* 100
mape
## [1] 27.43778
mean absolute percentage error is 27.44% (rounded up from 27.43778 to 2 decimals)
Step 6: Forecast for Week 7 (Part D)
forecast_week7 <- tail(value, 1)
forecast_week7
## [1] 14
Interpretation: The value number projected for value in week 7 is 14
Question 2: Smoothing Approach
Step 1: Install Packages / Load Libraries
#install.packages("dplyr")
#install.packages("zoo")
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: Import Data
df <- data.frame(month=c(1,2,3,4,5,6,7,8,9,10,11,12),
value=c(240, 352, 230, 260, 280, 322, 220, 310, 240, 310, 240, 230))
Step 3:Descriptive Statistics / Time Series Plot (Part A)
summary(df)
## month value
## 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
#Mean is 269.5 million for the building contract for the 12 months period
#Time Series Plot
plot(df$month, df$value, type = "o", col="brown", xlab= "Month",
ylab="Building contracts (in $ millions)",
main= "Alabama Building Contracts Plot")
Interpretation: The plot shows that the values are not steady at the mean of 269.5 as the values fluctuate around.
Step 4: Three-Month Moving Average Method
df$avg <- c(NA, NA, NA,
(df$value[1] + df$value[2] + df$value[3]) / 3,
(df$value[2] + df$value[3] + df$value[4]) / 3,
(df$value[3] + df$value[4] + df$value[5]) / 3,
(df$value[4] + df$value[5] + df$value[6]) / 3,
(df$value[5] + df$value[6] + df$value[7]) / 3,
(df$value[6] + df$value[7] + df$value[8]) / 3,
(df$value[7] + df$value[8] + df$value[9]) / 3,
(df$value[8] + df$value[9] + df$value[10]) / 3,
(df$value[9] + df$value[10] + df$value[11]) / 3
)
#Calculate the squared errors
df <- df %>%
mutate(squared_error = ifelse(is.na(avg), NA, (value - avg)^2))
#Compute MSE for Three-Month Moving Average
mse <- mean(df$squared_error, na.rm = TRUE)
mse
## [1] 2040.444
Output the MSE - 2040.44 (rounded from 2040.4444~ to 2 decimals)
Step 5: Exponential Smoothing Method
alpha <- 0.2
exp_smooth <- rep(NA, length(df$value))
exp_smooth[1] <- df$value[1] # Starting point
for(i in 2: length(df$value)) {
exp_smooth[i] <- alpha * df$value[i-1] + (1-alpha) * exp_smooth[i-1]}
mse_exp_smooth <- mean((df$value[2:12] - exp_smooth[2:12])^2)
mse_exp_smooth
## [1] 2593.762
Output the MSE - 2593.76 (rounded from 2593.7615 to 2 decimals)
Step 6: Comparison Between Three-Month Moving Average &
Exponential Smoothing (Part B)
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"
Interpretation: The better method here is the Three-Month Moving Average than the Exponential Smoothing method for this case.
Question 3: Linear Trend Approach
Step 1: Install Packages / Load Libraries
#install.packages("readxl")
#install.packages("ggplot2")
library(readxl)
library(ggplot2)
Step 2: Import Data / Time Series Plot (Part A)
mortgage_data <- read_excel(file.choose())
data <- subset(mortgage_data, select = -c(Year)) # eliminates Year column
ggplot(data, aes(x = Period, y = Interest_Rate)) +
geom_line() +
geom_point() +
xlab("Time Period") +
ylab("Interest Rate") +
ggtitle("Time Series Plot of Fixed Mortgage Rate")
Interpretation: This time series plot has a mostly negative pattern from period 1 to 22 with a few bumps of increase. However by the end of period 22, the pattern changes to increasing as it skyrockets up.
Step 3: Linear Trend Equation (Part B)
model <- lm(Interest_Rate ~ Period, data = data)
summary(model)
##
## Call:
## lm(formula = Interest_Rate ~ Period, data = data)
##
## 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
Interpretation: Mortage = 6.7 + -0.13*Period is the linear trend equation
Step 4: Forecast Period 25 (Part C)
forecast_period25 <- predict(model, newdata = data.frame(Period = 25))
forecast_period25
## 1
## 3.472942
Interpretation: The forecast for period 25 is ~3.47