The Mean Squares Final

Motivation for this Project

We want to find the impact weather has on different taxi service companies and whether this impact is statistically significant, also, we want to find the effect ‘For Hire Vehicles’ have had on taxis in recent years. In addition, we would like to find out time frames which demand is higher for taxis therefore a taxi company can allocate their employees accordingly. We will be using the following analytical techniques to answer these questions:

• Transformation and Clean Up
• Hypothesis Testing
• Time Series Plot
• Heat Map

Exploratory Analysis

library(dplyr)
library(tidyr)
library(stringr)
library(sqldf)
library(DATA606)
library(ggplot2)
library(grid)
library(gridExtra)

db <- dbConnect(SQLite(), dbname = "nyc_taxi_db.sqlite")

nyc_daily_weather <- read.csv("https://raw.githubusercontent.com/aaronzal95/607final/master/dailyweather.csv", TRUE, ",")
taxi <- read.csv("https://raw.githubusercontent.com/willoutcault/FinalProjData607/master/v_taxi_daily%20(2).csv", TRUE, ",")

Cleaning & Transformations

To start we need to remove a few hundred observations. This is because the data was not recorded at the date time which causes the data to become skewed. To do this we filtered out dates which had the same date in the Date.time variable and file_name variable.

taxi$file_name <- str_remove_all(taxi$file_name, "[:alpha:]")
taxi$file_name <- str_remove_all(taxi$file_name, "_")
taxi$file_name <- str_remove_all(taxi$file_name, "\\.")
taxi <- taxi %>% 
  separate(date.date., c("Year", "Month", "Day"), sep = "-", remove = TRUE)
taxi <- taxi %>% unite("Year_Month", Year:Month, sep = "-")
taxi <- filter(taxi, Year_Month==file_name)
taxi <- taxi %>% unite("Date.time", Year_Month:Day, sep = "-")

Formatting Date Column

This must be done so that both weather data and taxi data can be correctly merged.

taxi$newdate <- strptime(as.character(taxi$Date.time), "%Y-%m-%d")
taxi$Date.time <- format(taxi$newdate, "%m/%d/%Y")

Match Locations

In order to reduce redundancy we are only analyzing the weather from Manhattan.

nyc_daily_weather <- filter(nyc_daily_weather, Address == "manhattan, ny")

Merge Data Frames

df <- merge(taxi, nyc_daily_weather, by="Date.time")

df$day <- weekdays(df$Date.time)
df <- select(df, Date.time, day, taxi, fare_amount, surcharge, tip_amount, 
             total_amount, rides, Temperature, Precipitation)
df <- separate(df, Date.time, c("Month", "Day", "Year"), sep = "/", remove = TRUE)

Create Binary Precipitation Column

Creating a binary precipitation column will allow us to conduct a conditional numerical inference on taxi demand.

for (row in 1:nrow(df)) {
    if (df$Precipitation[row] > 0) {
        df$Precipitation[row] <- 'yes' 
    } else {
        df$Precipitation[row] <- 'no'
    }
}
df$surcharge <- scale(df$surcharge)

Create Taxi Company Subsets

fhv_sub <- filter(df, taxi == "FHV")
yellow_sub <- filter(df, taxi == "Yellow")
green_sub <- filter(df, taxi == "Green")

Hypothesis Testing

Looking at the ‘df’ data frame we have 5113 observations with 12 different variables. The data contains observations on three different taxi companies, as well as the weather recorded for each date. We would like to find out if precipitation has an effect on the number of taxi rides. Intuitively we would expect more rides on rainy days because less people are willing to walk in the rain.

First let us look at the distribution of number of rides made from 2014-2018 for each company.

Yearly Ride Distribution

y <- ggplot(yellow_sub, aes(x=Year, y=rides)) + geom_boxplot() + ggtitle("Yellow Taxi")
g <- ggplot(green_sub, aes(x=Year, y=rides)) + geom_boxplot() + ggtitle("Green Taxi")
fhv <- ggplot(fhv_sub, aes(x=Year, y=rides)) + geom_boxplot() + ggtitle("FHV")
grid.arrange(y, g, fhv, ncol=2)

Lets dive deeper and look at how the distribution is between the months of the year.

Monthly Ride Distribution

y <- ggplot(yellow_sub, aes(x=Month, y=rides)) + geom_boxplot() + ggtitle("Yellow Taxi")
g <- ggplot(green_sub, aes(x=Month, y=rides)) + geom_boxplot() + ggtitle("Green Taxi")
fhv <- ggplot(fhv_sub, aes(x=Month, y=rides)) + geom_boxplot() + ggtitle("FHV")
grid.arrange(y, g, fhv, ncol=2)

We notice that the summer is the least popular time for Yellow Taxi and Green Taxi, however FHV remain steady throughout the summer. February through May are the most popular times for Yellow and Green Taxis while FHV still remains steady. With the exception of the year 2015 for the Green Taxi company, the two taxi companies are steady declining. Adversely we notice FHV are on a steady increase.

There is an observed difference in the average number of rides made when it is raining?

by(df$rides, df$Precipitation, mean)

## df$Precipitation: no
## [1] 265450.3
## ------------------------------------------------------------ 
## df$Precipitation: yes
## [1] 276671.7

