Synopsis and Problem Description

Bike sharing programs are popular around the world. In May 2014, the machine learning competition website kaggle.com opened the competition “Forecast use of a city bikeshare system”. In this competition, participants are asked to combine historical usage patterns with weather data in order to forecast bike rental demand in the Capital Bikeshare program in Washington, D.C.

This analysis attempts to generate a machine learning model based on linear regression to predict rental demand by the hour. The training set (http://www.kaggle.com/c/bike-sharing-demand/data) includes hourly rental data for the first 19 days of the month. The goal is to predict the rest of the days for that month.

Data Fields

The data set includes the following variables: datetime = hourly date + timestamp
season = 1 - spring, 2 - summer, 3 - fall, 4 - winter holiday = whether the day is considered a holiday workingday = whether the day is neither a weekend nor holiday weather = 1: Clear, Few clouds, Partly cloudy, Partly cloudy 2: Mist + Cloudy, Mist + Broken clouds, Mist + Few clouds, Mist 3: Light Snow, Light Rain + Thunderstorm + Scattered clouds, Light Rain + Scattered clouds 4: Heavy Rain + Ice Pallets + Thunderstorm + Mist, Snow + Fog temp = temperature in Celsius atemp = “feels like” temperature in Celsius humidity = relative humidity windspeed = wind speed casual = number of non-registered user rentals initiated registered = number of registered user rentals initiated count = number of total rentals

Approach

First step is to load the train data and run some transformation to make it easier to manipulate data. Second, I explore some of the most obvious correlations. For instance, hour of the day and temperature. To explore data I show some plots to verify that the correlation exists. I added month because I beleive it is a stronger predictor than season. I used the most recent data so I decided to exclude 2011. Next, I used a linear regression model and ran a summary to check and see if the coefficients were significant. Finally I ran the predictions on the test file and created submission file.

Results

The linear model shows a Rsquared of only 29% which is low, therefore most of the variation is not explained by the model. Nevertheless, the resulting Kaggle score is 1.38112 which is above the mean score benchmark! (1.58456) in the leaderboard. Not bad for first model!

Step 1: Load and Transform

library(lubridate)
library(car)  # for scatterplot
setwd("~/Documents/WA Intro to Data Science/kaggle")

Load training set

bike1 <- read.csv("train.csv"
                  ,stringsAsFactors = FALSE)

Tranform dates and categorical variables

bike1$datetime <- ymd_hms(bike1$datetime)

bike1$season <- factor(bike1$season
                       ,levels = c(1,2,3,4)
                       ,labels = c("spring", "summer", "fall", "winter")
                       )

bike1$workingday <- factor(bike1$workingday
                           ,levels = c(0,1)
                           ,labels = c("nonwkday", "wkday")
                           )

bike1$weather <- factor(bike1$weather
                        ,levels = c(4,3,2,1)
                        ,labels = c("very bad", "bad", "good", "very good")
                        ,ordered = TRUE)

Add month and hour of the day to data set because I beleive they are strong predictors

bike1$hour <- hour(bike1$datetime)

bike1$month_nbr <- month(bike1$datetime)

bike1$month <- factor(months(bike1$datetime)
                      ,levels = c("January"
                                  ,"February"
                                  ,"March"
                                  ,"April"
                                  ,"May"
                                  ,"June"
                                  ,"July"
                                  ,"August"
                                  ,"September"
                                  ,"October"
                                  ,"November"
                                  ,"December")
                      ,ordered = TRUE)

I believe most recent data yields stronger prediction, so we filter on 2012

yearmask <- year(bike1$datetime) == 2012

bike1 <- bike1[yearmask,]  # only 5,464 observations in 2012

Step 2: Data Exploration and Hypothesis

Let’s look at one season, spring

bikesp <- bike1[bike1$season == "spring",]

Explore 1. Most likely, temperature and weather have correlation with bike demand. We can plot:

## Warning: could not fit smooth

plot of chunk unnamed-chunk-7

Indeed, the plot shows correlation with temparature

Explore 2. Most certain the hour of the day also correlates with Bike demand plot of chunk unnamed-chunk-8

Not just hour of the day but also working vs non working days influence demand

Explore 3. Finally let’s see if usage varies depending on the month plot of chunk unnamed-chunk-9

We can see that demand in January is the lowest and it peaks in the summer

In short we have identified strong correlation with these predictors: 1. Temperature 2. Hour of the Day 3. Working Day 4. Month of the Year

Before moving on, let’s compare demand of registered vs. casual users:

cr <- aggregate(. ~ month
                ,data = bike1[c("casual"
                                ,"registered"
                                ,"month")]
                ,sum)

rownames(cr) <- cr$month

cr <- cr[c("casual", "registered")]

plot of chunk unnamed-chunk-11

Both Casual and Registered seem to have the same trend across months

Now, we build our hypothesis that bike rentals have the following predictors: 1. Temperature 2. Hour of the Day 3. Working Day 4. Month of the Year

Step 3: Build Linear Model

Fit linear regression model

bike2 <- bike1[c("temp"
                 ,"hour"
                 ,"workingday"
                 ,"month_nbr"
                 ,"count")]

bikelm <- lm(count ~ .
             ,data = bike2
             )

Let’s check coefficients

summary(bikelm)
## 
## Call:
## lm(formula = count ~ ., data = bike2)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -374.0 -118.2  -36.6   80.4  639.2 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)      -99.025      8.802  -11.25  < 2e-16 ***
## temp               7.995      0.325   24.63  < 2e-16 ***
## hour              11.704      0.348   33.68  < 2e-16 ***
## workingdaywkday    7.726      5.084    1.52     0.13    
## month_nbr          4.927      0.705    6.98  3.2e-12 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 175 on 5459 degrees of freedom
## Multiple R-squared:  0.291,  Adjusted R-squared:  0.291 
## F-statistic:  560 on 4 and 5459 DF,  p-value: <2e-16

All predictors have low p values except workingday We also see that the model explains only 29% of total variance which is low

Step 4: Run Prediction and Create Submission File

biket <- read.csv("test.csv"
                  ,stringsAsFactors = FALSE)

We apply the same tranformations as we did with the training set

Grab list of predictors from test data set:

biket2 <- biket[c("temp"
                 ,"hour"
                 ,"workingday"
                 ,"month_nbr")]

Predict Bike Rental Demand

brental <- predict(bikelm
                   ,newdata = biket2
                   )

Check negative values

table(brental < 0)  # there ae 59 negative values! not good!
## 
## FALSE  TRUE 
##  6434    59
brental[brental < 0] <- min(brental[brental > 0]) 

brental <- round(brental, 0)

Create submission file

bikesub <- data.frame(datetime = as.character(biket$datetime)
                 ,count = as.integer(brental)
)

write.csv(bikesub
          ,file = "submission.csv"
          ,row.names = FALSE
          ,quote = FALSE
          )

After submitting, I received a Kaggle Score of 1.38112 which is above the mean score benchmark! of 1.58456 ! Not bad for first model ;-)