Class Exercise 16: Time Series Forecasting
Q1 Naive Approach
week <- 1:6
sales <- c(17,13,15,11,17,14)
forecast_a <- sales[-length(sales)]
actual_a <- sales[-1]
mse_a <- mean((actual_a - forecast_a)^2)
mse_a## [1] 16.2mae_a <- mean(abs(actual_a - forecast_a))
mae_a## [1] 3.8mape_a <- mean(abs((actual_a - forecast_a) / actual_a) * 100)
mape_a## [1] 27.43778forecast_week7_a <- tail(sales, 1)
forecast_week7_a## [1] 14Q2 Smoothing Approach
Part A
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, unionlibrary(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.numericdf <- 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))summary(df)## month data
## 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#Interpretation: The average contract value over the 12 month period is 269.5 million USDplot(df$month, df$data, type = "o", col = "blue" , xlab = "Month", ylab= "Contract Value in Millions USD", main = "Alabama Building Contracts")
Part B
df$avg_data3 <- 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
)
df <- df %>%
mutate(
squared_error = ifelse(is.na(avg_data3), NA , (data - avg_data3)^2)
)
mse <- mean(df$squared_error, na.rm = TRUE)
mse #2040.44## [1] 2040.444alpha <- 0.2
exp_smooth <- rep(NA, length(df$data))
exp_smooth[1] <- df$data[1]
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 #Output the MSE = 2536.44## [1] 2593.762better_method <- ifelse(mse < mse_exp_smooth, "Three-Month Moving Average", "Exponential Smoothing")
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"Q3,4,5: Linear Trend Approach
Q3 - Time Series Plot
library(readxl)
library(ggplot2)
df_3 <- read_excel(file.choose())
df_3## # A tibble: 24 × 3
## Year Period Interest_Rate
## <dttm> <dbl> <dbl>
## 1 2000-01-01 00:00:00 1 8.05
## 2 2001-01-01 00:00:00 2 6.97
## 3 2002-01-01 00:00:00 3 6.54
## 4 2003-01-01 00:00:00 4 5.83
## 5 2004-01-01 00:00:00 5 5.84
## 6 2005-01-01 00:00:00 6 5.87
## 7 2006-01-01 00:00:00 7 6.41
## 8 2007-01-01 00:00:00 8 6.34
## 9 2008-01-01 00:00:00 9 6.03
## 10 2009-01-01 00:00:00 10 5.04
## # ℹ 14 more rowsdf_3 <- subset(df_3, select = -c(Year))
head(df_3)## # A tibble: 6 × 2
## Period Interest_Rate
## <dbl> <dbl>
## 1 1 8.05
## 2 2 6.97
## 3 3 6.54
## 4 4 5.83
## 5 5 5.84
## 6 6 5.87summary(df_3) #interpretation: Average 30 year mortgage interest rate over 20 years was 5.08%## Period Interest_Rate
## Min. : 1.00 Min. :2.958
## 1st Qu.: 6.75 1st Qu.:3.966
## Median :12.50 Median :4.863
## Mean :12.50 Mean :5.084
## 3rd Qu.:18.25 3rd Qu.:6.105
## Max. :24.00 Max. :8.053ggplot(df_3, aes(x = df_3$Period, y= df_3$Interest_Rate))+
geom_line()+
geom_point()+
xlab("Period")+
ylab("Interest Rate")+
ggtitle("Time Series Plot for 30 Year Fixed-Mortgage Rate Over 20-year Period")## Warning: Use of `df_3$Period` is discouraged.
## ℹ Use `Period` instead.## Warning: Use of `df_3$Interest_Rate` is discouraged.
## ℹ Use `Interest_Rate` instead.## Warning: Use of `df_3$Period` is discouraged.
## ℹ Use `Period` instead.## Warning: Use of `df_3$Interest_Rate` is discouraged.
## ℹ Use `Interest_Rate` instead.
Interpretation: The Time Series plot shows a negative trend until year 22 of the mortgage. Q4 - Linear trend equation and significance
model <- lm(df_3$Interest_Rate ~ df_3$Period, data = df_3)
summary(model)Q5 - Forecast for year 25
Forecast for year 25 = 3.45% interest rate