Forecast daily bike rental demand using time series models
Danyal Reyaz
2024-05-26
About Data Analysis Report
This RMarkdown file contains the report of the data analysis done for the project on forecasting daily bike rental demand using time series models in R. It contains analysis such as data exploration, summary statistics and building the time series models. The final report was completed on Sun May 26 11:36:00 2024.
Data Description:
This dataset contains the daily count of rental bike transactions between years 2011 and 2012 in Capital bikeshare system with the corresponding weather and seasonal information.
Data Source: https://archive.ics.uci.edu/ml/datasets/bike+sharing+dataset
Relevant Paper:
Fanaee-T, Hadi, and Gama, Joao, ‘Event labeling combining ensemble detectors and background knowledge’, Progress in Artificial Intelligence (2013): pp. 1-15, Springer Berlin Heidelberg
Task One: Load and explore the data
Load data and install packages
## Import required packages
# Install and load required packages
if (!require("pacman")) install.packages("pacman")## Loading required package: pacman## Warning: package 'pacman' was built under R version 4.3.3pacman::p_load(timetk, tidyverse, lubridate, ggplot2)
# Load the dataset
data("bike_sharing_daily")
bike_data <- bike_sharing_daily
# View the dataset
head(bike_data)## # A tibble: 6 × 16
## instant dteday season yr mnth holiday weekday workingday weathersit
## <dbl> <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 2011-01-01 1 0 1 0 6 0 2
## 2 2 2011-01-02 1 0 1 0 0 0 2
## 3 3 2011-01-03 1 0 1 0 1 1 1
## 4 4 2011-01-04 1 0 1 0 2 1 1
## 5 5 2011-01-05 1 0 1 0 3 1 1
## 6 6 2011-01-06 1 0 1 0 4 1 1
## # ℹ 7 more variables: temp <dbl>, atemp <dbl>, hum <dbl>, windspeed <dbl>,
## # casual <dbl>, registered <dbl>, cnt <dbl>str(bike_data)## spc_tbl_ [731 × 16] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ instant : num [1:731] 1 2 3 4 5 6 7 8 9 10 ...
## $ dteday : Date[1:731], format: "2011-01-01" "2011-01-02" ...
## $ season : num [1:731] 1 1 1 1 1 1 1 1 1 1 ...
## $ yr : num [1:731] 0 0 0 0 0 0 0 0 0 0 ...
## $ mnth : num [1:731] 1 1 1 1 1 1 1 1 1 1 ...
## $ holiday : num [1:731] 0 0 0 0 0 0 0 0 0 0 ...
## $ weekday : num [1:731] 6 0 1 2 3 4 5 6 0 1 ...
## $ workingday: num [1:731] 0 0 1 1 1 1 1 0 0 1 ...
## $ weathersit: num [1:731] 2 2 1 1 1 1 2 2 1 1 ...
## $ temp : num [1:731] 0.344 0.363 0.196 0.2 0.227 ...
## $ atemp : num [1:731] 0.364 0.354 0.189 0.212 0.229 ...
## $ hum : num [1:731] 0.806 0.696 0.437 0.59 0.437 ...
## $ windspeed : num [1:731] 0.16 0.249 0.248 0.16 0.187 ...
## $ casual : num [1:731] 331 131 120 108 82 88 148 68 54 41 ...
## $ registered: num [1:731] 654 670 1229 1454 1518 ...
## $ cnt : num [1:731] 985 801 1349 1562 1600 ...
## - attr(*, "spec")=
## .. cols(
## .. instant = col_double(),
## .. dteday = col_date(format = ""),
## .. season = col_double(),
## .. yr = col_double(),
## .. mnth = col_double(),
## .. holiday = col_double(),
## .. weekday = col_double(),
## .. workingday = col_double(),
## .. weathersit = col_double(),
## .. temp = col_double(),
## .. atemp = col_double(),
## .. hum = col_double(),
## .. windspeed = col_double(),
## .. casual = col_double(),
## .. registered = col_double(),
## .. cnt = col_double()
## .. )summary(bike_data)## instant dteday season yr
## Min. : 1.0 Min. :2011-01-01 Min. :1.000 Min. :0.0000
## 1st Qu.:183.5 1st Qu.:2011-07-02 1st Qu.:2.000 1st Qu.:0.0000
## Median :366.0 Median :2012-01-01 Median :3.000 Median :1.0000
## Mean :366.0 Mean :2012-01-01 Mean :2.497 Mean :0.5007
## 3rd Qu.:548.5 3rd Qu.:2012-07-01 3rd Qu.:3.000 3rd Qu.:1.0000
## Max. :731.0 Max. :2012-12-31 Max. :4.000 Max. :1.0000
## mnth holiday weekday workingday
## Min. : 1.00 Min. :0.00000 Min. :0.000 Min. :0.000
## 1st Qu.: 4.00 1st Qu.:0.00000 1st Qu.:1.000 1st Qu.:0.000
## Median : 7.00 Median :0.00000 Median :3.000 Median :1.000
## Mean : 6.52 Mean :0.02873 Mean :2.997 Mean :0.684
## 3rd Qu.:10.00 3rd Qu.:0.00000 3rd Qu.:5.000 3rd Qu.:1.000
## Max. :12.00 Max. :1.00000 Max. :6.000 Max. :1.000
## weathersit temp atemp hum
## Min. :1.000 Min. :0.05913 Min. :0.07907 Min. :0.0000
## 1st Qu.:1.000 1st Qu.:0.33708 1st Qu.:0.33784 1st Qu.:0.5200
## Median :1.000 Median :0.49833 Median :0.48673 Median :0.6267
## Mean :1.395 Mean :0.49538 Mean :0.47435 Mean :0.6279
## 3rd Qu.:2.000 3rd Qu.:0.65542 3rd Qu.:0.60860 3rd Qu.:0.7302
## Max. :3.000 Max. :0.86167 Max. :0.84090 Max. :0.9725
## windspeed casual registered cnt
## Min. :0.02239 Min. : 2.0 Min. : 20 Min. : 22
## 1st Qu.:0.13495 1st Qu.: 315.5 1st Qu.:2497 1st Qu.:3152
## Median :0.18097 Median : 713.0 Median :3662 Median :4548
## Mean :0.19049 Mean : 848.2 Mean :3656 Mean :4504
## 3rd Qu.:0.23321 3rd Qu.:1096.0 3rd Qu.:4776 3rd Qu.:5956
## Max. :0.50746 Max. :3410.0 Max. :6946 Max. :8714Describe and explore the data
# Convert the date column to Date type
bike_data$dteday <- as.Date(bike_data$dteday)
# Plot the rental counts over time
ggplot(bike_data, aes(x = dteday, y = cnt)) +
geom_line() +
labs(title = "Daily Bike Rentals", x = "Date", y = "Count")
# Correlation between temperature and total rentals
cor(bike_data$temp, bike_data$cnt)## [1] 0.627494# Mean and median temperatures for different seasons
bike_data %>%
group_by(season) %>%
summarize(mean_temp = mean(temp), median_temp = median(temp))## # A tibble: 4 × 3
## season mean_temp median_temp
## <dbl> <dbl> <dbl>
## 1 1 0.298 0.286
## 2 2 0.544 0.562
## 3 3 0.706 0.715
## 4 4 0.423 0.409# Mean temperature, humidity, wind speed, and total rentals per month
bike_data %>%
group_by(mnth) %>%
summarize(mean_temp = mean(temp),
mean_humidity = mean(hum),
mean_windspeed = mean(windspeed),
total_rentals = sum(cnt))## # A tibble: 12 × 5
## mnth mean_temp mean_humidity mean_windspeed total_rentals
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 0.236 0.586 0.206 134933
## 2 2 0.299 0.567 0.216 151352
## 3 3 0.391 0.588 0.223 228920
## 4 4 0.470 0.588 0.234 269094
## 5 5 0.595 0.689 0.183 331686
## 6 6 0.684 0.576 0.185 346342
## 7 7 0.755 0.598 0.166 344948
## 8 8 0.709 0.638 0.173 351194
## 9 9 0.616 0.715 0.166 345991
## 10 10 0.485 0.694 0.175 322352
## 11 11 0.369 0.625 0.184 254831
## 12 12 0.324 0.666 0.177 211036# Temperature association with bike rentals (registered vs. casual)
ggplot(bike_data, aes(x = temp)) +
geom_point(aes(y = registered, color = "Registered")) +
geom_point(aes(y = casual, color = "Casual")) +
labs(title = "Temperature vs. Bike Rentals", x = "Normalized Temperature", y = "Count") +
scale_color_manual(values = c("Registered" = "blue", "Casual" = "red"))
Task Two: Create interactive time series plots
## Read about the timetk package
# ?timetk
# Create an interactive time series plot
bike_data %>%
plot_time_series(.date_var = dteday, .value = cnt, .interactive = TRUE, .plotly_slider = TRUE, .color_var = year(dteday))Task Three: Smooth time series data
# Load additional required packages
pacman::p_load(forecast, zoo, TTR)
# Clean the time series data
bike_data_cleaned <- bike_data %>%
mutate(cnt_clean = tsclean(ts(cnt, frequency = 365)))
# Plot cleaned data
ggplot(bike_data_cleaned, aes(x = dteday)) +
geom_line(aes(y = cnt, color = "Original")) +
geom_line(aes(y = cnt_clean, color = "Cleaned")) +
labs(title = "Cleaned Daily Bike Rentals", x = "Date", y = "Count") +
scale_color_manual(values = c("Original" = "blue", "Cleaned" = "red"))
# Apply Simple Moving Average (SMA)
bike_data_cleaned <- bike_data_cleaned %>%
mutate(cnt_sma = SMA(cnt_clean, n = 10))
# Plot smoothed data
ggplot(bike_data_cleaned, aes(x = dteday)) +
geom_line(aes(y = cnt_clean, color = "Cleaned")) +
geom_line(aes(y = cnt_sma, color = "Smoothed (SMA)")) +
labs(title = "Smoothed Daily Bike Rentals", x = "Date", y = "Count") +
scale_color_manual(values = c("Cleaned" = "blue", "Smoothed (SMA)" = "red"))## Don't know how to automatically pick scale for object of type <ts>. Defaulting
## to continuous.## Warning: Removed 9 rows containing missing values (`geom_line()`).
# Apply Simple Exponential Smoothing
bike_ts <- ts(bike_data_cleaned$cnt_clean, frequency = 365)
fit_ets <- HoltWinters(bike_ts)
# Plot Exponential Smoothing
plot(fit_ets)
Task Four: Decompse and access the stationarity of time series data
# Decompose the time series
decomp <- stl(bike_ts, s.window = "periodic")
plot(decomp)
# Check for stationarity using ADF test
library(tseries)## Warning: package 'tseries' was built under R version 4.3.3adf_test <- adf.test(bike_ts, alternative = "stationary")
adf_test$p.value## [1] 0.8138496# If not stationary, apply differencing
bike_ts_diff <- diff(bike_ts)
adf_test_diff <- adf.test(bike_ts_diff, alternative = "stationary")## Warning in adf.test(bike_ts_diff, alternative = "stationary"): p-value smaller
## than printed p-valueadf_test_diff$p.value## [1] 0.01# Plot ACF and PACF for differenced data
acf(bike_ts_diff)
pacf(bike_ts_diff)
Task Five: Fit and forecast time series data using ARIMA models
# Fit an ARIMA model
fit <- auto.arima(bike_ts, seasonal = TRUE)
summary(fit)## Series: bike_ts
## ARIMA(1,0,3)(0,1,0)[365] with drift
##
## Coefficients:
## ar1 ma1 ma2 ma3 drift
## 0.9683 -0.5912 -0.1279 -0.0937 5.7116
## s.e. 0.0224 0.0571 0.0617 0.0576 0.8318
##
## sigma^2 = 986021: log likelihood = -3042.81
## AIC=6097.63 AICc=6097.86 BIC=6121.05
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 5.85301 697.8113 385.8648 -2.699882 9.189324 0.1694626
## ACF1
## Training set -0.003587803# Check residuals
checkresiduals(fit)
##
## Ljung-Box test
##
## data: Residuals from ARIMA(1,0,3)(0,1,0)[365] with drift
## Q* = 316.47, df = 142, p-value = 2.554e-15
##
## Model df: 4. Total lags used: 146# Forecast future values
forecasted <- forecast(fit, h = 30)
# Plot the forecast
autoplot(forecasted) +
labs(title = "Bike Rental Forecast for Next 30 Days", x = "Date", y = "Count")
Task Six: Findings and Conclusions
The analysis of daily bike rentals in the Capital Bikeshare system revealed several key insights:
Seasonal Patterns: Bike rentals exhibit clear seasonal patterns, with higher counts during warmer months and lower counts in colder months. This suggests that weather plays a significant role in bike rental behavior.
Temperature Correlation: There is a strong correlation between normalized temperature and the total count of bike rentals. Both casual and registered users show increased rentals with higher temperatures.
Stationarity and ARIMA Model: The time series data was not stationary initially, but after differencing, it became stationary. An ARIMA model was successfully fitted, and the forecast for the next 30 days provided reasonable predictions.
Forecasting Accuracy: The ARIMA model captured the overall trend and seasonality well, indicating that it can be a useful tool for predicting future bike rental demand.
Overall, the project demonstrated the effectiveness of time series analysis and forecasting techniques in understanding and predicting bike rental demand. Future work could include incorporating additional external factors such as detailed weather conditions or special events to further improve the model’s accuracy.