sanketgadhave
commented
4 months ago # homework 2
# Handling the Covid period. (2020 - 2022 2 years) by moving average
library(fredr)
#> Warning: package 'fredr' was built under R version 4.2.3
library(forecast)
#> Warning: package 'forecast' was built under R version 4.2.3
#> Registered S3 method overwritten by 'quantmod':
#> method from
#> as.zoo.data.frame zoo
library(dygraphs)
#> Warning: package 'dygraphs' was built under R version 4.2.3
library(xts)
#> Warning: package 'xts' was built under R version 4.2.3
#> Loading required package: zoo
#> Warning: package 'zoo' was built under R version 4.2.3
#>
#> Attaching package: 'zoo'
#> The following objects are masked from 'package:base':
#>
#> as.Date, as.Date.numeric
library(ggplot2)
#> Warning: package 'ggplot2' was built under R version 4.2.3
library(forecast)
library(reprex)
#> Warning: package 'reprex' was built under R version 4.2.3
fredr_set_key("052142bc981666b4ebcb1c8df98d006b")
# Reading the data
icnsa = fredr(series_id = "ICNSA")
column_names <- colnames(icnsa)
print(column_names)
#> [1] "date" "series_id" "value" "realtime_start"
#> [5] "realtime_end"
# Converting the date to date data type
icnsa$date <- as.Date(icnsa$date)
window_size <- 52 # a 52-week (1 year) moving average
icnsa$smoothed_value <- zoo::rollmean(icnsa$value, k = window_size, fill = NA)
# Plot the smoothed data
ggplot(icnsa, aes(x = date, y = smoothed_value)) +
geom_line() +
labs(title = "Smoothed Unemployment Numbers Over Time", x = "Date", y = "Smoothed Unemployment Numbers") +
theme_minimal()
#> Warning: Removed 51 rows containing missing values (`geom_line()`).
# Plotting the Autocorrelation Function
Acf(icnsa$value, main = "ACF of Unemployment Numbers")
# Plotting the Partial Autocorrelation Function
Pacf(icnsa$value, main = "PACF of Unemployment Numbers")
# Fitting the new arima model with smoothed data
updated_model <- auto.arima(icnsa$smoothed_value)
summary(updated_model)
#> Series: icnsa$smoothed_value
#> ARIMA(1,1,3)
#>
#> Coefficients:
#> ar1 ma1 ma2 ma3
#> 0.8521 0.7171 0.1644 -0.0587
#> s.e. 0.0134 0.0232 0.0303 0.0223
#>
#> sigma^2 = 3670877: log likelihood = -26274.86
#> AIC=52559.71 AICc=52559.73 BIC=52589.62
#>
#> Training set error measures:
#> ME RMSE MAE MPE MAPE MASE
#> Training set -0.1090695 1914.317 756.916 0.01319981 0.2107156 0.4144923
#> ACF1
#> Training set 0.0005282674
# Get the last forecasted date from data.
last_date <- max(icnsa$date)
print(last_date)
#> [1] "2024-02-03"
# As it is a weekly data next forecast would be for 2024-02-10
forecast_date <- as.Date("2024-02-10")
# Calculate the difference in weeks
weeks_between <- as.numeric(difftime(forecast_date, last_date, units = "weeks"))
# Since we're working with weekly data, round up any fractional weeks to the nearest whole number
forecast_horizon <- ceiling(weeks_between)
print(paste("Last date in dataset:", last_date))
#> [1] "Last date in dataset: 2024-02-03"
print(paste("Forecast horizon (weeks):", forecast_horizon))
#> [1] "Forecast horizon (weeks): 1"
# Forecasting for the same peroid but now with smoothed data
forecast_result_updated <- forecast(updated_model, h = forecast_horizon)
forecast_mean_updated <- mean(forecast_result_updated$mean, na.rm = TRUE)
print(forecast_mean_updated)
#> [1] 219972.3Created on 2024-02-09 with reprex v2.1.0
- Forecasted value after smoothing the Covid data: 219972.3
Created on 2024-02-09 with reprex v2.1.0