VMT Comparison
Nate Bean
11/17/2020
This document makes a quick comparison of the Streetlight VMT data and MnDOT’s daily vehicle volume data. The data from these sources is slightly different, but they are both designed to measure vehicle travel across the state and should be correlated. Streetlight’s data is generated using information from location-based services and GPS navigation, while MnDOT’s daily data is generated through continuous traffic counting points. We have a couple longer white papers that further describe how both kinds of data are generated. The figure below shows the trend in statewide VMT using Streetlight data, as well as the dates of several important policies.
metro_counties <- c("Hennepin", "Ramsey", "Dakota", "Carver", "Scott", "washington", "Anoka")
streetlight <- read_csv("./VMT Analysis/Data/streetlight_data_all.csv") %>%
filter(state== "Minnesota") %>%
mutate(date= paste(year, month, day, sep = "-"),
date= as.Date(date),
region = case_when(
county %in% metro_counties ~ "Metro",
TRUE ~ "Greater MN"
)) %>%
select(-c("year", "month", "day"))
sl_MNtotal <- read_csv("./VMT Analysis/Data/streetlight_data_mn.csv") %>%
mutate(date= paste(year, month, day, sep = "-"),
date= as.Date(date),
data= "Streetlight")
ggplot(sl_MNtotal, aes(x=date, y= vmt/1000000))+
geom_bar(stat="identity",color= "white", fill="#1f78b4", alpha=0.3)+
geom_ma(ma_fun=SMA, n=7, color="#1f78b4", size=2, linetype="solid")+
scale_y_continuous(breaks= c(0, 100, 200, 300, 400), expand= c(0,2))+
scale_x_date(expand= c(0,1), date_labels = paste0("%b"," ","1st"), limits = as.Date(c(NA, "2020-11-08")),
date_breaks = "1 month")+
geom_segment(aes(x=as.Date(c("2020-03-05")), y=242, xend=as.Date(c("2020-03-05")), yend=260), size=1.25,
color="black")+
geom_segment(aes(x=as.Date(c("2020-03-26")), y=69, xend=as.Date(c("2020-03-26")), yend=130), size=1.25,
color="black")+
geom_segment(aes(x=as.Date(c("2020-05-18")), y=97, xend=as.Date(c("2020-05-18")), yend=115), size=1.25,
color="black")+
geom_segment(aes(x=as.Date(c("2020-06-01")), y=120, xend=as.Date(c("2020-06-01")), yend=138), size=1.25,
color="black")+
geom_segment(aes(x=as.Date(c("2020-06-10")), y=136, xend=as.Date(c("2020-06-10")), yend=151), size=1.25,
color="black")+
annotate("label", x=as.Date(sl_MNtotal$date[10]), y=274, label="1st Case", family= "Roboto Condensed", size=5,
fill='white', alpha= 0.4, label.size= NA)+
annotate("label", x=as.Date(sl_MNtotal$date[27]), y=115, label="Stay-at-Home \nOrder", family= "Roboto Condensed",
size=5, fill='white', alpha= 0.1, label.size= NA, hjust=0)+
annotate("label", x=as.Date(sl_MNtotal$date[73]), y=128, label="Phase 1", family= "Roboto Condensed", size=5,
fill='white', alpha= 0.4, label.size= NA)+
annotate("label", x=as.Date(sl_MNtotal$date[87]), y=150, label="Phase 2", family= "Roboto Condensed", size=5,
fill='white', alpha= 0.4, label.size= NA)+
annotate("label", x=as.Date(sl_MNtotal$date[102]), y=168, label="Phase 3", family= "Roboto Condensed", size=5,
fill='white', alpha= 0.4, label.size= NA)+
#scale_x_date(limits = as.Date(c(NA, "2020-07-03")))+
theme_classic()+
labs(x="", y="VMT (Millions)",
title= "Minnesota VMT During COVID-19",
caption = "Minnesota's reopening has been broken into phases. Phase 1 ended limits on non-essential \ntravel and allowed some business reopenings. Following phases lifted further restrictions.")+
theme(text= element_text(family= "Roboto Condensed"),
panel.grid.major = element_line(colour="light grey"),
plot.title = element_text(size = 18),
plot.caption = element_text(size=11),
panel.grid.major.x = element_blank(),
axis.text.y = element_text(size=18, color = "black"),
axis.text.x = element_text(size= 15, color = "black", angle= 20, vjust= 0.5),
axis.title.y= element_text(size=20, color="black", margin = margin(r=10)))
The data from MnDOT shows average traffic volume, referred to as Annual Average Daily Traffic (AADT). This measure includes an adjustment for season, day of the week, and vehicle type. It’s generated using data collected through count locations along highways across the state. The particular daily data used to measure the impact of COVID-19 uses a small portion of MnDOT’s overall counting locations that continuously report data. Overall, this data is a bit different than VMT because it captures the number of vehicles on the road, rather than the total number of miles driven. However, the AADT data is used by MnDOT to calculate its own VMT numbers by multiplying the AADT on each road segment by its centerline miles. This data is provided in terms of percent change compared to a baseline volume.
aadt <- read_xlsx("./VMT Analysis/Data/Daily_Volume_Change_2020-11-15_update.xlsx") %>%
clean_names() %>%
pivot_longer(x43891:x44150, names_to= "date", values_to= "volume") %>%
mutate(date= as.Date(as.numeric(str_remove(date, "x")), origin = "1899-12-30"),
district= str_remove(district, "MnDOT "),
data= "aadt") %>%
filter(district == "Statewide")
ggplot(aadt, aes(x= date, y=volume))+
geom_line(color= "#addd8e", alpha=0.3, size=1.2) +
geom_ma(ma_fun=SMA, n=7, size=2, linetype="solid",color="#addd8e")+
#geom_hline(yintercept = 0, color= "orange", linetype= "dashed", size=1)+
theme_classic() +
scale_x_date(limits = as.Date(c(NA, "2020-11-15")), expand= c(0,1), date_labels = paste0("%b"," ","1st"),
date_breaks = "1 month")+
scale_y_continuous(limits = c(-50, 20))+
#geom_vline(xintercept = as.Date(c("2020-03-05")), linetype= "dashed") +
#geom_vline(xintercept = as.Date(c("2020-03-26")), linetype= "dashed") +
#geom_vline(xintercept = as.Date(c("2020-05-18")), linetype= "dashed") +
#geom_vline(xintercept = as.Date(c("2020-06-01")), linetype= "dashed") +
#geom_vline(xintercept = as.Date(c("2020-06-10")), linetype= "dashed") +
labs(
x="",
y="Change (%)",
caption= "Change compared to 2016-2019 baseline. Data from MnDOT.",
title= "Change in Traffic Volume in Minnesota"
) +
theme(text= element_text(family= "Roboto Condensed"),
plot.title = element_text(size=18),
plot.caption = element_text(size = 13),
panel.grid.minor = element_blank(),
panel.grid.major = element_line(colour="light grey"),
panel.grid.major.x = element_blank(),
axis.text.y = element_text(size=18, color = "black"),
axis.text.x = element_text(size= 15, color = "black", vjust=0.5, angle=20),
axis.title.y= element_text(size=18, color="black"),
legend.position = "right",
legend.margin = margin(t= -15),
legend.title = element_text(size=16),
legend.text = element_text(size=16))
Direct Comparison
It is difficult to directly compare the two data sources because there is no baseline from the previous year to compare the Streetlight data to. However, we can at least use the percent change in Streetlight data from the first week of March to get a sense of how the data compares. As shown by the figure, the Streetlight data finds a much deeper drop in VMT during the first wave of the pandemic, but then also a faster recovery until August. After that, the Streetlight shows a decline with MnDOT’s continues with a slow increase. By November, the MnDOT data shows a near-recovery to the historical baseline, while the Streetlight data shows a continued drop of about 40 percent.
mn_vmt <- sl_MNtotal %>%
mutate(data= 'Streetlight',
date= paste(year, month, day, sep = "-"),
date= as.Date(date)) %>%
select(date, data, mar_perc_change) %>%
rename(change= mar_perc_change) %>%
arrange(date)
mn_vol <- aadt %>%
select(-district) %>%
rename(change= volume) %>%
mutate(data= 'MnDOT')
combined <- mn_vol %>%
rbind(mn_vmt)
pal_hl <- c("#addd8e", "#1f78b4")
ggplot()+
geom_ma(data= combined, aes(x= date, y=change, color=data), ma_fun=SMA, n=7, size=2, linetype="solid")+
theme_classic() +
scale_x_date(limits = as.Date(c(NA, "2020-11-15")), expand= c(0,1), date_labels = paste0("%b"," ","1st"),
date_breaks = "1 month")+
scale_color_manual(values= pal_hl)+
#geom_hline(yintercept = 0, color= "orange", linetype= "dashed", size=1)+
labs(
x="",
y="Change (%)",
caption= "MnDOT data shows change in traffic volume compared to 2016-2019 baseline. \nStreetlight data shows VMT change compared to the average in the first week of March.",
title= "Comparison between Streetlight VMT and MnDOT Traffic Volume Data",
color= "Data Source"
) +
theme(text= element_text(family= "Roboto Condensed"),
plot.title = element_text(size=18),
plot.caption = element_text(size = 13),
panel.grid.minor = element_blank(),
panel.grid.major = element_line(colour="light grey"),
panel.grid.major.x = element_blank(),
axis.text.y = element_text(size=18, color = "black"),
axis.text.x = element_text(size= 15, color = "black", vjust=0.5, angle=20),
axis.title.y= element_text(size=18, color="black"),
legend.position = "right",
legend.margin = margin(t= -15),
legend.title = element_text(size=16),
legend.text = element_text(size=16))
One clear difference between the two data sets is the difference is that the MnDOT data is adjusted for seasonal effects, while the Streetlight data is not. This also allows the MnDOT data to be compared to a historical baseline while the Streetlight data are compared to the average from the first week of March. This can explain some differences. Another difference is that MnDOT’s data concerns changes in vehicle volume, compared to changes in total miles traveled. This could potentially lead to some differences as well. Other differences could be created based on the different methods used to generate this data. Overall, it may be beneficial to speak with Michael Lacono about the reasons for the differences in our data given his knowledge if we wish to pursue our VMT analysis further.
I also experimented with the effect that seasonal adjustments might have on the Streetlight data. This isn’t a final effort, but looked at changes performed by the Bureau of Transportation Statistics to collect general estimates of the size of seasonal adjustments. The figure below includes an additional line that tracks the seasonally adjusted Streetlight data. There is little change however, and it only shows that the summer recovery is slightly less than when unadjusted.
#https://www.transtats.bts.gov/OSEA/SeasonalAdjustment/
adjust <- read_csv(
"D:/Google Drive/IURIF/TPEC/8_COVID Impacts/VMT Analysis/Data/Raw data/seasonal_adjustments.csv") %>%
arrange(month)
sl_adjust <- sl_MNtotal %>%
inner_join(adjust, by="month") %>%
mutate(data= 'Streetlight Adjusted',
date= paste(year, month, day, sep = "-"),
date= as.Date(date),
mar_perc_change= ((vmt*avg_adjust)-mar_baseline)/mar_baseline*100) %>%
select(date, data, mar_perc_change) %>%
rename(change= mar_perc_change) %>%
arrange(date)
combined2 <- combined %>%
rbind(sl_adjust) %>%
mutate(lines= ifelse(data=="Streetlight Adjusted", 2, 1))
pal_adj <- c("#addd8e", "#1f78b4", "orange")
ggplot()+
geom_ma(data= combined2, aes(x= date, y=change, color=data), ma_fun=SMA, n=7, size=2, linetype= "solid")+
theme_classic() +
scale_x_date(limits = as.Date(c(NA, "2020-11-15")), expand= c(0,1), date_labels = paste0("%b"," ","1st"),
date_breaks = "1 month")+
scale_color_manual(values= pal_adj)+
#scale_linetype_manual(breaks=c("MnDOT","Streetlight", "Streetlight Adjusted"), values= c(1,1,2))+
#geom_hline(yintercept = 0, color= "orange", linetype= "dashed", size=1)+
labs(
x="",
y="Change (%)",
caption= "MnDOT data shows change in traffic volume compared to 2016-2019 baseline. \nStreetlight data shows VMT change compared to the average in the first week of March.",
title= "Comparison between Streetlight VMT and MnDOT Traffic Volume Data",
color= "Data Source"
) +
theme(text= element_text(family= "Roboto Condensed"),
plot.title = element_text(size=18),
plot.caption = element_text(size = 13),
panel.grid.minor = element_blank(),
panel.grid.major = element_line(colour="light grey"),
panel.grid.major.x = element_blank(),
axis.text.y = element_text(size=18, color = "black"),
axis.text.x = element_text(size= 15, color = "black", vjust=0.5, angle=20),
axis.title.y= element_text(size=18, color="black"),
legend.position = "right",
legend.margin = margin(t= -15),
legend.title = element_text(size=16),
legend.text = element_text(size=16))
Now, here’s a comparison with MnDOT VMT data. This shows the change in MnDOT is exactly the same as the proportional change in volume. This raises some questions about how exactly they are calculating VMT. But besides that this figure isn’t useful. Upon further review, MnDOT only has percent change across the state, and doesn’t have data about the actual VMT recorded. That’s likely just an estimate and not any sort of official count. So if we want to directlyt compare VMT we need can only do that for the metro area.
mndot_state_vmt <- read_csv(
"D:/Google Drive/IURIF/TPEC/8_COVID Impacts/VMT Analysis/Data/Raw data/region_state_traffic_trends.csv") %>%
clean_names() %>%
filter(district== "MnDOT Statewide") %>%
select(date, typical_vmt_diff) %>%
mutate(data= "MnDOT VMT") %>%
rename(change= typical_vmt_diff)
combined3 <- combined %>%
rbind(mndot_state_vmt) %>%
mutate(data= ifelse(data=="MnDOT", "MnDOT Volume", data),
data= ifelse(data=="Streetlight", "Streetlight", data))
pal_adj <- c("#addd8e", "#1f78b4", "orange")
ggplot()+
geom_ma(data= combined3, aes(x= date, y=change, color=data), ma_fun=SMA, n=7, size=2, linetype= "solid")+
theme_classic() +
scale_x_date(limits = as.Date(c(NA, "2020-11-15")), expand= c(0,1), date_labels = paste0("%b"," ","1st"),
date_breaks = "1 month")+
scale_color_manual(values= pal_adj)+
#scale_linetype_manual(breaks=c("MnDOT","Streetlight", "Streetlight Adjusted"), values= c(1,1,2))+
#geom_hline(yintercept = 0, color= "orange", linetype= "dashed", size=1)+
labs(
x="",
y="Change (%)",
title= "Comparison between Streetlight and MnDOT Data",
color= "Data Source"
) +
theme(text= element_text(family= "Roboto Condensed"),
plot.title = element_text(size=18),
plot.caption = element_text(size = 13),
panel.grid.minor = element_blank(),
panel.grid.major = element_line(colour="light grey"),
panel.grid.major.x = element_blank(),
axis.text.y = element_text(size=18, color = "black"),
axis.text.x = element_text(size= 15, color = "black", vjust=0.5, angle=20),
axis.title.y= element_text(size=18, color="black"),
legend.position = "right",
legend.margin = margin(t= -15),
legend.title = element_text(size=16),
legend.text = element_text(size=16))
Here is the comparison between MnDOT and Streetlight for the metro area. They cover slightly different samples, considering MnDOT is just tracking travel along Metro freeways.
sl_metro <- streetlight %>%
filter(region=="Metro") %>%
select(date, vmt, mar_baseline) %>%
group_by(date) %>%
summarise(vmt= sum(vmt),
baseline= sum(mar_baseline)) %>%
mutate(data= "Streetlight",
change= (vmt-baseline)/baseline*100) %>%
select(-baseline)
mndot_metro <- read_csv(
"D:/Google Drive/IURIF/TPEC/8_COVID Impacts/VMT Analysis/Data/Raw data/region_state_traffic_trends.csv") %>%
clean_names() %>%
filter(district== "MnDOT Metro Freeways") %>%
select(date, district, vmt_sum, typical_vmt_diff) %>%
rename(
vmt= vmt_sum,
change= typical_vmt_diff,
data= district) %>%
mutate(data= "MnDOT")
metro_data <- sl_metro %>%
rbind(mndot_metro)
ggplot()+
geom_ma(data= metro_data, aes(x= date, y=vmt/1000000, color=data), ma_fun=SMA, n=7, size=2, linetype= "solid")+
theme_classic() +
scale_x_date(limits = as.Date(c(NA, "2020-11-15")), expand= c(0,1), date_labels = paste0("%b"),
date_breaks = "1 month")+
scale_color_manual(values= pal_adj)+
#scale_y_continuous(breaks= c(0, 25, 50, 75, 100, 125), limits= c(0,150))+
#scale_linetype_manual(breaks=c("MnDOT","Streetlight", "Streetlight Adjusted"), values= c(1,1,2))+
#geom_hline(yintercept = 0, color= "orange", linetype= "dashed", size=1)+
labs(
x="",
y="VMT (millions)",
title= "Metro Area VMT: Comparison between Streetlight and MnDOT",
color= "Data Source"
) +
theme(text= element_text(family= "Roboto Condensed"),
plot.title = element_text(size=18),
plot.caption = element_text(size = 13),
panel.grid.minor = element_blank(),
panel.grid.major = element_line(colour="light grey"),
panel.grid.major.x = element_blank(),
axis.text.y = element_text(size=18, color = "black"),
axis.text.x = element_text(size= 15, color = "black", vjust=0.5, angle=20),
axis.title.y= element_text(size=18, color="black"),
legend.position = "right",
legend.margin = margin(t= -15),
legend.title = element_text(size=16),
legend.text = element_text(size=16))
Drawing data from MnDOT’s Sensors
I recently found a Met Council app that allows us to draw on data from MnDOT’s metro sensors
#https://github.com/Metropolitan-Council/tc.sensors
library(tc.sensors)
library(data.table)## Warning: package 'data.table' was built under R version 3.6.3##
## Attaching package: 'data.table'## The following objects are masked from 'package:xts':
##
## first, last## The following objects are masked from 'package:lubridate':
##
## hour, isoweek, mday, minute, month, quarter, second, wday, week,
## yday, year## The following objects are masked from 'package:dplyr':
##
## between, first, last## The following object is masked from 'package:purrr':
##
## transposetest <- pull_sensor(5474, pull_date = "2018-110-14")
detectors <- pull_configuration(return_opt = "in_memory", .quiet = TRUE) %>%
mutate(
lon= as.numeric(r_node_lon),
lat= as.numeric(r_node_lat)
)
sensors<- pull_sensor_ids() %>%
slice(1:3) %>%
as_vector()
#for (sen in sensors){
# test <- pull_sensor(sen, pull_date = "2020-09-01")
#}
#date_range <- seq(as.Date("2019/01/01"), as.Date("2019/01/02"), by = "days")
#loop_data <- pmap(list(8564, date_range), pull_sensor)
#loops_full <- rbindlist(loop_data)library(leaflet)
leaflet(width = "100%") %>%
setView(-93.265015, 44.977753, zoom=11) %>%
addProviderTiles(providers$Esri.WorldGrayCanvas) %>%
addCircleMarkers(data= detectors,
popup = paste("<strong>Detector:</strong>", detectors$detector_label, "<br>"),
radius=3,
stroke = FALSE,
fillOpacity = 0.9,
opacity = 0.7,
fillColor = "blue")## Assuming "lon" and "lat" are longitude and latitude, respectively