As seen above the average number of rides increases in the rain but is this statistically significant?

Inference

by(df$rides, df$Precipitation, length)

## df$Precipitation: no
## [1] 3498
## ------------------------------------------------------------ 
## df$Precipitation: yes
## [1] 1615

The sample data set was acquired by random sampling and are less than 10% of the total taxi ride data.

Null Hypothesis: There is no change in the number of rides made when it rains.

Alternative Hypothesis: There is a change in the number of rides made when it rains.

inference(y = df$rides, x = df$Precipitation, est = "mean", type = "ht", null = 0, 
          alternative = "twosided", method = "theoretical")

## Response variable: numerical, Explanatory variable: categorical
## Difference between two means
## Summary statistics:
## n_no = 3498, mean_no = 265450.3, sd_no = 208928.8
## n_yes = 1615, mean_yes = 276671.7, sd_yes = 219433.6

## Observed difference between means (no-yes) = -11221.34
## 
## H0: mu_no - mu_yes = 0 
## HA: mu_no - mu_yes != 0 
## Standard error = 6503.37 
## Test statistic: Z =  -1.725 
## p-value =  0.0844

Using the inference function we are able to analyze our response variable, df$rides. The second argument in the function is our explanatory varible, df$Precipitation, which splits our data into two groups, days with rain and no rain. We are interested in the mean parameter and are conducting a hypothesis test.

Conclusion

Our p-value returned by the function is 0.0844, using a 5% significance level we fail to reject the null hypothesis. However we can say with 90% certainty that there is a difference in the amount of taxi rides when it rains.

Time Series Plot

Preparation

df <- df %>% unite("Date.time", Month:Year, sep = "-")
df$newdate <- strptime(as.character(df$Date.time), "%m-%d-%Y")
df$Date.time <- format(df$newdate, "%Y-%m-%d")
df$Date.time <- as.Date(df$Date.time)

Grouping By Monthly Averages

df2 <- df %>% select(Date.time, taxi, rides)
df2 <- df2 %>% 
  separate(Date.time, c("Year", "Month", "Day"), sep = "-", remove = TRUE)
df2 <- filter(df2, Day=='01')
df14 <- filter(df2, Year=='2014')
df15 <- filter(df2, Year=='2015')
df16 <- filter(df2, Year=='2016')
df17 <- filter(df2, Year=='2017')
df18 <- filter(df2, Year=='2018')
df14 <- mutate(df14, tot_rides = sum(rides))
df15 <- mutate(df15, tot_rides = sum(rides))
df16 <- mutate(df16, tot_rides = sum(rides))
df17 <- mutate(df17, tot_rides = sum(rides))
df18 <- mutate(df18, tot_rides = sum(rides))
df2 <- bind_rows(df14,df15,df16,df17,df18)
df2 <- df2 %>% unite("Date.time", Year:Day, sep = "-")
df2$Date.time <- as.Date(df2$Date.time)

Plot

ggplot(df2, aes(x = Date.time, y = rides)) + 
  geom_line(aes(color = taxi), size = 1) +
  scale_color_manual(values = c("#BA0000", "#0B6623", "#FFDD03")) + 
  ggtitle("Taxi Rides from 2014 to 2018 by Company") +
  xlab("Date") + 
  ylab("Ride Count by Month")

df2 <- df2 %>% 
  separate(Date.time, c("Year", "Month", "Day"), sep = "-", remove = TRUE)
ggplot(df2, aes(fill=taxi, y=rides/tot_rides, x=Year)) + 
  geom_bar(stat="identity") + 
  ggtitle("Ride Proportions by Company from 2014-2018") +
  xlab("Date") + 
  ylab("Ride Proportions by Year")+
  scale_fill_manual(values=c("#BA0000", "#0B6623", "#FFDD03"))

Heat Map

The heat map below illustrates the weekday popularity for taxi rides as we progress throughout the year.

yellow_heat <- ggplot(yellow_sub, aes(yellow_sub$day, yellow_sub$Month)) + 
  geom_tile(aes(fill = rides)) + 
  scale_fill_gradient(low = 'yellow', high = 'black') + 
  ggtitle("Yellow Taxis")
green_heat <- ggplot(green_sub, aes(green_sub$day, green_sub$Month)) + 
  geom_tile(aes(fill = rides)) + 
  scale_fill_gradient(low = 'green', high = 'black') + 
  ggtitle("Green Taxis")
fhv_heat <- ggplot(fhv_sub, aes(fhv_sub$day, fhv_sub$Month)) + 
  geom_tile(aes(fill = rides)) + 
  scale_fill_gradient(low = 'white', high = 'red') + 
  ggtitle("FHV")

grid.arrange(yellow_heat, green_heat, fhv_heat, ncol=2)

Conclusion

In conclusion we notice pretty significant changes based on varying conditions. Our question whether weather played an impact on demand for rides was significant up to a 90% significance level. A taxi company should properly allocate their recourses when rain is in the forcast.

We noticed a significant increase in demand for ‘For Hire Vehicles’ while green and yellow taxis have steady decreased in demand. This is bad news for yellow and green taxi companies because the demand for their service is only getting lower.

Lastly we identified the days for each month where demand for rides is the highest. In addition to forecasting weather, knowing which days of the week in each month can allow for more accurate recourse allocation.