Bicycle Sharing in Seattle

Data Structures and Variables

## Observations: 58
## Variables: 9
## $ station_id        <chr> "BT-01", "BT-03", "BT-04", "BT-05", "CBD-03"...
## $ name              <chr> "3rd Ave & Broad St", "2nd Ave & Vine St", "...
## $ lat               <dbl> 47.61842, 47.61583, 47.61609, 47.61311, 47.6...
## $ long              <dbl> -122.3510, -122.3486, -122.3411, -122.3442, ...
## $ install_date      <chr> "10/13/2014", "10/13/2014", "10/13/2014", "1...
## $ install_dockcount <int> 18, 16, 16, 14, 20, 18, 20, 20, 20, 18, 16, ...
## $ modification_date <chr> "", "", "", "", "", "", "", "11/9/2015", "",...
## $ current_dockcount <int> 18, 16, 16, 14, 20, 18, 20, 18, 20, 18, 0, 1...
## $ decommission_date <chr> "", "", "", "", "", "", "", "", "", "", "8/9...

## Observations: 236,065
## Variables: 12
## $ trip_id           <int> 431, 432, 433, 434, 435, 436, 437, 438, 439,...
## $ starttime         <chr> "10/13/2014 10:31", "10/13/2014 10:32", "10/...
## $ stoptime          <chr> "10/13/2014 10:48", "10/13/2014 10:48", "10/...
## $ bikeid            <chr> "SEA00298", "SEA00195", "SEA00486", "SEA0033...
## $ tripduration      <dbl> 985.935, 926.375, 883.831, 865.937, 923.923,...
## $ from_station_name <chr> "2nd Ave & Spring St", "2nd Ave & Spring St"...
## $ to_station_name   <chr> "Occidental Park / Occidental Ave S & S Wash...
## $ from_station_id   <chr> "CBD-06", "CBD-06", "CBD-06", "CBD-06", "CBD...
## $ to_station_id     <chr> "PS-04", "PS-04", "PS-04", "PS-04", "PS-04",...
## $ usertype          <chr> "Member", "Member", "Member", "Member", "Mem...
## $ gender            <chr> "Male", "Male", "Female", "Female", "Male", ...
## $ birthyear         <int> 1960, 1970, 1988, 1977, 1971, 1974, 1978, 19...

## Observations: 689
## Variables: 21
## $ Date                       <chr> "10/13/2014", "10/14/2014", "10/15/...
## $ Max_Temperature_F          <int> 71, 63, 62, 71, 64, 68, 73, 66, 64,...
## $ Mean_Temperature_F         <int> 62, 59, 58, 61, 60, 64, 64, 60, 58,...
## $ Min_TemperatureF           <int> 54, 55, 54, 52, 57, 59, 55, 55, 55,...
## $ Max_Dew_Point_F            <int> 55, 52, 53, 49, 55, 59, 57, 57, 52,...
## $ MeanDew_Point_F            <int> 51, 51, 50, 46, 51, 57, 55, 54, 49,...
## $ Min_Dewpoint_F             <int> 46, 50, 46, 42, 41, 55, 53, 50, 46,...
## $ Max_Humidity               <int> 87, 88, 87, 83, 87, 90, 94, 90, 87,...
## $ Mean_Humidity              <int> 68, 78, 77, 61, 72, 83, 74, 78, 70,...
## $ Min_Humidity               <int> 46, 63, 67, 36, 46, 68, 52, 67, 58,...
## $ Max_Sea_Level_Pressure_In  <dbl> 30.03, 29.84, 29.98, 30.03, 29.83, ...
## $ Mean_Sea_Level_Pressure_In <dbl> 29.79, 29.75, 29.71, 29.95, 29.78, ...
## $ Min_Sea_Level_Pressure_In  <dbl> 29.65, 29.54, 29.51, 29.81, 29.73, ...
## $ Max_Visibility_Miles       <int> 10, 10, 10, 10, 10, 10, 10, 10, 10,...
## $ Mean_Visibility_Miles      <int> 10, 9, 9, 10, 10, 8, 10, 10, 10, 6,...
## $ Min_Visibility_Miles       <int> 4, 3, 3, 10, 6, 2, 6, 5, 6, 2, 10, ...
## $ Max_Wind_Speed_MPH         <int> 13, 10, 18, 9, 8, 10, 10, 12, 15, 1...
## $ Mean_Wind_Speed_MPH        <int> 4, 5, 7, 4, 3, 4, 3, 5, 8, 8, 9, 4,...
## $ Max_Gust_Speed_MPH         <chr> "21", "17", "25", "-", "-", "-", "1...
## $ Precipitation_In           <dbl> 0.00, 0.11, 0.45, 0.00, 0.14, 0.31,...
## $ Events                     <chr> "Rain", "Rain", "Rain", "Rain", "Ra...

