Forecast weekdays time series data

Question

I have time-series data from 2002-11-01 to 2019-12-24 excluding weekends and holiday and I want to forecast upcoming values based on this data. I want to forecast value for only weekdays, while not considering weekends. I don't know which model will be applicable to this forecasting.

I was unable to put the whole data. But for other years values are similar to these.

Answer 1

Here's a quick and dirty way of producing the forecast:

# Vector of packages required in session:  necessary_packages => character vector
necessary_packages <- c("forecast", "ggplot2")

# Create a vector containing the names of any packages needing installation:
# new_pacakges => character vector
new_packages <- 
  necessary_packages[!(necessary_packages %in% installed.packages()[, "Package"])]

# If the vector has more than 0 values, install the new pacakges
# (and their associated dependencies): stdout
if(length(new_packages) > 0){install.packages(new_packages, dependencies = TRUE)}

# Initialise the packages in the session: stdout => list of booleans
lapply(necessary_packages, require, character.only = TRUE)

# Nullify outliers in the data.frame: out_free_df => data.frame
out_free_df <- within(df, {
  Price <- sapply(df$Price, function(x){
       ifelse(x %in% boxplot.stats(df$Price)$out, NA, x)
      }
    )
  }
)

# Interpolate the Nullified values: prices => numeric vector
interped_df <- within(out_free_df, {
    Price <- ifelse(
      is.na(out_free_df$Price),
      approx(out_free_df$Price, n = nrow(df), 
             method = "linear")$y[which(is.na(out_free_df$Price))],
      out_free_df$Price
    )
  }
)

# Difference the logged prices: ldp => timeseries obj
ldp <- diff(log(msts(interped_df$Price, seasonal.periods = c(5, (365.25 * (5/7))))))

# Look at the seasonality of the prices: stdout => graphics
ggseasonplot(ldp, polar = TRUE)

# Look at a line chart of the the prices: stdout => graphics
autoplot(ldp)

# Plot the auto-correlation function: stdout => graphics 
ggAcf(ldp)

# No. of diffs required to make series stationary: n_diffs => numeric vector
n_diffs <- ndiffs(ldp, alpha = 0.05, "kpss")

# Function to produce the forecast: forecast_func => function
forecast_func <- function(fcast_vec, n_ahead, include_weekends = TRUE){

  # Extend n_ahead to compensate for weekends: n_ahead => numeric vector
  n_steps <-
    ifelse(include_weekends, n_ahead, (n_ahead + ceiling((n_ahead / 7) * 2)))

  # Store a scalar to adjust for daily seasonality dependent upon whether
  # weekends are included or not: daily_seas => numeric vector
  daily_seas <- ifelse(include_weekends, 7, 5)

  # Store a scalar to adjust for yearly seasonality dependent upon whether
  # weekends are included or not: yearly_seas => numeric vector:
  yearly_seas <- ifelse(include_weekends, 365.25, (365.25 * (5 / 7)))

  # Lock pseudo-randon number generator: set.seed(2020) => .GlobalEnv
  set.seed(2020)

  # Cast the forecast vector to a time-series object with 5 daily
  # and yearly seasonality: fcast_vec => ts object
  fcast_ts <-
    msts(fcast_vec,
         seasonal.periods = ifelse(
           length(fcast_vec) > yearly_seas,
           daily_seas,
           c(daily_seas, yearly_seas)
         ))

  # Store a function to caclulate the RMSE: rmse => function 
  rmse <- function(actual_vec, pred_vec){sqrt(mean((pred_vec - actual_vec)**2))}

  # Fit an ets model: fit_ets => list
  fit_ets <- ets(fcast_ts)

  # Fit a holt-winters additive forecast: fit_hwa => list
  fit_hwa <- hw(fcast_ts, seasonal = "additive")

  # Fit a tbats model: fit_tbt => list
  fit_tbt <- tbats(fcast_ts)

  # Fit an auto.arima model: fit_arm => list
  fit_arm <- auto.arima(fcast_ts)

  # Fit a neural network model: fit_nn => list 
  fit_nn <- nnetar(fcast_ts, maxit = 150)

  # Store the fit objects in a list: fit_list => list
  fit_list <- list(fit_ets, fit_hwa, fit_tbt, fit_arm, fit_nn)

  # Select the best model: fcast_fit => list
  fcast_fit <- 
    fit_list[[which.min(sapply(fit_list, function(x){rmse(fcast_ts, x$fitted)}))]]

  # Produce the forecast n steps ahead: forecasted_raw => data.frame  
  forecasted_raw <- data.frame(forecast(fcast_fit, h = n_steps))

  # Clean up column names of the forecast: forecasted_df => data.frame 
  forecasted_df <- 
    setNames(forecasted_raw, gsub("\\s+|[.]", "_", tolower(names(forecasted_raw))))

  # Define the return object: forecasted_df => .GlobalEnv
  return(forecasted_df)
}

# Store a vector time_steps to forecast ahead: n => numeric vector
n <- 30

# Store a boolean scalar to determine whether or not weekends are considered: 
# iw => boolean
iw <- FALSE

# Apply the function to differenced, logged prices: intermediat_res => data.frame
intermediate_res <- forecast_func(c(0, diff(log(interped_df$Price))), n, 
                                  include_weekends = iw)

# Append the forecasted prices to the data.frame: df_w_fcast => data.frame
df_w_fcast <- rbind(
  transform(df, Type = "actuals"),
  data.frame(
    Date = c(seq.Date(max(df$Date)+1, as.Date(ifelse(iw, (max(df$Date) + n), 
                            (max(df$Date) + (n + ceiling((n/7) * 2)))),
             "%Y-%m-%d", origin = as.Date("1970-01-01", "%Y-%m-%d")), 1)),
    Price = exp(cumsum(
      c((intermediate_res$point_forecast[1] + log(df$Price[nrow(df)])),
        intermediate_res$point_forecast[2:nrow(intermediate_res)]))),
    Type = "forecast"
  )
)

# Get the indexes of records we want to exclude: rm_idx => numeric vector
rm_idx <- if(!(iw)){which(weekdays(df_w_fcast$Date) %in% c("Saturday", "Sunday"))}

# Subset out weekends: w_e_free_fcast => data.frame
w_e_free_fcast <- if(!is.null(rm_idx)){df_w_fcast[-rm_idx,]}else{df_w_fcast}

# Chart it using ggplot2: list => stoudt (graphics device) 
ggplot(w_e_free_fcast, aes(x = Date, y = Price, group = Type, colour = Type)) +
  geom_line()