-
Notifications
You must be signed in to change notification settings - Fork 1
/
Congestion Analysis.Rmd
215 lines (158 loc) · 7.53 KB
/
Congestion Analysis.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
---
title: "Congestion Analysis"
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
# Import packages
If you've never imported before, you'll need to run `install.packages("name of package here")` once. After that, the packages will live in your local library. All you need to do to import them is run the code chunk below.
```{r}
library(data.table)
library(tidyverse)
library(plotly)
library(extrafont)
library(sf)
library(leaflet)
extrafont::loadfonts()
```
# Import StreetLight (SL) data
These two csv files were created from two different SL projects. We used two projects because the maximum zones (in this case, a zone = a road segment) SL permits in a single congestion analysis project is 5,000.
```{r}
congestion_1 <- fread("StL Tables/82850_CongAnal_1_4500_92519_sa_all.csv")
congestion_2 <- fread("StL Tables/82851_CongAnal_4501_8995_92519_sa_all.csv")
# Combine tables to create one table
congestion <- bind_rows(congestion_1, congestion_2)
# Make codes tables
day_types <- congestion %>%
select(`Day Type`) %>%
unique()
day_parts <- congestion %>%
select(`Day Part`) %>%
unique()
# Select relevant variables & rename to names that are more convenient to work with; create day_type_code and day_part_code variables so it's not necessary to type out entire descripter when filtering
congestion_tidy <- congestion %>%
dplyr::select(`Zone ID`, `Day Type`, `Day Part`, `Avg All Segment Speed (mph)`) %>%
rename(id = `Zone ID`,
day_type = `Day Type`,
day_part = `Day Part`,
avg_spd = `Avg All Segment Speed (mph)`) %>%
separate(day_type, into = c("day_type_code", "day_type_desc"), sep = 1) %>%
separate(day_part, into = c("day_part_code", "day_part_desc"), sep = 2) %>%
mutate(day_type_desc = str_replace(day_type_desc, pattern = ": ", replacement = ""),
day_part_desc = str_replace(day_part_desc, pattern = ": ", replacement = ""))
# Select min speed for weekdays
congestion_wkday <- congestion_tidy %>%
filter(day_type_code == 1 & day_part_code != "00" & day_part_code != "02" & day_part_code != "09" & day_part_code != "19") %>% # Eliminate all day, off-peak, peak AM and peak PM from consideration
group_by(id) %>%
mutate(min_spd = min(avg_spd)) %>%
ungroup() %>%
filter(avg_spd == min_spd) # Note that some segments have multiple hours with the same speed that is the min - will cause duplicates
# Look at duplicates (hours with same speed as min)
congestion_dups <- congestion_wkday %>%
group_by(id) %>%
count()
# Join back counts of hours to detailed dataset
congestion_check <- left_join(congestion_wkday, congestion_dups, by = "id")
# See how many times the overnight hours appear as the minimum speed (and are the only hour that occurs)
check_plot <- congestion_check %>%
mutate(day_part_code = as.numeric(day_part_code)) %>%
mutate(min_hour_cat = ifelse(n == 1, "One hour is min", "Multiple hours are min")) %>%
ggplot(aes(fct_reorder(day_part_desc, day_part_code), fill = min_hour_cat)) +
geom_bar() +
coord_flip() +
scale_fill_manual(values = c("#FF99FF", "#9999FF")) +
labs(x = "",
fill = "") +
theme(text = element_text(family = "Tw Cen MT"),
legend.position = "bottom",
axis.ticks = element_blank(),
panel.background = element_rect(fill = "white"),
panel.grid = element_blank())
check_plot
ggsave("Methodology check.png", width = 10, height = 6)
ggplotly(check_plot)
```
# Take a look at where segments with 2+ hours with same min speed are located
```{r}
# Create summarized dataset that contains min speed, hours with that speed, and zone ID
congestion_wkday_id <- congestion_wkday %>%
group_by(id, min_spd) %>%
summarize(hour_or_hours = paste(day_part_desc, collapse = ", "))
# Add variable stating number of hours tied for min
congestion_full <- left_join(congestion_wkday_id, congestion_dups, by = "id") %>%
rename(n_min_hours = n)
# Import shapefiles
con_shp_1 <- st_read("Shapefiles/82850_CongAnal_1_4500_92519_segment_line.shp")
con_shp_2 <- st_read("Shapefiles/82851_CongAnal_4501_8995_92519_segment_line.shp")
congestion_shp_1 <- left_join(con_shp_1, congestion_full, by = "id")
congestion_shp_2 <- left_join(con_shp_2, congestion_full, by = "id")
congestion_shp <- rbind(congestion_shp_1, congestion_shp_2) #do NOT use bind_rows
congestion_lab <- congestion_shp %>%
mutate(popup = paste0("Number of hours tied for minimum speed: <strong>", n_min_hours, "</strong><br> Min speed: <strong>", min_spd, "</strong"))
labs <- as.list(congestion_lab$popup)
congestion_shp %>%
leaflet() %>%
addPolygons(color = ~colorNumeric("PuBu", n_min_hours)(n_min_hours),
label = lapply(labs, htmltools::HTML),
labelOptions = labelOptions(style = list("font-family" = "Segoe UI Light",
"font-size" = "14px"))) %>%
addProviderTiles(providers$CartoDB.Positron)
#st_write(congestion_shp, "Congestion Method Check.shp", "ESRI Shapefile Driver")
```
# Take a look at segments where congestion is in the off-peak
```{r}
con_wkday_1 <- left_join(con_shp_1, congestion_wkday, by = "id")
con_wkday_2 <- left_join(con_shp_2, congestion_wkday, by = "id")
congestion_wkday_shp <- rbind(con_wkday_1, con_wkday_2) #do NOT use bind_rows
st_write(congestion_wkday_shp, "Congestion Method Check on Off-peak.shp", "ESRI Shapefile Driver")
```
# Congestion (without hour designation) + free-flow speed
```{r}
# Note only 8,910 segments have weekday speeds for some hour of the day
congestion_wkday_unique <- congestion_wkday %>%
dplyr::select(id, min_spd) %>%
unique()
all_ids <- as_tibble(c(1:8995)) %>%
rename(id = value)
missing_con_spds <- anti_join(all_ids, congestion_wkday_unique, by = "id")
# Note only 8,734 segments have speeds recorded for off-peak
flow_wkday <- congestion_tidy %>%
filter(day_type_code == "1" & day_part_code == "02") %>%
dplyr::select(id, avg_spd) %>%
rename(off_pk_spd = avg_spd) %>%
unique()
missing_flow_spds <- anti_join(all_ids, flow_wkday, by = "id")
flow_con <- full_join(congestion_wkday_unique, flow_wkday, by = "id")
ref_spd <- flow_con %>%
mutate(perc_congested = min_spd/off_pk_spd*100)
ref_wkday_1 <- left_join(con_shp_1, ref_spd, by = "id")
ref_wkday_2 <- left_join(con_shp_2, ref_spd, by = "id")
congestion_flow_shp <- rbind(ref_wkday_1, ref_wkday_2)
st_write(congestion_flow_shp, "Shapefiles/Congestion_Flow_All_Hours.shp", "ESRI Shapefile Driver")
write_csv(missing_con_spds, "Segment IDs Missing Weekday Speed.csv")
write_csv(missing_flow_spds, "Segment IDs Missing Off-Peak Weekday Speeds.csv")
```
# Congestion using only 5am-9pm hours
```{r}
congestion_59_wkday <- congestion_tidy %>%
filter(day_type_code == 1) %>% # Only include weekdays
mutate(day_part_code = as.numeric(day_part_code)) %>% # Make it more convenient to get rid of impertinent hours of day
filter(day_part_code >= 7 & day_part_code <= 24) %>%
group_by(id) %>%
mutate(min_spd = min(avg_spd)) %>%
ungroup() %>%
filter(avg_spd == min_spd) %>%
dplyr::select(id, min_spd) %>%
unique()
flow_con_59 <- full_join(congestion_59_wkday, flow_wkday, by = "id")
ref_con_59 <- flow_con_59 %>%
mutate(perc_congested = min_spd/off_pk_spd*100) %>%
filter(!is.na(perc_congested) & min_spd > 0 & off_pk_spd != 0) # Strip bad data
ref_59_1 <- left_join(con_shp_1, ref_con_59, by = "id")
ref_59_2 <- left_join(con_shp_2, ref_con_59, by = "id")
congestion_59_flow_shp <- rbind(ref_59_1, ref_59_2)
congestion_59_tidy <- congestion_59_flow_shp %>%
filter(!is.na(perc_congested))
st_write(congestion_59_tidy, "Shapefiles/Congestion_Flow_5am_9pm_Tidy.shp", "ESRI Shapefile Driver")
```