Station Installations

First, let’s convert those character-string date objects to actual dates using the lubridate package.

station$install_date <- mdy(station$install_date)

# How many times were new stations installed?
station %>% summarise(n_distinct(install_date))

##   n_distinct(install_date)
## 1                        9

# How many stations were installed on each date?
station %>% group_by(install_date) %>% summarise(count = n()) %>% 
    arrange(install_date)

## # A tibble: 9 × 2
##   install_date count
##         <date> <int>
## 1   2014-10-13    50
## 2   2015-05-22     1
## 3   2015-06-12     1
## 4   2015-07-27     1
## 5   2015-09-15     1
## 6   2015-10-29     1
## 7   2016-03-18     1
## 8   2016-07-03     1
## 9   2016-08-09     1

It looks like the vast majority (86%) of the stations were added on opening day. Let’s see where those original ones were and where the rest were added.

So they added more stations throughout the district that they serve, instead of adding several new stations to a single neighborhood all at once. Good to know.

Now, I wonder how many bikes can be parked at each station (as of August 31,2016)?

Bar graph showing that most bike stations currently house between 13 an 20 bikes.

Well that’s weird, some of the stations have a dock count of 0. I’m assuming they didn’t start that way. Let’s calculate the change in dock count from station installation to August 31, 2016 and plot it on a map.

dock_change <- station %>% group_by(station_id) %>% select(station_id, 
    long, lat, ends_with("dockcount")) %>% mutate(dock_change = current_dockcount - 
    install_dockcount)

Change in Number of Bike Docks Per Station

Any stations with no change in number of docks are not shown here.

Map of Seattle with different sized and colored dots showing the amount of bikes that have been added or removed from docking stations. Most stations have lost bikes.

Wow! Looks like quite a few stations took away bike docks and none gained any. Perhaps those stations weren’t being used very frequently. We’ll have to look at that a bit later.

Current Station Size

I’m going to take one quick look at the current size of each station before moving on to the next dataset. Note: I did not include any stations that were closed as of August 31, 2016 in this map

Zoomed in map of Seattle with various size dots showing the current station size of all bike stations.

So it looks like the biggest stations tend to be on the outskirts of the rest. Where there are several stations in close proximity, there tend to be fewer bike docks at each station. That makes sense, logically speaking. If you go to a station and there is no bike to rent, you can easily go to another nearby, assuming there is another nearby. In areas where the stations are more secluded, it’s more important that there be bikes and open spaces readily available for users.

Alright, I’m feeling good about exploring this dataset. Time to check out the trip dataset!

Plotting Trips Per Month (By Season)

First, we need to create a “Year-Month” variable

start_date_ym <- trip_2 %>% mutate(ym = paste(year(start_date), 
    month(start_date), sep = "/"))

Now plot. I think I’ll plot this by month but color it by season (where December, January, and February are “winter”, March, April, and May are “spring”, June, July, August are “summer”, and September, October, November are “autumn”)

Line graph showing the number of trips taken per month over the course of the year and colored by season. Trips are highest in the summer, lowest in the winter.

Well that intuitively makes sense. The number of trips taken per month increases in the spring, reaches a maximum in the summer, declines through the fall, remains fairly stable in the winter and then repeats.

Average Trip Duration

