Class Exercise 16
Question 1
Step 1: Insert data
weeks <- 1:6
values <- c(17, 13, 15, 11, 17, 14)Step 2: Naive method to forecast MAE, MSE, MAPE
naive_forecasts <- c(NA, values[1:5])
errors <- values - naive_forecasts
MAE <- mean(abs(errors[2:length(errors)]), na.rm = TRUE)
cat("Mean Absolute Error (MAE):", MAE, "\n")## Mean Absolute Error (MAE): 3.8MSE <- mean(errors[2:length(errors)]^2, na.rm = TRUE)
cat("Mean Squared Error (MSE):", MSE, "\n")## Mean Squared Error (MSE): 16.2MAPE <- mean(abs(errors[2:length(errors)]) / values[2:length(values)] * 100, na.rm = TRUE)
cat("Mean Absolute Percentage Error (MAPE):", MAPE, "%\n")## Mean Absolute Percentage Error (MAPE): 27.43778 %forecast_week7 <- values[6]
cat("Forecast for Week 7:", forecast_week7, "\n")## Forecast for Week 7: 14Using the naive forecasting method, the Mean Absolute Error (MAE) is 3.80, the Mean Squared Error (MSE) is 16.20, and the Mean Absolute Percentage Error (MAPE) is 27.44%. The forecast for Week 7 is 14.00. Question 2A
Step 1: Data and data frame
months <- 1:12
contracts <- c(240, 352, 230, 260, 280, 322, 220, 310, 240, 310, 240, 230)
data <- data.frame(Month = months, Contracts = contracts)Step 2: Time series plot
plot(data$Month, data$Contracts, type = "o", col = "blue", pch = 16,
xlab = "Month", ylab = "Contracts ($ Millions)",
main = "Time Series Plot of Alabama Building Contracts")
grid()
The data shows an irregular pattern with not a particular trend or seasonality.Question 2B
Step 1: Load libraries
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.numericStep 2: Three-month moving average approach with the exponential smoothing forecast using alpha = 0.2.
data$MA_3 <- rollmean(data$Contracts, k = 3, fill = NA, align = "right")
alpha <- 0.2
data$Exp_Smooth <- rep(NA, nrow(data))
data$Exp_Smooth[1] <- data$Contracts[1]
for (i in 2:nrow(data)) {
data$Exp_Smooth[i] <- alpha * data$Contracts[i - 1] + (1 - alpha) * data$Exp_Smooth[i - 1]
}
data$MA_Error <- data$Contracts - data$MA_3
data$Exp_Smooth_Error <- data$Contracts - data$Exp_Smooth
MSE_MA <- mean(data$MA_Error[!is.na(data$MA_Error)]^2)
MSE_Exp_Smooth <- mean(data$Exp_Smooth_Error[!is.na(data$Exp_Smooth_Error)]^2)
cat("MSE - Three-Month Moving Average:", round(MSE_MA, 2), "\n")## MSE - Three-Month Moving Average: 996.8cat("MSE - Exponential Smoothing:", round(MSE_Exp_Smooth, 2), "\n")## MSE - Exponential Smoothing: 2377.61MSE - Three-Month Moving Average: 996.80
MSE - Exponential Smoothing: 2377.61
The three-month moving average gives more accurate forecast based on the lower MSE since its value is lower.Question 3
Step 1: Load libraries
library(readxl)
library(ggplot2)Step 2: Load and check data
data <- read_excel("Mortgage.xlsx")
head(data)## # A tibble: 6 × 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.87Step 3: Time series plot
ggplot(data, aes(x = Year, y = Interest_Rate)) +
geom_line(color = "blue") +
geom_point(color = "red") +
labs(title = "Time Series Plot of Mortgage Interest Rates",
x = "Year", y = "Interest Rate (%)") +
theme_minimal()
The data shows a clear downward trend in interest rates from 2000 to 2020, followed by an increase starting in 2021. The rates became more volatile in 2020 and 2021, likely because of the economic impact of the COVID-19 pandemic.Question 4 and 5
Step 1: Load libraries
library(readxl)
library(ggplot2)Step 2: Load and check data
data <- read_excel("Mortgage.xlsx")
head(data)## # A tibble: 6 × 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.87Step 3: Linear regression equation
linear_trend_model <- lm(Interest_Rate ~ Period, data = data)
summary(linear_trend_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.0003637The linear trend equation for this time series is: Interest rate = 6.69 - 0.13*Period.The average interest rate for period 25 (i.e., 2024) is 3.44.