Justin Meade Homework 4

Fourth Assignment

Justin Meade
3/4/2022

Load Libraries

import CSV containing speed data from zipped directory, rename unique identifier for join

tbl_IA_1HR_Speed_AVG_INRIX <- read_csv(
  unz(
    'G:/My Drive/School/UMASS/DACSS/DACSS_601/assignment4/DATA/Bottlenecks_05062020.zip',
    'Bottlenecks_05062020.csv', )) %>%
  rename('Tmc'='tmc_code')

Import shapefile containing data regarding Traffic Message Channels, Convert to tibble

shp_IA_TMC<-st_read(
  'G:/My Drive/School/UMASS/DACSS/DACSS_601/assignment4/Data/Iowa_2018_TMC_shapefile/Iowa.shp',
  as_tibble=TRUE) %>%
  select(
    'Tmc','RoadName','County','Miles','ThruLanes','Route_Numb','Route_Sign','AltRteName','AADT','AADT_Singl','AADT_Combi')
Reading layer `Iowa' from data source 
  `G:\My Drive\School\UMASS\DACSS\DACSS_601\assignment4\Data\Iowa_2018_TMC_shapefile\Iowa.shp' 
  using driver `ESRI Shapefile'
Simple feature collection with 4862 features and 36 fields
Geometry type: MULTILINESTRING
Dimension:     XY
Bounding box:  xmin: -96.61288 ymin: 40.38535 xmax: -90.17986 ymax: 43.50076
Geodetic CRS:  WGS 84

Collect Garbage to clear memory, Merge datasets together, create new object

gc()
            used   (Mb) gc trigger   (Mb)  max used   (Mb)
Ncells   1271717   68.0    2196184  117.3   2196184  117.3
Vcells 240395763 1834.1  305104959 2327.8 241413257 1841.9
tmc_Bottleneck_IA_1HR<- tbl_IA_1HR_Speed_AVG_INRIX %>%
  left_join(shp_IA_TMC, by='Tmc')
tmc_Bottleneck_IA_1HR <-tmc_Bottleneck_IA_1HR %>%
  filter(Route_Sign %in% c(2,3,4))%>%
  mutate(Route_Sign = case_when(
    Route_Sign == 2 ~ 'Interstate',
    Route_Sign == 3 ~ 'US Route',
    Route_Sign == 4 ~ 'IA Route'))

tmc_Bottleneck_IA_1HR

Filter for ‘Bottlenecked’ time segments

tmc_Bottleneck_IA_1HR_Bneck <- tmc_Bottleneck_IA_1HR %>%
  filter(confidence_score ==30 & cvalue >=75) %>%
  filter(speed <=.6*reference_speed | ( reference_speed >= 65 & speed <= .6*65))

Calculate totals number of hours ‘bottlenecked’, per TMC, show worst 10

gc()
            used   (Mb) gc trigger    (Mb)   max used    (Mb)
Ncells   1301632   69.6    2196184   117.3    2196184   117.3
Vcells 787234687 6006.2 2232934109 17036.0 2098627066 16011.3
tmc_Bottleneck_IA_1HR_Bneck %>%
  group_by('Tmc')%>%
  count(measurement_tstamp, name = 'HRS')%>%
  arrange(0-HRS)
# A tibble: 8,754 x 3
# Groups:   "Tmc" [1]
   `"Tmc"` measurement_tstamp    HRS
   <chr>   <dttm>              <int>
 1 Tmc     2018-02-05 15:00:00   265
 2 Tmc     2018-02-05 16:00:00   260
 3 Tmc     2018-02-05 14:00:00   228
 4 Tmc     2018-02-05 17:00:00   219
 5 Tmc     2018-02-05 18:00:00   163
 6 Tmc     2018-02-06 08:00:00   163
 7 Tmc     2018-03-24 10:00:00   156
 8 Tmc     2018-03-24 09:00:00   152
 9 Tmc     2018-03-24 08:00:00   150
10 Tmc     2018-03-24 07:00:00   148
# ... with 8,744 more rows

Calculate average speeds and average refernce speeds, by route type, sort

tmc_Bottleneck_IA_1HR_Bneck%>%
  select(Route_Sign,speed) %>%
  group_by(Route_Sign)%>%
  summarise_all(list(mean="mean", median="median", sd="sd"))%>%
  mutate(order= case_when(
    Route_Sign=='Interstate'~ 1,
    Route_Sign=='US Route'~ 2,
    Route_Sign=='IA Route'~ 3)) %>%
  arrange(order)%>%
  select(-order)
# A tibble: 3 x 4
  Route_Sign  mean median    sd
  <chr>      <dbl>  <dbl> <dbl>
1 Interstate  24.0   24.7  7.88
2 US Route    19.2   17.4  8.77
3 IA Route    17.3   15.8  8.22
tmc_Bottleneck_IA_1HR_Bneck%>%
  select(Route_Sign,reference_speed) %>%
  group_by(Route_Sign)%>%
  summarize_all(list(mean="mean", median="median", sd="sd"))%>%
  mutate(order= case_when(
    Route_Sign=='Interstate'~ 1,
    Route_Sign=='US Route'~ 2,
    Route_Sign=='IA Route'~ 3))%>%
  arrange(order)%>%
  select(-order)
# A tibble: 3 x 4
  Route_Sign  mean median    sd
  <chr>      <dbl>  <dbl> <dbl>
1 Interstate  50.6     49  12.1
2 US Route    40.8     37  14.9
3 IA Route    36.8     33  14.5

Determine TMCs with the most records.

tmc_Bottleneck_IA_1HR_Bneck %>%
  select(Tmc) %>%
  group_by(Tmc)%>%
  count(Tmc, name = 'CNT')%>%
  arrange(0-CNT)
# A tibble: 4,248 x 2
# Groups:   Tmc [4,248]
   Tmc         CNT
   <chr>     <int>
 1 118+10758  3041
 2 118P07144  2698
 3 118N07371  2435
 4 118P07114  2305
 5 118P07371  2298
 6 118N07464  2203
 7 118P09542  2034
 8 118N09543  1908
 9 118-07410  1783
10 118N09258  1771
# ... with 4,238 more rows

Calcualte hours by time of day, for the most bottlenecked segment

TMC_118_10758 <- tmc_Bottleneck_IA_1HR_Bneck %>%
  filter( Tmc== '118+10758')%>%
  mutate(DATE = format(measurement_tstamp,'%HH'))%>%
  group_by(DATE)%>%
  count(name='HRS_BOTTLENECK')%>%
  arrange(DATE)
  
  
ggplot(data=TMC_118_10758,aes(x= DATE, y =HRS_BOTTLENECK)) +
  geom_col() + 
  xlab('Time-of-day') +
  ylab('Hours Bottlenecked') +
  ggtitle('TMC 118+10758 (2018)')

Calcualte hours by week, for the most bottlenecked segment

TMC_118_10758 <- tmc_Bottleneck_IA_1HR_Bneck %>%
  filter( Tmc== '118+10758')%>%
  mutate(DATE = format(measurement_tstamp,'%WW'))%>%
  group_by(DATE)%>%
  count(name='HRS_BOTTLENECK')%>%
  arrange(DATE)
  
  
ggplot(data=TMC_118_10758,aes(x= DATE, y =HRS_BOTTLENECK)) +
  geom_col() + 
  xlab('WEEK') +
  ylab('Hours Bottlenecked') +
  ggtitle('TMC 118+10758 (2018)')

Calculate bottleneck hours for every week throughout the year, all roadway systems

tmc_Bottleneck_IA_1HR_Bneck
# A tibble: 371,264 x 19
   Tmc       measurement_tstamp  speed average_speed reference_speed
   <chr>     <dttm>              <dbl>         <dbl>           <dbl>
 1 118+11506 2018-01-01 07:00:00  32.9            57              58
 2 118+11509 2018-01-01 14:00:00  34.0            60              59
 3 118+11508 2018-01-01 16:00:00  31.6            54              54
 4 118+11505 2018-01-01 10:00:00  27.8            57              57
 5 118+07488 2018-01-01 11:00:00   5              35              30
 6 118N06941 2018-01-01 01:00:00   8              18              18
 7 118N06941 2018-01-01 02:00:00   8              18              18
 8 118N06941 2018-01-01 04:00:00  10.7            18              18
 9 118+11512 2018-01-01 11:00:00  30              58              59
10 118+07453 2018-01-01 21:00:00  27.9            55              58
# ... with 371,254 more rows, and 14 more variables:
#   travel_time_minutes <dbl>, confidence_score <dbl>, cvalue <dbl>,
#   RoadName <chr>, County <chr>, Miles <dbl>, ThruLanes <dbl>,
#   Route_Numb <dbl>, Route_Sign <chr>, AltRteName <chr>, AADT <dbl>,
#   AADT_Singl <dbl>, AADT_Combi <dbl>,
#   geometry <MULTILINESTRING [°]>
tmc_Week_RSign <-
  tmc_Bottleneck_IA_1HR_Bneck %>%
  mutate(DATE = format(measurement_tstamp,'%WW'))%>%
  group_by(Route_Sign,DATE)%>%
  count(name = 'HRS')%>%
  mutate(order= case_when(
    Route_Sign=='Interstate'~ 1,
    Route_Sign=='US Route'~ 2,
    Route_Sign=='IA Route'~ 3))%>%
  arrange(DATE,order)

tmc_Week_RSign
# A tibble: 159 x 4
# Groups:   Route_Sign, DATE [159]
   Route_Sign DATE    HRS order
   <chr>      <chr> <int> <dbl>
 1 Interstate 01W     982     1
 2 US Route   01W    4867     2
 3 IA Route   01W    2327     3
 4 Interstate 02W    1228     1
 5 US Route   02W    5422     2
 6 IA Route   02W    2538     3
 7 Interstate 03W    1106     1
 8 US Route   03W    5172     2
 9 IA Route   03W    2467     3
10 Interstate 04W    1093     1
# ... with 149 more rows
road_Systems <- pull(unique(tmc_Week_RSign['Route_Sign'])) 

road_Systems
[1] "Interstate" "US Route"   "IA Route"  
ggplot(tmc_Week_RSign, aes( y=HRS, x=DATE, fill=Route_Sign)) + 
  geom_bar(stat='identity',position = 'stack') + 
  xlab('Week') + 
  ylab("Hours 'Bottlenecked'") 

Reuse

Text and figures are licensed under Creative Commons Attribution CC BY-NC 4.0. The figures that have been reused from other sources don't fall under this license and can be recognized by a note in their caption: "Figure from ...".

Citation

For attribution, please cite this work as

Meade (2022, March 12). Data Analytics and Computational Social Science: Justin Meade Homework 4. Retrieved from https://github.com/DACSS/dacss_course_website/posts/httpsrpubscommeade68875038/

BibTeX citation

@misc{meade2022justin,
  author = {Meade, Justin},
  title = {Data Analytics and Computational Social Science: Justin Meade Homework 4},
  url = {https://github.com/DACSS/dacss_course_website/posts/httpsrpubscommeade68875038/},
  year = {2022}
}