Great! I wonder how the average trip duration fluctuates over this time period.

# Convert Trip Duration from Seconds to Minutes
Trip_Duration_Month <- start_date_ym %>% mutate(trip_duration_min = tripduration/60) %>% 
    group_by(ym) %>% select(ym, trip_duration_min) %>% summarise(Avg = mean(trip_duration_min), 
    sd = sd(trip_duration_min)) %>% mutate(se = sd/sqrt(n()))

Now to plot the average trip duration (in minutes) (plus or minus standard error), with colors indicating season.

A line graph showing the duration (with standard error error bars) of the average trip per month, colored for each season. Trip durations peak in the summer and are low in the winter.

There’s surprisingly not a huge range in trip durations here.

The little bit of variation here makes logical sense. Longer trips were being taken in the spring and summer months rather than the fall and winter. It’s also notable that the spring and summer of 2016 may have shown fewer trips than the previous year, show a slight increase in average trip length.

Number of Trips by Day of Week

I wonder if people are using this service to commute to/from work. Let’s look at the number of trips by day of the week.

First, let’s create a Day of the Week variable.

trip_2$wd <- wday(trip_2$start_date, label = TRUE)

Now to plot the total number of trips by day of the week.

A line graph showing number of trips taken by day of the week. There are slightly more trips taken Monday - Friday.

Ok, so there are definitely more trips during the week than on the weekends. I wonder if this varies by season too.

Line graph with a line for each season showing the number of trips taken by day of the week. The lines are all pretty consistent within a season, and summer has the highest of all seasons.

So it looks like usage is relatively consistent across seasons, at least as far as the number of trips are concerned.

Number of Trips by Time of Day

How about time of day? Are people using these around commuting times during the week and later on weekends?

Seven, side-by-side graphs one for each day of the week. Each has a separate line for each of the four seasons, showing activity by hour of the day. Weekdays have spikes during rush hour and weekends are consistent throughout the day.

Wow, looks like regardless of the season, people are commuting to/from work using this service (there’s a spike between 8 and 10 AM and another between 4 and 7 PM Monday through Friday). But the weekends seem to be popular between 10 AM and 10 PM.

Number of Trips by Member Type

I wonder if different types of members (those who have a membership vs. those that bought a 24 hour or 3 day pass) vary in the number of trips they take.

If I were to guess, I’d think the short-term passes would be ideal for tourists or people looking for a quick weekend trip, whereas members may be more likely to continue using the service year-round. Let’s check out my assumptions by plotting, once again colored by season.

Line graph with 2 lines, one showing the number of trips per month, colored by season, for members, and one showing the number of trips per month, colored by season, for pass holders. The shape is similar, but passholders take fewer trips every month, especially in winter.

Surprisingly (to me, at least), different types of users seem to follow similar patterns of usage. Spring and Summer are definitely the most popular times for anyone to ride a bike in the Seattle area.

Trip Duration by Member Type

While it may seem that the trip duration shouldn’t vary widely by member type, a quick look at Pronto!’s pricing structure may make you reconsider that assumption. You see, while you have to purchase either an annual membership ($85/year), a 24-Hour Pass ($8) or a 3-Day Pass ($16) there is still a cap on the duration of your trip. For members, any ride under 45 minutes is free, but any ride going over 45 minutes will incur a fee of $2 for every additional 30 minutes. For short-term users, any ride under 30 minutes is free, but going over that time limit would cost you an additional $2 for the first 30 minutes and $5 for each additional 30 minutes after that!

Let’s see if these time limits cause differing behaviors in our users.

Two side-by-side histograms, showing member and short term pass holder trip duration with a black dotted line indicating the time when fees start accruing. Pass holers take a wider range of trip lengths and pay more fees.

Ok, so our members are pretty good about making sure that they return their bike before they incur extra charges, but the short-term pass holders frequently go over their time limit. I wonder how the cost of a trip varies for members and pass holders. Let’s try to calculate the cost of a trip.

