Visualizing Arlington Bikometers

Part 6: Creating the Visualizations

   

Goal

Create a post with similar parameters to the Minnesota DOT’s Covid-19 & Historic Total Traffic Count graph.

Connect to MySQL Database

Load the table into R

counts_daily <- tbl(con, 'counts_daily')
head(counts_daily)

Combining ‘In’ and ‘Out’ Values

Below is the code we created in In Part 5, to combine the ‘I’ and ‘O’ values.

counts_daily_total <- counts_daily %>% 
  group_by(date, bikeometer_id) %>% 
  summarize(count = sum(count), is_weekend = is_weekend, 
            month = month, day = day, year = year, month_day = month_day) %>% 
  collect()

## `summarise()` has grouped output by 'date'. You can override using the `.groups` argument.

counts_daily_total

class(counts_daily_total$month_day)

## [1] "character"

I’m going to manipulate the counts_daily_total ‘tibble’ using the mutate() function.

I realized that I should have used a hyphen instead of an underscore for the ‘month-day’ values so first I need to do some character replacement. I’ll use the mutate() function to make changes to columns and pass in the gsub() function to replace the underscore with a hyphen.

Then, we will add an arbitrary year to the end of month_day to make it easier to convert to a date class and subsequently graph.

counts_daily_total <- counts_daily_total %>% mutate(month_day = gsub("[_]", "-", month_day))

counts_daily_total <- counts_daily_total %>% mutate(month_day=paste(month_day, '-2020', sep = ''))
counts_daily_total

Now, let’s convert month_day to a date class.

class(counts_daily_total$month_day[1])

## [1] "character"

counts_daily_total$month_day <- strptime(counts_daily_total$month_day, '%m-%d-%Y')
class(counts_daily_total$month_day[1])

## [1] "POSIXlt" "POSIXt"

counts_daily_total$month_day <- as.Date(counts_daily_total$month_day)
class(counts_daily_total$month_day[1])

## [1] "Date"

You can see that the column goes from classes ‘character’ to ‘POSIXlt POSIXt’ to finally ‘Date’.

counts_daily_total

Note to self

Originally, class(counts_daily_total$year,month,day == ‘S3 value Bigint’ which doesn’t play nicely with dplyr. Be sure to convert number columns into int before applying filters. Also, when mutating a column, don’t assign the mutate like this:

# Don't use this
counts_daily_total$month_day <- counts_daily_total %>% mutate(month_day = gsub("[_]", "-", month_day))

# Use this!
counts_daily_total <- counts_daily_total %>% mutate(month_day = gsub("[_]", "-", month_day))

Filtering for Date Range and Bikeometer ID

In a previous post, I chose a time-frame and which Bikeometers were best to plot.

counts_daily_filtered_2017_to_2019 <- counts_daily_total %>% 
  filter(date >= '2017-03-12' & date <= '2017-05-15' & bikeometer_id %in% c(14,15,16,18,22,31,39)| 
         date >= '2018-03-12' & date <= '2018-05-15' & bikeometer_id %in% c(14,15,16,18,22,31,39)|
         date >= '2019-03-12' & date <= '2019-05-15' & bikeometer_id %in% c(14,15,16,18,22,31,39))
counts_daily_filtered_2017_to_2019

counts_daily_filtered_2020 <- counts_daily_total %>% 
  filter(date >= '2020-03-12' & date <= '2020-05-15' & bikeometer_id %in% c(14,15,16,18,22,31,39))

counts_daily_filtered_2020

Group the 2020 Bikeometer counts

Now we can can group the counts by taking their average. I’ll rename the column ‘2020_counts’ to make it easier to merge the table later.

counts_daily_filtered_2020_grouped <- counts_daily_filtered_2020 %>% group_by(month_day) %>% summarise('2020_counts' = mean(count))

counts_daily_filtered_2020_grouped

Creating the 2017-2019 Daily Average column

Now that we have two tables, one with 2017-2019 data and one with 2020 data, let’s add a column to the counts_daily_filtered_2017_to_2019 table that shows the average across all Bikeometers.

counts_daily_filtered_2017_to_2019_grouped <- counts_daily_filtered_2017_to_2019 %>% group_by(month_day) %>% summarise('2017-2019_avg_counts' = mean(count))

counts_daily_filtered_2017_to_2019_grouped

We should check to see if the average is being taken correctly. We can manually check the first ‘month_day’ below.

counts_daily_filtered_2017_to_2019 %>% select(month_day, count, date, bikeometer_id) %>%  filter(month_day =='2020-03-12') 

(16 + 140 + 34 + 51 + 250 + 131 + 108 + 28 + 228 + 54 + 48 + 408)/12

## [1] 124.6667

This matches the ‘avg_counts’ value for the ‘2020-03-12’ date!

counts_daily_filtered_2017_to_2019_grouped

counts_daily_filtered_2020_grouped

Let’s now join the ‘counts_daily_filtered_2017_to_2019_grouped’ and the ‘counts_daily_filtered_2020_grouped’ tables so we can graph them.

df <- merge(x = counts_daily_filtered_2017_to_2019_grouped, y = counts_daily_filtered_2020_grouped, by = 'month_day')
df

In order for this table to be easily read by R, we need to covert it from a wide table to a long table. This is the resource I used to understand how to do the conversion.

df.long <- pivot_longer(df, cols=2:3, names_to='year', values_to='counts')
df.long

line <- df.long %>% ggplot(aes(month_day, counts, group = year, color = year)) +
  geom_area(aes(fill = year, group = year), alpha = 0.5, position = 'identity')
line

If you don’t include ‘position = ’identity’ then the counts will stack on top of each other instead of overlapping like above.

You can see the default arguments for a plot by using the args() function.

args(geom_area)

## function (mapping = NULL, data = NULL, stat = "identity", position = "stack", 
##     na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE, 
##     ..., outline.type = "upper") 
## NULL

library(ggthemes)
line <- line + theme_calc() + labs(x = 'Date', title = 'COVID-19 & Historic Total Bike Count')
line

library(plotly)

## 
## Attaching package: 'plotly'

## The following object is masked from 'package:ggplot2':
## 
##     last_plot

## The following object is masked from 'package:stats':
## 
##     filter

## The following object is masked from 'package:graphics':
## 
##     layout

library(ggplot2)
ggplotly(line)

Conclusion

It looks like there definitely was an increase for some days during the 2020 COVID Pandemic but the data isn’t as significant as the MnDOT plot.

This post concludes the work I set out to complete, but there is always more questions to answer. In the next post, I’ll investigate the GPS locations of each chosen Bikeometer and try to draw conclusions from that data.