Time Series Data Analysis
Project Objective
Understanding forecasting methods and accuracy metrics, analyzing patterns in time series data, and applying trend analysis to reach insightful conclusions about data.Question 1: Naive Approach
Time series data
week <- 1:6 #independent variable - time
values <- c(17,13,15,11,17,14) #dependent variablePart A: Most recent value as a forecast
forecast_a <- values[-length(values)] #Excludes last value
actual_a <- values[-1] #Exclude the first valueFind Mean Absolute Error (MAE)
mae_a <- mean(abs(actual_a - forecast_a)) # Use abs() for absolute differences
mae_a #MAE is 3.8## [1] 3.8Find Mean Squared Error (MSE)
mse_a <- mean((actual_a - forecast_a)^2)
mse_a #MSE is 16.2## [1] 16.2Find Mean Absolute Percentage Error (MAPE)
mape_a <- mean(abs((actual_a - forecast_a) / actual_a)) * 100
mape_a # MAPE is 27.44## [1] 27.43778Calculate forecast values for week 7
forecast_week7_a <- tail(values, 1)
forecast_week7_a## [1] 14Interpretation: The projected value for week 7 is 14.Question 2: Moving Average and Exponential Smoothing Approach
Alabama Building Contracts
Part A: Moving Average
#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, unionlibrary(zoo)##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericImport data
df <- data.frame(month=c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12),
contracts=c(240,352,230,260,280,322,220,310,240,310,240,230))Identify descriptive statistics
summary(df)## month contracts
## 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.0Interpretation: The average contract value over a 12 month period is $269.5 million.Create time series plot
plot(df$month, df$contracts, type = "o", col = "blue", xlab = "Month", ylab = "Contracts",
main = "Alabama Building Contracts Plot")
# The time series plot exhibits a random variationManually calculate the three-month moving average
# Calculate the three-month moving average manually
df$avg_contracts3 <- c(NA, NA,
(df$contracts[1] + df$contracts[2] + df$contracts[3]) / 3,
(df$contracts[2] + df$contracts[3] + df$contracts[4]) / 3,
(df$contracts[3] + df$contracts[4] + df$contracts[5]) / 3,
(df$contracts[4] + df$contracts[5] + df$contracts[6]) / 3,
(df$contracts[5] + df$contracts[6] + df$contracts[7]) / 3,
(df$contracts[6] + df$contracts[7] + df$contracts[8]) / 3,
(df$contracts[7] + df$contracts[8] + df$contracts[9]) / 3,
(df$contracts[8] + df$contracts[9] + df$contracts[10]) / 3,
(df$contracts[9] + df$contracts[10] + df$contracts[11]) / 3,
(df$contracts[10] + df$contracts[11] + df$contracts[12]) / 3
)Calculate squared errors (For months where moving average is available)
df <- df %>%
mutate(
squared_error= ifelse(is.na(avg_contracts3), NA, (contracts - avg_contracts3)^2)
)Compute MSE (excluding initial months with NA values)
mse <- mean(df$squared_error, na.rm = TRUE)
mse #MSE is 2040.44## [1] 996.8Part B: Exponential smoothing
alpha <- 0.2
exp_smooth <- rep(NA, length(df$contracts))
exp_smooth[1] <- df$contracts[1] #starting point
for (i in 2: length(df$contracts)) {
exp_smooth[i] <- alpha * df$contracts[i-1] + (1 - alpha) * exp_smooth[i-1]
}
mse_exp_smooth <- mean((df$contracts[2:12] - exp_smooth[2:12])^2)
mse_exp_smooth #MSE is 2593.76## [1] 2593.762Compare the three-month moving average approach with the exponential smoothing approach to see which one is more accurate:
better_method <- ifelse(mse < mse_exp_smooth, "3 month moving average", "exponential smoothing")Conclusion
list(
MSE_Moving_Average = mse,
MSE_Exponential_Smoothing = mse_exp_smooth,
Better_Method = better_method
)## $MSE_Moving_Average
## [1] 996.8
##
## $MSE_Exponential_Smoothing
## [1] 2593.762
##
## $Better_Method
## [1] "3 month moving average"The three month moving average provides more accurate forecasts based on MSE.Question 3
30-Year Fixed-Rate Mortgage Interest Rates
Part A: Moving Average
library(readxl)
library(dplyr)
library(zoo)Import data from Mortgage.xlsx
file_path <- "/Users/amritahimmatraopet/Desktop/Mortgage.xlsx" # Replace with the actual path to the file
df <- read_excel(file_path)Display the first few rows to confirm data was imported correctly
head(df)## # 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.87Identify descriptive statistics
summary(df)## Year Period Interest_Rate
## Min. :2000-01-01 00:00:00 Min. : 1.00 Min. :2.958
## 1st Qu.:2005-10-01 18:00:00 1st Qu.: 6.75 1st Qu.:3.966
## Median :2011-07-02 12:00:00 Median :12.50 Median :4.863
## Mean :2011-07-02 18:00:00 Mean :12.50 Mean :5.084
## 3rd Qu.:2017-04-02 06:00:00 3rd Qu.:18.25 3rd Qu.:6.105
## Max. :2023-01-01 00:00:00 Max. :24.00 Max. :8.053Interpretation: the average contract value over a 12-month period is $269.5 million.Create time series plot
plot(df$Year, df$Interest_Rate, type = "o", col = "blue",
xlab = "Year", ylab = "Interest Rate (%)",
main = "30-Year Fixed-Rate Mortgage Interest Rates")
Perform linear regression
model <- lm(Interest_Rate ~ Year, data = df)
summary(model)##
## Call:
## lm(formula = Interest_Rate ~ Year, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.3624 -0.7212 -0.2824 0.5014 3.1846
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.043e+01 1.289e+00 8.094 4.86e-08 ***
## Year -4.085e-09 9.708e-10 -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.0003636Interpretation: Estimated linear trend equation: 6.70 - 0.13*Period
The R-Squared is 0.45 (Moderately fits the data)
The overall model is significant as p-value < 0.05.Forecast average interest rate for period 25
6.70 - 0.13*25 = 3.45
Interpretation: The average interest rate for period 25 is 3.45%.