trip_cost <- trip_2 %>% mutate(cost = ifelse(usertype == "Member" & 
    tripduration_m <= 45, 0, ifelse(usertype == "Member" & tripduration_m > 
    45 & tripduration_m <= 75, 2, ifelse(usertype == "Member" & 
    tripduration_m > 75, (2 + 5 * ((tripduration_m - 75)/30)), 
    ifelse(usertype == "Short-Term Pass Holder" & tripduration_m <= 
        30, 0, ifelse(usertype == "Short-Term Pass Holder" & 
        tripduration_m > 30 & tripduration_m < 60, 2, ifelse(usertype == 
        "Short-Term Pass Holder" & tripduration_m > 60, (2 + 
        5 * ((tripduration_m - 60)/30)), "unknown")))))))

That was a complicated nested if/else statement! Let’s see how much these folks are paying in additional fees!

Two bar graphs side by side, showing member and short-term pass holder fee paying behavior. Short-term pass holders pay more fees.

Looks like short-term pass holders (who are already paying a higher price per day of biking), are also paying lots of extra fees. This could be because they are unfamiliar with the pricing structure and don’t realize they need to return their bike to a station within 30 minutes without getting charged. It is also possible that short-term users may be tourists who don’t know their way around as easily, and thus can’t find their way to a station within the time limit.

Member Demographics

We only seem to have age and gender information about people who have an annual Pronto! membership, so we can at least take a look at what types of people use this service.

Let’s look first at age.

trip_2$usertype <- as.factor(trip_2$usertype)
trip_age <- trip_2 %>% mutate(age = year(start_dt) - birthyear)

hist(trip_age$age, main = "Member Age", xlab = "Number of Riders", 
    col = "#56B4E9", breaks = 25)

Histogram showing that the most riders are in their late 20s to early 30s.

My first instinct here is to say “Wow! There’s a lot of 20 and 30-somethings that use this service!” But this figure (and these data) may be a little misleading. You see, we don’t have any sort of Rider ID number, meaning we can’t take “individual activity level” into account. So we can’t tell if the tallest spike is because 5 very athletic 28-year-olds went on 4,000 trips each, or if 100 people went on 200 trips each, or if there were 20,000 28-year-olds who each only used the service once.

The same problem would arise if we looked at gender, so I’m just going to move beyond demographics.

Trip Routes

I’m going to do my best to look at some potential routes that these users could have taken, given their start and stop locations and duration. All of these data will be analyzed using the ggmap package and Google Maps API (more info here)

To start, I need to combine the coordinates of the station (from the station dataset) with the data from the trip dataset. Let’s get started.

# Create a dataframe with only station ID, latitude, and
# longitude
station_coord <- station %>% select(station_id, lat, long)

# Trim our trip dataframe to only include start & stop
# dates/times, and station ID
trip_route <- trip_2 %>% select(trip_id, starts_with("start_"), 
    starts_with("stop_"), from_station_id, to_station_id, tripduration)

# Match by station ID
trip_route$start_lat <- station_coord[match(trip_route$from_station_id, 
    station_coord$station_id), "lat"]

trip_route$start_long <- station_coord[match(trip_route$from_station_id, 
    station_coord$station_id), "long"]

trip_route$stop_lat <- station_coord[match(trip_route$to_station_id, 
    station_coord$station_id), "lat"]

trip_route$stop_long <- station_coord[match(trip_route$to_station_id, 
    station_coord$station_id), "long"]

Great! Now to start looking at routes.

I’ll start by looking at the possible routes of the very first trip.

Two side-by-side satellite images of Seattle, each showing a potential bike route from one place to another.

Cool! So Google Maps API was able to give us two potential routes for this particular trip. We can make a best guess on which trip was taken by determining the trip duration.

# Converting trip duration to minutes
trip_route$tripduration <- trip_route$tripduration/60

# Finding actual trip duration
trip_route[1, "tripduration"]

## [1] 16.43225

Ok, so the actual trip on October 13, 2014 took 16.4 minutes. Let’s see how long each of the hypothetical trips took.

leg_1 %>% group_by(route) %>% summarise(duration = sum(minutes))

