jlivsey / UB-sping24-time-series

2 stars 1 forks source link

Homework 2 ublearns #37

Closed Vasundharayerriboina closed 7 months ago

Vasundharayerriboina commented 7 months ago
library(fredr)
library(forecast)
#> Registered S3 method overwritten by 'quantmod':
#>   method            from
#>   as.zoo.data.frame zoo
library(tidyverse)
library(splines)
library(reprex)
#API key
fred_api_key <- "a0512c86722aa5efb0f73b0c42ab03c4"
fredr_set_key(fred_api_key)
# Function to fetch data from FRED API
icnsa_data <- fredr(series_id = "ICNSA")
icnsa_data <- fetch_fred_data("ICNSA")
#> Error in fetch_fred_data("ICNSA"): could not find function "fetch_fred_data"
head(icnsa_data)
#> # A tibble: 6 × 5
#>   date       series_id  value realtime_start realtime_end
#>   <date>     <chr>      <dbl> <date>         <date>      
#> 1 1967-01-07 ICNSA     346000 2024-02-28     2024-02-28  
#> 2 1967-01-14 ICNSA     334000 2024-02-28     2024-02-28  
#> 3 1967-01-21 ICNSA     277000 2024-02-28     2024-02-28  
#> 4 1967-01-28 ICNSA     252000 2024-02-28     2024-02-28  
#> 5 1967-02-04 ICNSA     274000 2024-02-28     2024-02-28  
#> 6 1967-02-11 ICNSA     276000 2024-02-28     2024-02-28
# Plotting ICNSA data to visually identify Covid pandemic times
plot(icnsa_data$date, icnsa_data$value, type = "l", xlab = "Date", ylab = "ICNSA", main = "Initial Claims (ICNSA)")

#start and end dates for Covid period
start_date <- as.Date("2020-03-01")
end_date <- as.Date("2021-07-31")
# Creating cubic spline model to impute values for the Covid period
covid_period <- icnsa_data %>%
  filter(date >= start_date & date <= end_date)
# Fit cubic( spline)
lambda <- 0.2
spline_fit <- smooth.spline(x = as.numeric(covid_period$date), y = covid_period$value, spar = lambda)
# Prediction of values for Covid period
imputed_values <- predict(spline_fit, x = as.numeric(covid_period$date))
# Plotting original data and the imputed values
plot(icnsa_data$date, icnsa_data$value, type = "l", xlab = "Date", ylab = "ICNSA", main = "Initial Claims (ICNSA) with Imputed Covid Values")
lines(covid_period$date, imputed_values$y, col = "red")
legend("topright", legend = c("Original", "Imputed"), col = c("black", "red"), lty = 1)

# here Converting we are converting  value column to numeric
icnsa_data$value <- as.numeric(icnsa_data$value)
# Combining  original and imputed data
imputed_data <- data.frame(date = covid_period$date, value = imputed_values$y)
combined_data <- bind_rows(icnsa_data %>% filter(date < start_date),
                           imputed_data,
                           icnsa_data %>% filter(date > end_date))

# now Converting  to time series
ts_data <- ts(combined_data$value, start = min(combined_data$date), frequency = 52)

# Fitting  multiplicative Holt-Winters model
hw_multiplicative <- HoltWinters(ts_data, seasonal = "multiplicative")
forecast_multiplicative <- forecast(hw_multiplicative, h = 1)
forecast_multiplicative
#>           Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
#> -1032.673       201438.8 74114.41 328763.2 6712.939 396164.7
# Fitting additive Holt-Winters model
hw_additive <- HoltWinters(ts_data, seasonal = "additive")
forecast_additive <- forecast(hw_additive, h = 1)
forecast_additive
#>           Point Forecast    Lo 80    Hi 80     Lo 95    Hi 95
#> -1032.673       161954.6 36845.02 287064.2 -29383.99 353293.2
# Point forecasts for both the models
point_forecast_multiplicative <- forecast_multiplicative$mean[[1]]
point_forecast_additive <- forecast_additive$mean[[1]]

cat("Point forecast using multiplicative Holt-Winters model:", point_forecast_multiplicative, "\n")
#> Point forecast using multiplicative Holt-Winters model: 201438.8
cat("Point forecast using additive Holt-Winters model:", point_forecast_additive, "\n")
#> Point forecast using additive Holt-Winters model: 161954.6

Created on 2024-02-28 with reprex v2.1.0