The data
First, we need to load the data and some packages that I’ll be using
a lot. I’ll also source some functions for customized plots and
tables.
# Load packages
library("tidyverse")
library("kableExtra")
# Load data
load("data/r_data/data_raw.rda")
data <- data_raw
# Source functions
source("r_scripts/functions.R")
Format
We can use dplyr’s glimpse() to understand the data
set’s structure.
glimpse(data)
## Rows: 5,723,532
## Columns: 13
## $ ride_id <chr> "6C992BD37A98A63F", "1E0145613A209000", "E498E15508…
## $ rideable_type <fct> classic_bike, docked_bike, docked_bike, classic_bik…
## $ started_at <dttm> 2021-04-12 18:25:36, 2021-04-27 17:27:11, 2021-04-…
## $ ended_at <dttm> 2021-04-12 18:56:55, 2021-04-27 18:31:29, 2021-04-…
## $ start_station_name <fct> State St & Pearson St, Dorchester Ave & 49th St, Lo…
## $ start_station_id <fct> TA1307000061, KA1503000069, 20121, TA1305000034, 20…
## $ end_station_name <fct> Southport Ave & Waveland Ave, Dorchester Ave & 49th…
## $ end_station_id <fct> 13235, KA1503000069, 20121, 13235, 20121, 15542, 16…
## $ start_lat <dbl> 41.89745, 41.80577, 41.74149, 41.90312, 41.74149, 4…
## $ start_lng <dbl> -87.62872, -87.59246, -87.65841, -87.67394, -87.658…
## $ end_lat <dbl> 41.94815, 41.80577, 41.74149, 41.94815, 41.74149, 4…
## $ end_lng <dbl> -87.66394, -87.59246, -87.65841, -87.66394, -87.658…
## $ member_casual <fct> member, casual, casual, member, casual, casual, cas…
The data set is a record of 5.723.532 bike trips and their time and
location, bicycle type and customer type. The data types seem sensible
at first glance. The only thing I would like to change is replacing the
inefficient character ride_id column with numeric IDs. In
order to do so, we first need to make sure that all current ride IDs are
unique.
# Number of duplicate ride_ids
sum(duplicated(data$ride_id))
## [1] 0
There are no duplicates, so we can simply replace the IDs with
consecutive integers without loosing any information.
# Replace ride_id with integers
data <- data %>%
mutate(ride_id = 1:n())
Also, ride duration might be interesting and can be easily
computed.
# Compute ride duration
data <- data %>%
mutate(ride_duration = as.numeric(difftime(ended_at,
started_at,
units = "min")))
Content
Now that everything is in the right format, it’s time to dive deeper
into the actual data to see whether there are any missing values or
invalid observations. We can compute some summary statistics using base
R’s summary().
summary(data)
## ride_id rideable_type started_at
## Min. : 1 classic_bike :3250691 Min. :2021-04-01 00:03:18.00
## 1st Qu.:1430884 docked_bike : 303989 1st Qu.:2021-06-22 15:20:26.50
## Median :2861766 electric_bike:2168852 Median :2021-08-17 18:25:49.00
## Mean :2861766 Mean :2021-08-26 22:25:18.39
## 3rd Qu.:4292649 3rd Qu.:2021-10-14 19:48:10.50
## Max. :5723532 Max. :2022-03-31 23:59:47.00
##
## ended_at start_station_name
## Min. :2021-04-01 00:14:29.00 Streeter Dr & Grand Ave: 84011
## 1st Qu.:2021-06-22 15:47:37.00 Michigan Ave & Oak St : 44260
## Median :2021-08-17 18:44:32.50 Wells St & Concord Ln : 44031
## Mean :2021-08-26 22:46:50.94 Millennium Park : 42287
## 3rd Qu.:2021-10-14 20:03:28.50 Clark St & Elm St : 41215
## Max. :2022-04-01 22:10:12.00 (Other) :4722352
## NA's : 745376
## start_station_id end_station_name
## 13022 : 84011 Streeter Dr & Grand Ave: 84694
## LF-005 : 47763 Michigan Ave & Oak St : 44635
## 13300 : 45592 Wells St & Concord Ln : 44124
## 13042 : 44260 Millennium Park : 42895
## TA1308000050: 44031 Clark St & Elm St : 40469
## (Other) :4712502 (Other) :4670468
## NA's : 745373 NA's : 796247
## end_station_id start_lat start_lng end_lat
## 13022 : 84694 Min. :41.64 Min. :-87.84 Min. :41.39
## LF-005 : 53819 1st Qu.:41.88 1st Qu.:-87.66 1st Qu.:41.88
## 13042 : 44635 Median :41.90 Median :-87.64 Median :41.90
## TA1308000050: 44124 Mean :41.90 Mean :-87.65 Mean :41.90
## 13300 : 43781 3rd Qu.:41.93 3rd Qu.:-87.63 3rd Qu.:41.93
## (Other) :4656232 Max. :45.64 Max. :-73.80 Max. :42.17
## NA's : 796247 NA's :4716
## end_lng member_casual ride_duration
## Min. :-88.97 casual:2546542 Min. : -58.03
## 1st Qu.:-87.66 member:3176990 1st Qu.: 6.57
## Median :-87.64 Median : 11.72
## Mean :-87.65 Mean : 21.54
## 3rd Qu.:-87.63 3rd Qu.: 21.33
## Max. :-87.49 Max. :55944.15
## NA's :4716
Here is what I see:
Rideable_type and member_casual seem fine.
They are both categorical with three/two categories and all their values
fit into one of the categories. The distinction between classic, docked
and electric bikes is a little strange, so we might want to investigate
that later.- All the values in
started_at and ended_at
have been classified as date-time. Values fall between April 1, 2021 and
March 31, 2022 for started_at, which is in line with what we expected.
Values for ended_at reach into April 1, 2022, so our data set apparently
contains all the trips that started within April 2021 and March 2022,
regardless of when they ended.
- Station names and IDs contain a lot of missing values. These values
could be valid though, since bikes might not necessarily need to be
parked at stations. However,
start_station_id contains
fewer missing values than start_station_name. We might be
able to infer the missing names based on IDs, but perhaps the missing
names indicate that something is wrong with these observations. We’ll
have to look into that.
Start_lat and start_lng do not contain
missing values, but their maximum values are suspicious, since they
deviate a lot from the rest of the variables’ summary statistics.End_lat and end_lng summary statistics are
more sensible. However, these do contatin quite a few missing values.
While missing start and end stations make sense, missing positions do
not. Maybe these are indicators of technical errors, such as empty
batteries, which would likely make the rest of the variables for these
observations invalid as well.- Values for
ride_duration fall into a huge range of
multiple weeks, even though the majority of values seem to fall into a
much smaller range. Negative trip durations are impossible and trip
durations of multiple days, while possible, do not make a lot of sense
either and should be further investigated.
We can now dig deeper based on these preliminary findings.
Particularly, we need to examine ride duration and all variables related
to start and end locations. Let’s start by looking at
ride_duration.
Ride duration I
Distribution
After looking at some basic descriptive statistics, I am interested
in the distribution of ride durations.
# Plot ride duration
data %>%
ggplot() +
geom_histogram(aes(x = ride_duration/60/24),
binwidth = 1, boundary = 0, color = "black") +
xlab("ride_duration (days)")
Since so many values fall between 0 and 24 hours, it is impossible to
distinguish between other bins. Zooming in might help us understand
these less common durations.
# Plot ride duration zoomed in
data %>%
my_ggplot() +
geom_histogram(aes(x = ride_duration/60/24),
binwidth = 1, boundary = 0, color = "black") +
coord_cartesian(ylim = c(0, 1000)) +
xlab("ride_duration (days)")
There are more than 625 trips with negative durations. Since start
and/or end times of these observations are incorrect, their other
measures might be wrong too and hence should not be included in the
analysis. Before removing any observations though, I am interested
whether ride durations differ between certain bike or membership types,
so I’ll create a table of summary statistics by group…
# ride_duration extreme values by group
data %>%
group_by(member_casual, rideable_type) %>%
summarize(min = min(ride_duration),
max = max(ride_duration),
mean = mean(ride_duration),
sd = sd(ride_duration),
n = n()) %>%
ungroup() %>%
mutate(percentage = n*100 / sum(n)) %>%
kable_custom()
|
member_casual
|
rideable_type
|
min
|
max
|
mean
|
sd
|
n
|
percentage
|
|
casual
|
classic_bike
|
-53.5
|
1559.9
|
28.9
|
77.5
|
1257643
|
22.0
|
|
casual
|
docked_bike
|
-40.8
|
55944.2
|
82.8
|
742.4
|
303989
|
5.3
|
|
casual
|
electric_bike
|
-58.0
|
487.3
|
19.6
|
23.6
|
984910
|
17.2
|
|
member
|
classic_bike
|
-54.1
|
1559.9
|
14.0
|
32.4
|
1993048
|
34.8
|
|
member
|
electric_bike
|
-53.8
|
480.5
|
12.4
|
15.8
|
1183942
|
20.7
|
… and another histogram by group.
# Plot ride_duration zoomed in by group
data %>%
my_ggplot() +
geom_histogram(aes(x = ride_duration/60/24),
binwidth = 1, boundary = 0, color = "black") +
coord_cartesian(ylim = c(0, 1000)) +
scale_y_continuous(breaks = seq(0,1000,250)) +
xlab("ride_duration (days)") +
facet_grid(rows = vars(member_casual), cols = vars(rideable_type))
Key observations are:
- Negative trip durations occur in all groups and are only slightly
more common (relatively) in electric bikes.
- Docked bikes seem to be responsible for all trips with a duration of
more than 26 hours.
- Docked bikes stand out due to their high number of long trips and
their relatively low number of total trips.
- Docked bikes have not been used by members.
Unfortunately, I cannot find anything on docked bikes in either the
case study scenario provided by Google (where there is no mention of
electric bikes either), or Divvy’s website (https://divvybikes.com/),
who provide the real-world data set for this case study. Given that
docked bikes stand out in terms of trip durations and the fact that they
have only been used by casuals and I cannot find any explanations for
either, I decided to remove these data points and continue my analysis
without docked bikes. If this were a real-life case, I would obviously
get help from others, however, I think looking at electric bikes vs
classic bikes is sufficient for this case study.
Removing
outliers
I am going to track any changes I make along with their type
(modification vs removal of observations) and their specific reasons in
a changelog. In order to do so efficiently, I’ll create a function that
I’ll be able to use whenever I modify or remove observations.
# Custom function for tracking changes
track_changes <- function (data, data_old, changelog, type, reason) {
# Extract affected rows
cl_temp <- anti_join(data_old, data) %>%
select(ride_id, member_casual, rideable_type) %>%
add_column(type = type, reason = reason) %>% # add type and reason
distinct() # select only distinct observations for long format
# Bind to existing entries
bind_rows(changelog, cl_temp)
}
# Set up changelog
changelog <- tibble()
Now that we’re set up, we can delete the unneeded rows…
# Copy of unchanged dataframe
data_old <- data
# Delete observations where rideable_type == docked_bike
data <- data %>% filter(rideable_type != "docked_bike")
# Remove unneeded factor level
data$rideable_type <- fct_drop(data$rideable_type)
… and record the changes we made.
# Changelog entry
changelog <- track_changes(data, data_old, changelog, "removal", "docked_bikes")
I also found on Divvy’s website that their data sets are not
supposed to include any trips with a duration of less than 1 minute,
since these are commonly caused by false starts or users trying to
redock their bikes. Accordingly, I decided to remove these trips. This
also takes care of trips with negative durations. Even though this might
remove a small number of valid observations, the majority of the data
points affected were most likely created through technical errors or
other odd events and are thus invalid.
# Copy of unchanged dataframe
data_old <- data
# Delete observations where ride_duration < 1 min
data <- data %>% filter(ride_duration >= 1)
# Changelog entry
changelog <- track_changes(data, data_old, changelog, "removal", "duration_<_1min")
New distribution
Let’s plot ride duration again for the remaining observations.
# Plot ride duration again
data %>%
my_ggplot() +
geom_histogram(aes(x = ride_duration/60),
binwidth = 1, boundary = 0, color = "black") +
xlab("ride_duration (hours)")
And zoomed in.
# Plot ride duration again zoomed in
data %>%
my_ggplot() +
geom_histogram(aes(x = ride_duration/60),
binwidth = 1, boundary = 0, color = "black") +
coord_cartesian(ylim = c(0, 150000)) +
xlab("ride_duration (hours)")
This looks much better already. The range has gotten a lot smaller.
However, there are still some very long trips and the spike in trips
that took between 24 and 25 hours is particularly odd.
We could simply choose an arbitrary cutoff e.g. based on Tukey (upper
quartile + 1.5*IQR), even though that one in particular seems a bit
conservative in this case as it would throw out all trips with a
duration of more than half an hour. Using the 99th percentile for
example would leave us with only trips lasting less than 1 3/4 hours. An
arbitrary cut off at 3 hours would leave us with 99.68% of
observations.
Even though any arbitrary cutoff will almost certainly remove not
only invalid observations, but valid ones as well, this could easily be
justified by the fact that these extreme customer behaviors should not
affect our marketing recommendations anyway. Instead, we should focus on
properly targetting the majority of casuals, particularly the ones
likely to convert (which are probably not the ones showcasing these
extreme behaviors), rather than attempting to appeal to every single
individual. However, I am curious whether there is a better way to
filter out invalid observations using other variables that might be
related to long trip durations. Accordingly, I will leave the data set
as is for now.
Start and end
location
Other than trip duration, we also need to validate start and end
stations and coordinates. Since there are certain relationships between
station ID (station_id), name (station_name)
and geographical coordinates (lat and lng), it
makes sense to investigate them together rather than individually.
Multiple missing
values
First, lets look at missing values, beginning with observations in
which both start_station_id and
start_station_name are missing.
# Missing start_station_name and start_station_id by rideable_type
data %>%
select(start_station_name, start_station_id, rideable_type) %>%
mutate(across(c(start_station_name, start_station_id), is.na)) %>%
mutate(both = start_station_name & start_station_id) %>%
group_by(rideable_type) %>%
summarize(missing_values = sum(both)) %>%
kable_custom()
|
rideable_type
|
missing_values
|
|
classic_bike
|
0
|
|
electric_bike
|
722973
|
It looks like classic bikes need to be parked at stations, while
electric bikes do not. Fortunately, as we saw earlier, there are no
missing values for start_lat and start_lng, so
we probably don’t need to be worried about the missing values for
start_station_id and start_station_name for
electric bikes. Let’s examine end stations now.
# Missing end_station_name and end_station_id by rideable_type
data %>%
select(end_station_name, end_station_id, rideable_type, member_casual) %>%
mutate(across(c(end_station_name, end_station_id), is.na)) %>%
mutate(both = end_station_name & end_station_id) %>%
group_by(rideable_type, member_casual) %>%
summarize(missing_values = sum(both)) %>%
kable_custom()
|
rideable_type
|
member_casual
|
missing_values
|
|
classic_bike
|
casual
|
4893
|
|
classic_bike
|
member
|
3591
|
|
electric_bike
|
casual
|
362751
|
|
electric_bike
|
member
|
397999
|
Even though classic bikes are supposed to be parked at stations,
that’s obviously not always the case. Earlier, we also noticed that
there were some missing geographic coordinates for end locations. Let’s
summarize these data points to see whether there is a connection.
# Summary where is.na(end_lat & end_lng)
data %>%
filter(is.na(end_lat) & is.na(end_lng)) %>%
summary()
## ride_id rideable_type started_at
## Min. : 5630 classic_bike :4221 Min. :2021-04-01 11:15:46.00
## 1st Qu.:1230585 electric_bike: 0 1st Qu.:2021-06-13 21:57:48.00
## Median :2181890 Median :2021-07-30 20:58:15.00
## Mean :2560832 Mean :2021-08-08 21:45:40.11
## 3rd Qu.:3891815 3rd Qu.:2021-09-17 13:01:17.00
## Max. :5707838 Max. :2022-03-31 13:52:51.00
##
## ended_at start_station_name
## Min. :2021-04-01 18:36:18.00 Streeter Dr & Grand Ave: 80
## 1st Qu.:2021-06-14 20:50:47.00 Millennium Park : 73
## Median :2021-07-31 17:33:55.00 Wabash Ave & Grand Ave : 37
## Mean :2021-08-09 15:04:25.91 Michigan Ave & 8th St : 36
## 3rd Qu.:2021-09-17 18:22:37.00 Michigan Ave & Oak St : 33
## Max. :2022-04-01 14:52:43.00 Dearborn St & Erie St : 29
## (Other) :3933
## start_station_id end_station_name end_station_id
## 13022 : 80 2112 W Peterson Ave : 0 13001 : 0
## 13008 : 73 63rd St Beach : 0 13006 : 0
## 13300 : 47 900 W Harrison St : 0 13008 : 0
## TA1307000117: 37 Aberdeen St & Jackson Blvd: 0 13011 : 0
## 623 : 36 Aberdeen St & Monroe St : 0 13016 : 0
## 13042 : 33 (Other) : 0 (Other): 0
## (Other) :3915 NA's :4221 NA's :4221
## start_lat start_lng end_lat end_lng member_casual
## Min. :41.65 Min. :-87.77 Min. : NA Min. : NA casual:3169
## 1st Qu.:41.87 1st Qu.:-87.66 1st Qu.: NA 1st Qu.: NA member:1052
## Median :41.89 Median :-87.64 Median : NA Median : NA
## Mean :41.88 Mean :-87.64 Mean :NaN Mean :NaN
## 3rd Qu.:41.92 3rd Qu.:-87.62 3rd Qu.: NA 3rd Qu.: NA
## Max. :42.06 Max. :-87.53 Max. : NA Max. : NA
## NA's :4221 NA's :4221
## ride_duration
## Min. : 1.0
## 1st Qu.: 225.2
## Median :1499.8
## Mean :1038.8
## 3rd Qu.:1499.9
## Max. :1559.9
##
None of the observations with missing end_lat and
end_lng have data for station name or ID that could be used
to infer the missing values. Also notice that these are all classic
bikes, more than three quarters of these trips were made by casuals and
the ride durations are extremely high. Whether they represent cases of
misuse or technical errors, these observations are very likely invalid
and at the very least irrelevant for what we are looking to achieve.
They can thus be removed.
# Copy of unchanged dataframe
data_old <- data
# Remove where end_lat and end_lng are NA
data <- data %>% filter(!is.na(end_lat) | !is.na(end_lng))
# Changelog entry
changelog <- track_changes(data, data_old, changelog,
"removal", "no_geographical_coordinates")
Deleting these observations did not get rid of all missing values for
end_station_id and end_station_name for
classic bikes. However, the remaining observations at least have
geographical coordinates that could be used to infer station names and
IDs. Let’s look at the summary statistics of those observations.
data %>%
filter((is.na(end_station_id) & rideable_type == "classic_bike")) %>%
summary()
## ride_id rideable_type started_at
## Min. : 5746 classic_bike :4263 Min. :2021-04-01 10:41:01.00
## 1st Qu.:2126199 electric_bike: 0 1st Qu.:2021-07-04 18:21:15.00
## Median :3372609 Median :2021-09-04 22:01:52.00
## Mean :3186632 Mean :2021-09-05 06:17:35.26
## 3rd Qu.:4601606 3rd Qu.:2021-10-26 05:32:42.50
## Max. :5703180 Max. :2022-03-31 18:03:24.00
##
## ended_at start_station_name
## Min. :2021-04-01 10:47:45.00 Streeter Dr & Grand Ave : 71
## 1st Qu.:2021-07-04 20:16:18.00 Clark St & Elm St : 45
## Median :2021-09-05 08:13:54.00 Wabash Ave & Grand Ave : 41
## Mean :2021-09-05 09:40:08.64 Fairbanks Ct & Grand Ave : 37
## 3rd Qu.:2021-10-26 07:42:41.00 Clinton St & Washington Blvd: 35
## Max. :2022-03-31 19:52:43.00 Michigan Ave & Washington St: 34
## (Other) :4000
## start_station_id end_station_name end_station_id
## 13022 : 71 2112 W Peterson Ave : 0 13001 : 0
## 13300 : 48 63rd St Beach : 0 13006 : 0
## TA1307000039: 45 900 W Harrison St : 0 13008 : 0
## TA1307000117: 41 Aberdeen St & Jackson Blvd: 0 13011 : 0
## TA1305000003: 37 Aberdeen St & Monroe St : 0 13016 : 0
## WL-012 : 35 (Other) : 0 (Other): 0
## (Other) :3986 NA's :4263 NA's :4263
## start_lat start_lng end_lat end_lng
## Min. :41.65 Min. :-87.77 Min. :41.65 Min. :-87.77
## 1st Qu.:41.88 1st Qu.:-87.66 1st Qu.:41.88 1st Qu.:-87.66
## Median :41.90 Median :-87.64 Median :41.89 Median :-87.64
## Mean :41.90 Mean :-87.64 Mean :41.90 Mean :-87.64
## 3rd Qu.:41.93 3rd Qu.:-87.63 3rd Qu.:41.93 3rd Qu.:-87.63
## Max. :42.06 Max. :-87.54 Max. :42.06 Max. :-87.54
##
## member_casual ride_duration
## casual:1724 Min. : 1.017
## member:2539 1st Qu.: 16.983
## Median : 49.083
## Mean : 202.556
## 3rd Qu.: 196.292
## Max. :1559.683
##
Apparently, these values are not missing at random, as their ride
durations are highly different from the rest of the observations. I
cannot see any reasons why this would be the case if these data points
were valid, so I am going to delete them.
# Copy of unchanged dataframe
data_old <- data
# Delete classic bike trip with no end station
data <- data %>%
filter(!(is.na(end_station_id) & rideable_type == "classic_bike"))
# Changelog entry
changelog <- track_changes(data, data_old, changelog,
"removal", "classic_and_no_end_station")
Missing station name
or ID
Let’s now look at observations where either station name
or ID, and/or either latitude or
longitude are missing. In order to do so efficiently for start and end
locations at the same time, I am going to first reshape the data frame
to a longer format, where start and end location of a given trip each
make up distinct observations.
# Long format for stations
data <- data %>%
pivot_longer(cols = matches("^start_|^end_"),
names_to = c("type", ".value"),
names_pattern = '(^[^_]+(?=_))_(.*)') %>%
mutate(type = as.factor(type))
# Glimpse
glimpse(data)
## Rows: 10,647,152
## Columns: 11
## $ ride_id <int> 1, 1, 4, 4, 7, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 13…
## $ rideable_type <fct> classic_bike, classic_bike, classic_bike, classic_bike, …
## $ started_at <dttm> 2021-04-12 18:25:36, 2021-04-12 18:25:36, 2021-04-17 09…
## $ ended_at <dttm> 2021-04-12 18:56:55, 2021-04-12 18:56:55, 2021-04-17 09…
## $ member_casual <fct> member, member, member, member, casual, casual, casual, …
## $ ride_duration <dbl> 31.316667, 31.316667, 25.100000, 25.100000, 1.433333, 1.…
## $ type <fct> start, end, start, end, start, end, start, end, start, e…
## $ station_name <fct> State St & Pearson St, Southport Ave & Waveland Ave, Hon…
## $ station_id <fct> TA1307000061, 13235, TA1305000034, 13235, 16948, 16948, …
## $ lat <dbl> 41.89745, 41.94815, 41.90312, 41.94815, 41.77937, 41.779…
## $ lng <dbl> -87.62872, -87.66394, -87.67394, -87.66394, -87.66484, -…
This format will make the upcoming operations much easier. Now we can
look for observations with either missing station name
or ID for start and end stations at the same time.
# Find observations where one is missing
data %>%
filter((is.na(station_name) & !is.na(station_id)) |
(is.na(station_id) & !is.na(station_name)) |
(is.na(lat) & !is.na(lng)) |
(is.na(lng) & !is.na(lat))) %>%
kable_custom()
|
ride_id
|
rideable_type
|
started_at
|
ended_at
|
member_casual
|
ride_duration
|
type
|
station_name
|
station_id
|
lat
|
lng
|
|
2167722
|
electric_bike
|
2021-07-18 03:44:22
|
2021-07-18 04:12:23
|
casual
|
28.0
|
start
|
NA
|
13221
|
41.9
|
-87.7
|
|
3293222
|
electric_bike
|
2021-09-21 18:18:59
|
2021-09-21 18:21:48
|
casual
|
2.8
|
start
|
NA
|
20215
|
41.6
|
-87.5
|
|
3900741
|
electric_bike
|
2021-09-22 07:14:42
|
2021-09-22 07:22:38
|
casual
|
7.9
|
start
|
NA
|
WL-008
|
41.9
|
-87.6
|
All three observations are missing start station names. Let’s see
whether we can use the station IDs to find their names.
# Find all station names associated with the three station IDs
data %>%
select(station_id, station_name) %>%
filter(station_id %in% c("13221", "20215", "WL-008")) %>%
group_by(station_id, station_name) %>%
summarize(n = n()) %>%
kable_custom()
|
station_id
|
station_name
|
n
|
|
13221
|
Wood St & Milwaukee Ave
|
32645
|
|
13221
|
NA
|
1
|
|
20215
|
Hegewisch Metra Station
|
142
|
|
20215
|
NA
|
1
|
|
WL-008
|
Clinton St & Roosevelt Rd
|
16114
|
|
WL-008
|
NA
|
1
|
Each of the three IDs is associated with one specific station name,
which is only missing for one observation. Since there is nothing
curious about the observations, other than the missing station name, I
will simply assign the station names based on their IDs. Now that the
data is in this longer format, we need to be careful with our changelog,
since two removed rows do not necessarily equate to two removed
observations, since both rows could belong to the same trip. I am going
to use “n” to refer to the number of deleted rows and “trips” to refer
to the number of deleted observations.
# Copy of unchanged dataframe
data_old <- data
# Assign station names based on station IDs
data <- data %>%
mutate(station_name = as.factor(case_when(
station_id == "13221" ~ "Wood St & Milwaukee Ave",
station_id == "20215" ~ "Hegewisch Metra Station",
station_id == "WL-008" ~ "Clinton St & Roosevelt Rd",
TRUE ~ as.character(station_name))))
# Changelog entry
changelog <- track_changes(data, data_old, changelog,
"modification", "fix_NA_station_names")
Station names
associated with multiple IDs
Next, I would like to know whether there are any station names that
are associated with more than one station ID.
# Find station_names that are associated with multiple station_ids
data %>%
mutate(start = ifelse(type == "start", TRUE, FALSE),
end = ifelse(type == "end", TRUE, FALSE)) %>%
group_by(station_name, station_id) %>%
summarize(n = n(),
start = as.logical(sum(start)),
end = as.logical(sum(end))) %>%
group_by(station_name) %>%
filter(n() > 1) %>%
kable_custom()
|
station_name
|
station_id
|
n
|
start
|
end
|
|
Lakefront Trail & Bryn Mawr Ave
|
KA1504000152
|
28894
|
TRUE
|
TRUE
|
|
Lakefront Trail & Bryn Mawr Ave
|
15576
|
1055
|
TRUE
|
TRUE
|
|
Loomis St & 89th St
|
201022
|
253
|
TRUE
|
TRUE
|
|
Loomis St & 89th St
|
20102
|
88
|
TRUE
|
TRUE
|
There are two station names in our data set that each are associated
with two different IDs. We should try to find out whether, despite
having two IDs, these station names still always refer to the same
station. In order to do so, we can look at their geographical
coordinates and the time frames in which each station has been used. We
will only consider classic bike trips, since geographical coordinates
are more variable for electric bikes and can vary even for individual
stations.
# Look at stations that are associated with multiple IDs
data %>%
filter(station_name %in% c("Lakefront Trail & Bryn Mawr Ave",
"Loomis St & 89th St") &
rideable_type == "classic_bike") %>%
group_by(station_name, station_id, lat, lng) %>%
summarize(min = min(started_at),
max = max(started_at)) %>%
kable_custom()
|
station_name
|
station_id
|
lat
|
lng
|
min
|
max
|
|
Lakefront Trail & Bryn Mawr Ave
|
KA1504000152
|
42.0
|
-87.7
|
2021-04-01 09:37:21
|
2022-02-25 23:49:20
|
|
Lakefront Trail & Bryn Mawr Ave
|
15576
|
42.0
|
-87.7
|
2022-02-28 14:56:25
|
2022-03-31 22:05:02
|
|
Loomis St & 89th St
|
201022
|
41.7
|
-87.7
|
2021-05-20 18:37:39
|
2021-10-11 10:33:28
|
|
Loomis St & 89th St
|
20102
|
41.7
|
-87.7
|
2021-12-06 07:13:46
|
2022-03-26 15:29:01
|
It seems that both stations were closed for a bit and then reopened
under the same name but using a different ID. However, Loomis St
& 89th St stayed in exactly the same location, while
Lakefront Trail & Bryn Mawr Ave seemed to only have moved
slightly. We can calculate the distance in meters via the Haversine
Distance.
# Distance between two station versions
geosphere::distHaversine(c(41.98404, -87.65231), c(41.98404, -87.65228))
## [1] 3.339585
Since Loomis St & 89th St has not moved at all and
Lakefront Trail & Bryn Mawr Ave moved less than 3.5m, I
think it makes sense for our purposes to treat both “versions” of each
station as the same station. Hence, I will replace the old IDs with the
new ones. But first, we need to make sure that neither of the IDs is
associated with another station name.
# Find all station names associated with IDs
data %>%
filter(station_id %in% c("KA1504000152", "15576", "201022", "20102")) %>%
group_by(station_id, station_name) %>%
summarize(n = n()) %>%
kable_custom()
|
station_id
|
station_name
|
n
|
|
KA1504000152
|
Lakefront Trail & Bryn Mawr Ave
|
28894
|
|
201022
|
Loomis St & 89th St
|
253
|
|
20102
|
Loomis St & 89th St
|
88
|
|
15576
|
Lakefront Trail & Bryn Mawr Ave
|
1055
|
Seems like we’re good to go, so we can simply replace the old IDs
with the new ones.
# Copy of unchanged dataframe
data_old <- data
# Same IDs for same stations
data <- data %>%
mutate(station_id = as.factor(case_when(
station_id == "KA1504000152" ~ "15576",
station_id == "201022" ~ "20102",
TRUE ~ as.character(station_id))))
# Changelog entry
changelog <- track_changes(data, data_old, changelog,
"modification", "multiple_IDs_for_same_station")
Station IDs
associated with multiple names
Now that we’ve looked at station names that are associated with
multiple IDs, we can do the same the other way around.
# Find station_IDs that are associated with multiple station_names
data %>%
mutate(start = ifelse(type == "start", TRUE, FALSE),
end = ifelse(type == "end", TRUE, FALSE)) %>%
group_by(station_name, station_id) %>%
summarize(n = n(),
min = min(ride_duration),
mean = mean(ride_duration),
median = median(ride_duration),
max = max(ride_duration),
casuals_perc = 100*sum(member_casual == "casual")/n(),
start = as.logical(sum(start)),
end = as.logical(sum(end))) %>%
group_by(station_id) %>%
filter(n() > 1) %>%
arrange(station_id) %>%
relocate(2) %>%
kable_custom() %>%
scroll_box(width = "100%", height = "300px")
|
station_id
|
station_name
|
n
|
min
|
mean
|
median
|
max
|
casuals_perc
|
start
|
end
|
|
13099
|
Halsted St & 18th St
|
3335
|
1.0
|
18.4
|
12.8
|
1141.8
|
39.1
|
TRUE
|
TRUE
|
|
13099
|
Halsted St & 18th St (Temp)
|
3467
|
1.0
|
16.3
|
12.0
|
422.1
|
40.6
|
TRUE
|
TRUE
|
|
13300
|
DuSable Lake Shore Dr & Monroe St
|
36255
|
1.0
|
32.5
|
25.4
|
1271.5
|
68.7
|
TRUE
|
TRUE
|
|
13300
|
Lake Shore Dr & Monroe St
|
31655
|
1.0
|
34.0
|
26.6
|
1388.7
|
69.9
|
TRUE
|
TRUE
|
|
351
|
351
|
2
|
17.1
|
27.7
|
27.7
|
38.3
|
100.0
|
TRUE
|
FALSE
|
|
351
|
Mulligan Ave & Wellington Ave
|
533
|
1.2
|
15.9
|
9.7
|
214.1
|
40.5
|
TRUE
|
TRUE
|
|
444
|
N Shore Channel Trail & Argyle Ave
|
21
|
3.5
|
18.7
|
9.7
|
72.0
|
47.6
|
TRUE
|
TRUE
|
|
444
|
N Shore Channel Trail & Argyle St
|
56
|
3.3
|
19.8
|
13.6
|
89.8
|
42.9
|
TRUE
|
TRUE
|
|
LF-005
|
DuSable Lake Shore Dr & North Blvd
|
48478
|
1.0
|
23.4
|
17.7
|
1431.3
|
57.5
|
TRUE
|
TRUE
|
|
LF-005
|
Lake Shore Dr & North Blvd
|
40753
|
1.0
|
25.0
|
19.2
|
1406.9
|
60.1
|
TRUE
|
TRUE
|
|
TA1305000039
|
Elston Ave & Cortland St
|
14101
|
1.0
|
13.8
|
10.9
|
692.6
|
40.2
|
TRUE
|
TRUE
|
|
TA1305000039
|
Marshfield Ave & Cortland St
|
2786
|
1.0
|
18.1
|
13.5
|
1335.4
|
34.9
|
TRUE
|
TRUE
|
|
TA1306000029
|
DuSable Lake Shore Dr & Ohio St
|
18667
|
1.0
|
24.5
|
16.9
|
1222.1
|
54.7
|
TRUE
|
TRUE
|
|
TA1306000029
|
Lake Shore Dr & Ohio St
|
15983
|
1.0
|
27.3
|
19.3
|
1012.2
|
53.9
|
TRUE
|
TRUE
|
|
TA1306000029
|
McClurg Ct & Ohio St
|
2902
|
1.0
|
21.8
|
10.2
|
1435.5
|
24.1
|
TRUE
|
TRUE
|
|
TA1307000041
|
DuSable Lake Shore Dr & Wellington Ave
|
24115
|
1.0
|
21.0
|
16.3
|
1058.8
|
42.8
|
TRUE
|
TRUE
|
|
TA1307000041
|
Lake Shore Dr & Wellington Ave
|
17936
|
1.0
|
23.2
|
17.8
|
1082.9
|
45.3
|
TRUE
|
TRUE
|
|
TA1309000039
|
DuSable Lake Shore Dr & Diversey Pkwy
|
22807
|
1.0
|
20.7
|
15.5
|
1200.9
|
45.3
|
TRUE
|
TRUE
|
|
TA1309000039
|
Lake Shore Dr & Diversey Pkwy
|
18290
|
1.0
|
22.9
|
16.8
|
1368.9
|
48.9
|
TRUE
|
TRUE
|
|
TA1309000049
|
DuSable Lake Shore Dr & Belmont Ave
|
24713
|
1.0
|
22.1
|
17.1
|
1390.9
|
45.9
|
TRUE
|
TRUE
|
|
TA1309000049
|
Lake Shore Dr & Belmont Ave
|
17224
|
1.0
|
24.7
|
19.3
|
940.9
|
50.6
|
TRUE
|
TRUE
|
Since, by design, IDs can be associated with multiple names, it is
not surprising that we found a few of those cases. I won’t change those
station names to be consistent, since it’s perfectly possible that the
names actually changed at some point. However, it is important to take
this into account later when analyzing members and casuals regarding
their station usage, when we might be better off using IDs rather than
names. Other than that, the one thing that seems a bit strange is
station “351” whose name is the same as its ID. However, other than what
is apparently a naming error that only occurred twice, the station seems
perfectly normal. I think we can simply change the station name for
those two observations and keep them in our data set.
# Copy of unchanged dataframe
data_old <- data
# Change station name according to ID
data <- data %>%
mutate(station_name = ifelse(station_name == "351",
"Mulligan Ave & Wellington Ave",
as.character(station_name)) %>%
as.factor())
# Changelog entry
changelog <- track_changes(data, data_old, changelog,
"modification", "ID_instead_of_name")
Curious station names
and IDs
Let’s see whether there are any more observations where station ID
and name are identical.
# Identical station ID and name
data %>%
filter(as.character(station_id) == as.character(station_name)) %>%
group_by(station_id, station_name) %>%
summarize(n = n(),
min = min(ride_duration),
mean = mean(ride_duration),
median = median(ride_duration),
max = max(ride_duration),
casuals_perc = 100*sum(member_casual == "casual")/n()) %>%
kable_custom()
|
station_id
|
station_name
|
n
|
min
|
mean
|
median
|
max
|
casuals_perc
|
|
Bissell St & Armitage Ave - Charging
|
Bissell St & Armitage Ave - Charging
|
34
|
1.4
|
7.3
|
7.1
|
19.0
|
35.3
|
|
DIVVY CASSETTE REPAIR MOBILE STATION
|
DIVVY CASSETTE REPAIR MOBILE STATION
|
8
|
13.4
|
66.4
|
39.6
|
123.4
|
100.0
|
|
Hastings WH 2
|
Hastings WH 2
|
3
|
1.1
|
1.2
|
1.1
|
1.3
|
0.0
|
|
Pawel Bialowas - Test- PBSC charging station
|
Pawel Bialowas - Test- PBSC charging station
|
2
|
2.6
|
2.6
|
2.6
|
2.6
|
100.0
|
|
Throop/Hastings Mobile Station
|
Throop/Hastings Mobile Station
|
1
|
19.9
|
19.9
|
19.9
|
19.9
|
0.0
|
|
Wilton Ave & Diversey Pkwy - Charging
|
Wilton Ave & Diversey Pkwy - Charging
|
38
|
1.1
|
8.7
|
6.9
|
28.2
|
26.3
|
Based on their names, their very low traffic and the mostly unusual
ride durations, these stations seem to be service or repair stations.
They are probably used mainly for service trips and thus irrelevant to
our analysis and can be removed.
# Copy of unchanged dataframe
data_old <- data
# Delete observations where station ID and name are identical
data <- data %>%
filter(as.character(station_id) != as.character(station_name) |
is.na(station_id) | is.na(station_name))
# Changelog entry
changelog <- track_changes(data, data_old, changelog,
"removal", "identical_ID_and_name")
Now we should check if there are any other stations that contain the
key words “test”, “repair” or “charging”.
# Search for other stations
data %>%
filter(if_any(matches("name$|id$"),
~ str_detect(.,regex("test|repair|charging",
ignore_case = TRUE)))) %>%
group_by(station_id, station_name) %>%
summarize(n = n(),
min = min(ride_duration),
mean = mean(ride_duration),
median = median(ride_duration),
max = max(ride_duration),
casuals_perc = 100*sum(member_casual == "casual")/n()) %>%
kable_custom()
|
station_id
|
station_name
|
n
|
min
|
mean
|
median
|
max
|
casuals_perc
|
|
Hubbard Bike-checking (LBS-WH-TEST)
|
Base - 2132 W Hubbard Warehouse
|
854
|
1.1
|
51.2
|
13.9
|
1479.0
|
20.3
|
This station too seems to be a service station or warehouse which is
used for internal operations. The observations are thus likely
irrelevant and can be removed.
# Copy of unchanged dataframe
data_old <- data
# Delete Warehouse observations
data <- data %>%
filter(station_name != "Base - 2132 W Hubbard Warehouse" |
is.na(station_name))
# Changelog entry
changelog <- track_changes(data, data_old, changelog, "removal", "warehouse")
Let’s see if there are other station names or IDs containing the word
“warehouse”.
# Stations names or IDs that contain the word "warehouse"
data %>%
filter(if_any(matches("name$|id$"),
~ str_detect(.,regex("warehouse",
ignore_case = TRUE)))) %>%
group_by(station_id, station_name) %>%
summarize(n = n(),
min = min(ride_duration),
mean = mean(ride_duration),
median = median(ride_duration),
max = max(ride_duration),
casuals_perc = 100*sum(member_casual == "casual")/n()) %>%
kable_custom()
## Warning in min(ride_duration): no non-missing arguments to min; returning Inf
## Warning in max(ride_duration): no non-missing arguments to max; returning -Inf
|
station_id
|
station_name
|
n
|
min
|
mean
|
median
|
max
|
casuals_perc
|
The search did not identify any other stations. This is all I can
think of in terms of cleaning station IDs and names. Lastly, let’s check
for the extreme values in start_lat and
start_lng that we saw earlier.
# Find min and max coordinates
data %>%
summarize(min_lat = min(lat),
max_lat = max(lat),
min_lng = min(lng),
max_lng = max(lng)) %>%
kable_custom()
|
min_lat
|
max_lat
|
min_lng
|
max_lng
|
|
41.4
|
42.2
|
-89.0
|
-87.5
|
Seems like we already deleted those extreme observations, as these
values here all fall within the expected range.
Ride duration II
Recheck
distribution
All that’s left to do now is examine ride duration in combination
with start and end locations in order to possibly identify more invalid
data points. First, we need to get the data frame back into its original
format.
# Keep only full observations (start and end)
duplicate_ids <- table(data$ride_id) %>% .[.>1] %>% names() %>% as.numeric()
data <- data %>% filter(ride_id %in% duplicate_ids)
# Transform long to wide
data <- data %>%
pivot_wider(names_from = "type",
values_from = c("station_name", "station_id", "lat", "lng"),
names_glue = "{type}_{.value}") %>%
relocate(colnames(data_raw))
# Drop unneeded levels
data <- droplevels(data)
Plot trip duration again to see whether anything has changed.
# Plot ride duration again
data %>%
my_ggplot() +
geom_histogram(aes(x = ride_duration/60),
binwidth = 1, boundary = 0, color = "black") +
xlab("ride_duration (hours)")
Zoom in and plot by bike and membership type.
# Plot ride duration again zoomed in by group
data %>%
my_ggplot() +
geom_histogram(aes(x = ride_duration/60),
binwidth = 1, boundary = 0, color = "black") +
coord_cartesian(ylim = c(0, 1500)) +
xlab("ride_duration (hours)") +
facet_grid(rows = vars(member_casual), cols = vars(rideable_type))
Compared to the last time we examined ride_duration, we
got rid of all of the values that were larger than 25 hours, as well as
the spike in the number of trips that took between 24 and 25 hours.
Ride duration by
station
Now we can bring ride_duration, station_id
and station_name together to hopefully identify some
patterns in the remaining outliers in terms of start and/or end station
that allow us to identify invalid observations. In order to do so, we
can look at the stations that are associated with the highest mean ride
durations. If any stations are only associated with unrealistically long
rides, we could remove all observations from those stations.
# Top six start station IDs with highest mean ride duration
data %>%
group_by(start_station_id) %>%
summarize(mean_duration = mean(ride_duration),
n = n()) %>%
arrange(-mean_duration) %>%
head() %>%
kable_custom()
|
start_station_id
|
mean_duration
|
n
|
|
564
|
85.2
|
52
|
|
422
|
75.5
|
7
|
|
20212
|
71.5
|
97
|
|
421
|
67.7
|
5
|
|
20225
|
64.9
|
80
|
|
587
|
55.4
|
55
|
# Top six start station names with highest mean ride duration
data %>%
group_by(start_station_name) %>%
summarize(mean_duration = mean(ride_duration),
n = n()) %>%
arrange(-mean_duration) %>%
head() %>%
kable_custom()
|
start_station_name
|
mean_duration
|
n
|
|
Racine Ave & 65th St
|
85.2
|
52
|
|
Albany Ave & 16th St
|
75.5
|
7
|
|
Altgeld Gardens
|
71.5
|
97
|
|
Albany Ave & Douglas Blvd
|
67.7
|
5
|
|
Commercial Ave & 100th St
|
64.9
|
80
|
|
Wabash Ave & 83rd St
|
55.4
|
55
|
# Top six end station IDs with highest mean ride duration
data %>%
group_by(end_station_id) %>%
summarize(mean_duration = mean(ride_duration),
n = n()) %>%
arrange(-mean_duration) %>%
head() %>%
kable_custom()
|
end_station_id
|
mean_duration
|
n
|
|
564
|
87.3
|
43
|
|
421
|
86.2
|
7
|
|
394
|
57.8
|
18
|
|
20212
|
57.4
|
67
|
|
416
|
54.0
|
6
|
|
586
|
52.4
|
76
|
# Top six end station names with highest mean ride duration
data %>%
group_by(end_station_name) %>%
summarize(mean_duration = mean(ride_duration),
n = n()) %>%
arrange(-mean_duration) %>%
head() %>%
kable_custom()
|
end_station_name
|
mean_duration
|
n
|
|
Racine Ave & 65th St
|
87.3
|
43
|
|
Albany Ave & Douglas Blvd
|
86.2
|
7
|
|
Panama Ave & Grace St
|
57.8
|
18
|
|
Altgeld Gardens
|
57.4
|
67
|
|
Washtenaw Ave & Madison St
|
54.0
|
6
|
|
MLK Jr Dr & 83rd St
|
52.4
|
76
|
Looks like no stations are exclusively used for extreme outliers in
terms of ride duration. Unfortunately, this means that there are no
patterns in the remaining observations that can help us identify invalid
data points or find a ride duration cut-off.
Choosing a cut-off
value
Given the size of the current data set, a few invalid data points
would probably not affect our analysis too much. Yet, for reasons
mentioned earlier (properly focusing on the majority of customers and
potential members rather than trying to please every single one and
letting extreme customer behaviors affect our marketing, possibly
resulting in not properly targeting any customers), I would prefer to
exclude some more outliers. Since there is no clear cut-off or other
criteria by which we can define outliers or identify invalid data
points, we will simply have to make a somewhat arbitrary but informed
decision.
According to their website, Divvy memberships include unlimited
45 minute rides, after which members need to either switch bikes or pay
$0.16 per minute. Non-members have to pay $1 to unlock the bike and then
start paying $0.16 per minute straight from the start. A day pass
includes unlimited 3-hour rides. Based on this information, it is
relatively unlikely for anyone, member or casual, to ride their bike for
more than three hours, since they could just switch bikes earlier to
avoid any additional costs. Also, it would be pointless for customers
that regularly do trips lasting 2 1/3 hours or longer to switch to a
membership, because at $0.16 per minute, a trip like that would already
be more expensive than a day pass, even for a member that only starts
paying after 45 minutes. Accordingly, unless Cyclistic are looking to
change their membership conditions or pricing, these customers are not
our targets for memberships. Yet, I will include every trip up to a
duration of 4 hours. This will include people using a day pass and
allows for a little margin on top of those three hours to include even
those that perhaps miscalculated the duration of their trip or
underestimated how long it would take them to get to the next station.
However, I might subset the data set based on trip duration later in my
analysis, depending on which question I am looking to answer.
# Copy of unchanged dataframe
data_old <- data
# Exclude trip durations of more than 4 hours
data <- data %>% filter(ride_duration <= 240)
# Changelog entry
changelog <- track_changes(data, data_old, changelog,
"removal", "duration_>_240min")
Wrap-up
Additional
variables
Before summarizing the data again, let’s add some time related
variables that will be interesting to analyze later.
# Add day of the week, weekend, weekm month, time of day and date
data <- data %>%
mutate(day_of_week = lubridate::wday(started_at, label = T, week_start = 1),
weekend = as.factor(ifelse(day_of_week %in% c("Sat", "Sun"),
"weekend",
"weekday")),
week = lubridate::isoweek(started_at),
month = lubridate::month(started_at, label = T, abbr = T),
hour = lubridate::hour(started_at),
minute = hour + lubridate::minute(started_at)/60,
second = minute + lubridate::second(started_at)/3600,
date = lubridate::date(started_at))
Summary and
Changelog
Now we can summarize the resulting data set…
# Summarize final data set
summary(data)
## ride_id rideable_type started_at
## Min. : 1 classic_bike :3194662 Min. :2021-04-01 00:03:18.0
## 1st Qu.:1465136 electric_bike:2121520 1st Qu.:2021-06-23 21:16:06.0
## Median :2913560 Median :2021-08-19 20:51:46.5
## Mean :2896478 Mean :2021-08-28 15:30:50.2
## 3rd Qu.:4333891 3rd Qu.:2021-10-16 16:39:39.0
## Max. :5723532 Max. :2022-03-31 23:59:47.0
##
## ended_at start_station_name
## Min. :2021-04-01 00:14:29.00 Streeter Dr & Grand Ave: 64425
## 1st Qu.:2021-06-23 21:35:18.25 Wells St & Concord Ln : 41950
## Median :2021-08-19 21:10:19.00 Clark St & Elm St : 39352
## Mean :2021-08-28 15:47:39.69 Michigan Ave & Oak St : 36958
## 3rd Qu.:2021-10-16 16:58:19.50 Wells St & Elm St : 36304
## Max. :2022-04-01 00:27:32.00 (Other) :4375139
## NA's : 722054
## start_station_id end_station_name
## 13022 : 64425 Streeter Dr & Grand Ave: 63326
## TA1308000050: 41950 Wells St & Concord Ln : 42280
## LF-005 : 41657 Clark St & Elm St : 38784
## TA1307000039: 39352 Michigan Ave & Oak St : 37074
## 13042 : 36958 Wells St & Elm St : 36215
## (Other) :4369786 (Other) :4339249
## NA's : 722054 NA's : 759254
## end_station_id start_lat start_lng end_lat
## 13022 : 63326 Min. :41.64 Min. :-87.84 Min. :41.39
## LF-005 : 47484 1st Qu.:41.88 1st Qu.:-87.66 1st Qu.:41.88
## TA1308000050: 42280 Median :41.90 Median :-87.64 Median :41.90
## TA1307000039: 38784 Mean :41.90 Mean :-87.65 Mean :41.90
## 13042 : 37074 3rd Qu.:41.93 3rd Qu.:-87.63 3rd Qu.:41.93
## (Other) :4327980 Max. :42.07 Max. :-87.52 Max. :42.17
## NA's : 759254
## end_lng member_casual ride_duration day_of_week
## Min. :-88.97 casual:2199527 Min. : 1.000 Mon:683543
## 1st Qu.:-87.66 member:3116655 1st Qu.: 6.567 Tue:724709
## Median :-87.64 Median : 11.400 Wed:744932
## Mean :-87.65 Mean : 16.825 Thu:727881
## 3rd Qu.:-87.63 3rd Qu.: 20.150 Fri:761306
## Max. :-87.49 Max. :239.967 Sat:888503
## Sun:785308
## weekend week month hour
## weekday:3642371 Min. : 1.0 Jul : 749866 Min. : 0.00
## weekend:1673811 1st Qu.:22.0 Aug : 745893 1st Qu.:11.00
## Median :30.0 Sep : 707872 Median :15.00
## Mean :29.6 Jun : 663994 Mean :14.21
## 3rd Qu.:38.0 Oct : 596885 3rd Qu.:18.00
## Max. :52.0 May : 478734 Max. :23.00
## (Other):1372938
## minute second date
## Min. : 0.00 Min. : 0.00 Min. :2021-04-01
## 1st Qu.:11.42 1st Qu.:11.43 1st Qu.:2021-06-23
## Median :15.55 Median :15.55 Median :2021-08-19
## Mean :14.70 Mean :14.71 Mean :2021-08-28
## 3rd Qu.:18.37 3rd Qu.:18.37 3rd Qu.:2021-10-16
## Max. :23.98 Max. :24.00 Max. :2022-03-31
##
… and examine the changelog.
# Changelog by type and membership
changelog %>%
group_by(type, member_casual) %>%
summarize(trips = n()) %>%
kable_custom()
|
type
|
member_casual
|
trips
|
|
modification
|
casual
|
11163
|
|
modification
|
member
|
16350
|
|
removal
|
casual
|
347015
|
|
removal
|
member
|
60335
|
# Changelog by type and bike type
changelog %>%
group_by(type, rideable_type) %>%
summarize(trips = n()) %>%
kable_custom()
|
type
|
rideable_type
|
trips
|
|
modification
|
classic_bike
|
20992
|
|
modification
|
electric_bike
|
6521
|
|
removal
|
classic_bike
|
56029
|
|
removal
|
docked_bike
|
303989
|
|
removal
|
electric_bike
|
47332
|
# Changelog by type, reason and membership
changelog %>%
group_by(type, reason, member_casual) %>%
summarize(trips = n()) %>%
kable_custom(full_width = TRUE) %>%
scroll_box(height = "300px", width = "500px")
|
type
|
reason
|
member_casual
|
trips
|
|
modification
|
fix_NA_station_names
|
casual
|
3
|
|
modification
|
ID_instead_of_name
|
casual
|
2
|
|
modification
|
multiple_IDs_for_same_station
|
casual
|
11158
|
|
modification
|
multiple_IDs_for_same_station
|
member
|
16350
|
|
removal
|
classic_and_no_end_station
|
casual
|
1724
|
|
removal
|
classic_and_no_end_station
|
member
|
2539
|
|
removal
|
docked_bikes
|
casual
|
303989
|
|
removal
|
duration_<_1min
|
casual
|
33234
|
|
removal
|
duration_<_1min
|
member
|
54249
|
|
removal
|
duration_>_240min
|
casual
|
4700
|
|
removal
|
duration_>_240min
|
member
|
1764
|
|
removal
|
identical_ID_and_name
|
casual
|
29
|
|
removal
|
identical_ID_and_name
|
member
|
52
|
|
removal
|
no_geographical_coordinates
|
casual
|
3169
|
|
removal
|
no_geographical_coordinates
|
member
|
1052
|
|
removal
|
warehouse
|
casual
|
170
|
|
removal
|
warehouse
|
member
|
679
|
# Changelog by type, bike type and membership
changelog %>%
group_by(type, rideable_type, member_casual) %>%
summarize(trips = n()) %>%
kable_custom(full_width = TRUE) %>%
scroll_box(height = "300px", width = "400px")
|
type
|
rideable_type
|
member_casual
|
trips
|
|
modification
|
classic_bike
|
casual
|
7539
|
|
modification
|
classic_bike
|
member
|
13453
|
|
modification
|
electric_bike
|
casual
|
3624
|
|
modification
|
electric_bike
|
member
|
2897
|
|
removal
|
classic_bike
|
casual
|
22048
|
|
removal
|
classic_bike
|
member
|
33981
|
|
removal
|
docked_bike
|
casual
|
303989
|
|
removal
|
electric_bike
|
casual
|
20978
|
|
removal
|
electric_bike
|
member
|
26354
|
# Changelog by type, reason, bike type and membership
changelog %>%
group_by(type, reason, rideable_type, member_casual) %>%
summarize(trips = n()) %>%
kable_custom(full_width = TRUE) %>%
scroll_box(height = "300px", width = "600px")
|
type
|
reason
|
rideable_type
|
member_casual
|
trips
|
|
modification
|
fix_NA_station_names
|
electric_bike
|
casual
|
3
|
|
modification
|
ID_instead_of_name
|
electric_bike
|
casual
|
2
|
|
modification
|
multiple_IDs_for_same_station
|
classic_bike
|
casual
|
7539
|
|
modification
|
multiple_IDs_for_same_station
|
classic_bike
|
member
|
13453
|
|
modification
|
multiple_IDs_for_same_station
|
electric_bike
|
casual
|
3619
|
|
modification
|
multiple_IDs_for_same_station
|
electric_bike
|
member
|
2897
|
|
removal
|
classic_and_no_end_station
|
classic_bike
|
casual
|
1724
|
|
removal
|
classic_and_no_end_station
|
classic_bike
|
member
|
2539
|
|
removal
|
docked_bikes
|
docked_bike
|
casual
|
303989
|
|
removal
|
duration_<_1min
|
classic_bike
|
casual
|
13289
|
|
removal
|
duration_<_1min
|
classic_bike
|
member
|
29259
|
|
removal
|
duration_<_1min
|
electric_bike
|
casual
|
19945
|
|
removal
|
duration_<_1min
|
electric_bike
|
member
|
24990
|
|
removal
|
duration_>_240min
|
classic_bike
|
casual
|
3793
|
|
removal
|
duration_>_240min
|
classic_bike
|
member
|
942
|
|
removal
|
duration_>_240min
|
electric_bike
|
casual
|
907
|
|
removal
|
duration_>_240min
|
electric_bike
|
member
|
822
|
|
removal
|
identical_ID_and_name
|
classic_bike
|
casual
|
14
|
|
removal
|
identical_ID_and_name
|
classic_bike
|
member
|
37
|
|
removal
|
identical_ID_and_name
|
electric_bike
|
casual
|
15
|
|
removal
|
identical_ID_and_name
|
electric_bike
|
member
|
15
|
|
removal
|
no_geographical_coordinates
|
classic_bike
|
casual
|
3169
|
|
removal
|
no_geographical_coordinates
|
classic_bike
|
member
|
1052
|
|
removal
|
warehouse
|
classic_bike
|
casual
|
59
|
|
removal
|
warehouse
|
classic_bike
|
member
|
152
|
|
removal
|
warehouse
|
electric_bike
|
casual
|
111
|
|
removal
|
warehouse
|
electric_bike
|
member
|
527
|
Save
Finally, we need to save the clean data, so that we can use it in our
analysis. We’ll also save the changelog to document and possibly
communicate the cleaning process.
# Save clean data
save(data, file = "data/r_data/data_cleaned.rda")
# Save changelog
save(changelog, file = "data/r_data/changelog.rda")
Continue with part II here.