## # A tibble: 2 × 2
##   route duration
##   <chr>    <dbl>
## 1     A 4.950000
## 2     B 5.583333

Hmm, looks like Google estimates those trips should have only taken between 5 and 6 minutes. It is very possible that our user did not go directly from one station to the other. It’s also possible that he got stopped at a few red lights along his route.

Perhaps this, being the first trip, was a demo of some sort. Let’s check out the last trip that was recorded and see if we still run into the same time disconnect.

Well this was certainly a longer ride than the first one we looked at!

How long did this trip take?

trip_route[nrow(trip_route), "tripduration"]

## [1] 31.60052

Ok, so how long did Google estimate it should take?

leg_2 %>% group_by(route) %>% summarise(duration = sum(minutes))

## # A tibble: 3 × 2
##   route duration
##   <chr>    <dbl>
## 1     A  9.50000
## 2     B 12.13333
## 3     C 13.45000

Once again, the trip took quite a bit longer than any of the routes shown here. It’s possible that estimating the routes taken by cyclists is not the best use of this dataset. So, what else is there to look at?

Station by Trip Departure and arrival

I suppose we can see which stations have the most trip departures and which have the most arrivals. Unless people are always making round-trip journeys, these are not likely to be equal.

Station Usage

Trip Departure

Zoomed in map of Seattle with different sized dots showing the departure of bikes. These are spread throughout the city.

Trip Arrival

Zoomed in map of Seattle with different sized dots showing the arrival of bikes (or where they were returned at the end of a trip). Most of these are near the coast.

Great, so it looks like the station that sends the highest number of bikes out and takes the highest number of bikes in is located at Pier 69 / Alaskan Way & Clay Street. Looks like this is pretty close to a few parks and several big tourist attractions.

Also, if you flip between “Departures” and “Arrivals”, you’ll notice that quite a few bikes are picked up in the Capitol Hill area, but are returned down by the coast. If you’re unfamiliar with Seattle’s topography, Capitol Hill is aptly named because it’s situated on a very steep hill. It makes sense that people would borrow bikes to ride down the hill, but not want to borrow a bike to go back up the hill. Interesting!

Temperature

Minimum

Line graph showing fluctuating daily minimum temperatures in Seattle

Mean

Line graph showing fluctuating daily mean temperatures in Seattle

Maximum

Line graph showing fluctuating daily maximum temperatures in Seattle

Events

Bar graph showing that the most common weather events were rain and “other”

Combining Weather and Trip Datasets

Good, so we can now see some parts of the weather data. Let’s combine the weather data with our trip data. Let’s try a left join from the dplyr package.

# Make a copy of the data frame
trip_3 <- trip_2

# Change column name in trip_3 to match weather dataset
trip_3$Date <- trip_3$start_date

# Left join the trip and weather dataframes by date.
trip_weather <- left_join(trip_3, weather, by = "Date")

Mean Temperature vs. Number of Trips

Ok. Now let’s see how the number of trips per day is influenced by weather (mean temperature, rounded to the nearest 5 degrees F)

Line graph showing that the number of trips peaks when temperatures are 60-70 degrees with higher or lower temperatures resulting in fewer rides.

So, as expected, there are more trips when the weather is mild but not too warm (over 70F) or too cold (below 50F). However, this figure may be influenced by the overall number of days that exhibited each mean temperature. Let’s try to standardize that.

Line graph showing that bike rides increased with an increase in temperature, relative to the number of days at each temperature.

So when we standardize our measurements, correcting for the number of days that actually reached each temperature, we see a steady increase in the number of trips until around 75F where the trend levels off. People are more likely to ride a bike when it’s warm outside.

Precipitation vs. Number of Trips

If you’ve ever heard of Seattle, you probably hear that it rains all the time there. Let’s see if that has an impact on the number of trips taken in a day.

We’ll start with a figure standardized for number of days at a precipitation level, rounded to the nearest 0.2 inches.

Line graph showing that the number of trips dropped as the precipitation level increased.

Looks like even Seattleites have a limit when it comes to riding a bike in the rain. The more it rained, the fewer trips were taken per day.