PHED
Yaxin Zhang
2020-06-15
NPMRDS data, travel time in second averaged to every15 mins for weekdays from 6:00am to 9:59am and 3:00pm to 6:59pm, 01/01/2017 to 12/31/2017. 87million+ observations.
load(file = "D:\\OneDrive_Stella\\OneDrive\\YaxinZhang\\2020_spring\\NPMRDS\\PHED\\combined_2017_phed.RData")
speedlimit<-read_csv("D:\\OneDrive_Stella\\OneDrive\\YaxinZhang\\2019_fall\\NYMTC\\yunhai\\Speedlimit.csv")
combined_2017_phed<-combined_2017_phed%>%
left_join(speedlimit, by=c("tmc_code"="tmc"))
combined_2017_phed[1:5,] %>%
kable() %>%
column_spec(8, bold = T) %>%
kable_styling(bootstrap_options = c("striped","hover"),full_width = F,
fixed_thead = T)1. Threshold Speed
- Threshold Speed is the speed of travel at which any slower measured speeds would result in excessive delay for travel time reporting segment.
- Select 20 miles per hour or 60 percent of the posted speed limit of the segment, whichever is greater.combined_2017_phed<-combined_2017_phed%>%
mutate(speed_threshold=ifelse(is.na(postedspeedinmph),20,ifelse(postedspeedinmph*.6>20,postedspeedinmph*.6,20)))
combined_2017_phed[1:5,] %>%
kable() %>%
column_spec(14, bold = T) %>%
kable_styling(bootstrap_options = c("striped","hover"),full_width = F,
fixed_thead = T)2. Excessive Delay Threshold Travel Time (EDTTT)
- EDTTT (in Seconds)=(length of TMC/Threshold Speed)*3600
- Length if the TMCs ("mile" column) needs to be rounded to the nearest thousandth of a mile
- EDTTT in nearest whole secondcombined_2017_phed<-combined_2017_phed%>%
mutate(edttt = round((miles/speed_threshold)*3600,0))
combined_2017_phed[1:5,] %>%
kable() %>%
column_spec(15, bold = T) %>%
kable_styling(bootstrap_options = c("striped","hover"),full_width = F,
fixed_thead = T)3. Travel Time Segment Delay (RSD)
- Travel Time Segment Delay (RSD) (in Seconds) = Travel Time - EDTTT
- Maximum value for RSD is 900 seconds (15mins)combined_2017_phed<-combined_2017_phed%>%
mutate(rsd_=round(combined_2017_phed$travel_time_seconds,0)-combined_2017_phed$edttt)%>%
mutate(rsd=ifelse(rsd_>900,900,rsd_))
combined_2017_phed[1:5,] %>%
kable() %>%
column_spec(17, bold = T) %>%
kable_styling(bootstrap_options = c("striped","hover"),full_width = F,
fixed_thead = T)4. Excessive Delay (ED) and Excessive Delay in Vehicle Hour
- Excessive Delay (ED) (in nearest thousandths of Hour) = RSD/3600, if RSD > 0 it equals to ED, if RSD < 0, no delay (ED=0)
- Annual Average Daily Traffic (AADT) is bidirectional, which needs to divide by 2 to get single direction
- Vehicle Volume for each 15 min bin = AADT / (24*4*2)
- Excessive Delay in Vehicle Hour for each 15 min bin = ED*(AADT/24*4*2)tmc_identification<-read.csv("D:\\OneDrive_Stella\\OneDrive\\YaxinZhang\\2020_spring\\NPMRDS\\PHED\\npmrds_2017_15m\\TMC_Identification.csv",header = T)
tmc<-tmc_identification[,c(1,20,22,30,31)]
tmc<-tmc[!duplicated(tmc$tmc),]
combined_2017_phed<-combined_2017_phed%>%
left_join(tmc, by = c("tmc_code"="tmc"))
#hourly traffic
AHT <- read_excel("D:\\OneDrive_Stella\\OneDrive\\YaxinZhang\\2020_spring\\NPMRDS\\PHED\\copy_Average_Hourly_Distribution_County_FC_NYMTC.xlsx")
table(AHT$CNTY_NAME,AHT$FUNCTIONAL_CLASS)
AHT$FUNCTIONAL_CLASS[AHT$FUNCTIONAL_CLASS==11] <- 1
AHT$FUNCTIONAL_CLASS[AHT$FUNCTIONAL_CLASS==12] <- 2
AHT$FUNCTIONAL_CLASS[AHT$FUNCTIONAL_CLASS==14] <- 3
AHT$FUNCTIONAL_CLASS[AHT$FUNCTIONAL_CLASS==16] <- 4
AHT$FUNCTIONAL_CLASS[AHT$FUNCTIONAL_CLASS==17] <- 5
AHT$FUNCTIONAL_CLASS[AHT$FUNCTIONAL_CLASS==19] <- 7
X <- c("county","f_system","0","1","2","3","4","5","6","7","8","9","10","11","12","13","14","15",
"16","17","18","19","20","21","22","23")
colnames(AHT) <- X
hourly_traffic <- AHT %>%
gather(dhour,traffic_ratio,-county,-f_system)
hourly_traffic <- as_tibble(hourly_traffic)
hourly_traffic$dhour <- as.numeric(hourly_traffic$dhour)
combined_2017_phed <- combined_2017_phed %>%
left_join(hourly_traffic,by=c("county","f_system","dhour"))
combined_2017_phed<-combined_2017_phed%>%
mutate(ed=ifelse(rsd<0,0,rsd/3600))
combined_2017_phed<-combined_2017_phed%>%
mutate(traffic_v=round((aadt/faciltype)*traffic_ratio,1))
combined_2017_phed<-combined_2017_phed%>%
mutate(edv=(traffic_v/4)*round(ed,2))
combined_2017_phed[1:5,] %>%
kable() %>%
column_spec(19, bold = T) %>%
kable_styling(bootstrap_options = c("striped","hover"),full_width = F,
fixed_thead = T)5. Average Occupancy Ratio (AVO)
- Percent of Buses as a share of total AADT on the segment (Pb)
- Pb = AADT_single/total AADT
- Percent of Trucks as a share of total AADT on the segment (Pt)
- Pt = AADT_combination/total AADT
- Percent of Cars as a share of total AADT on the segment (Pc)
- Pc = 1-Pb-Pt
- AVO = (Pc*AVOc)+(Pb*AVOb)+(Pt*AVOt)
- AVOc = 1.7, AVOt = 1, AVOb = 16.8.
AVO Values obtained from {r}[AVO Factors for computing TTRM and PHED](https://www.fhwa.dot.gov/tpm/guidance/avo_factors.pdf)
- AVO = (Pc*1.7) + (Pb*16.8) + (Pt*1)combined_2017_phed<-combined_2017_phed%>%
mutate(pb=aadt_singl/aadt)%>%
mutate(pt=aadt_combi/aadt)%>%
mutate(pc=1-pb-pt)%>%
mutate(avo=(pc*1.7)+(pb*16.8)+(pt*1))
combined_2017_phed[1:5,] %>%
kable() %>%
column_spec(c(22,23,24,25), bold = T) %>%
kable_styling(bootstrap_options = c("striped","hover"),full_width = F,
fixed_thead = T)6. Total Excessive Delay
- Excessive Delay Sum = EDsum = sum of all Excessive Delay (ED) from every 15min bin for each TMC
- Total Excessive Delay (Per Hour) = AVO*EDsumphed_edsum<-combined_2017_phed%>%
group_by(tmc_code,avo,county)%>%
summarise(edsum=sum(edv,na.rm = T))
phed_ted<-phed_edsum%>%
mutate(ted=avo*edsum)
phed_ted[1:5,] %>%
kable() %>%
kable_styling(bootstrap_options = c("striped","hover"),full_width = F,
fixed_thead = T)
phed_county<-phed_ted%>%
group_by(county)%>%
summarise(ted_c=sum(ted,na.rm = T))
population<-read.csv("D:\\OneDrive_Stella\\OneDrive\\YaxinZhang\\2020_spring\\NPMRDS\\PHED\\population_2017.csv",header = T)
phed_county <- phed_county %>%
left_join(population, by="county")
phed_c <-
phed_county %>%
mutate(phed=round(phed_county$ted_c/phed_county$population,1))
round(sum(phed_c$ted_c)/sum(phed_c$population),1)compare phed in 2017, 2018 and 2019
phed_2017 <- read.csv("D:\\OneDrive_Stella\\OneDrive\\YaxinZhang\\2020_spring\\NPMRDS\\PHED\\phed_2017.csv",header = TRUE)
phed_2018 <- read.csv("D:\\OneDrive_Stella\\OneDrive\\YaxinZhang\\2020_spring\\NPMRDS\\PHED\\phed_2018.csv",header = TRUE)
phed_2019 <- read.csv("D:\\OneDrive_Stella\\OneDrive\\YaxinZhang\\2020_spring\\NPMRDS\\PHED\\phed_2019.csv",header = TRUE)
phed_2018$phed_2018 <- round(phed_2018$ted_c/phed_2018$population,1)
round(sum(phed_2017$ted_c)/sum(phed_2017$population),1)## [1] 27.1round(sum(phed_2018$ted_c)/sum(phed_2018$population),1)## [1] 23.6round(sum(phed_2019$ted_c)/sum(phed_2019$population),1)## [1] 23.9phed <- data.frame(phed_2017[,c(1,4)],phed_2018[,4], phed_2019[,4])
x <- c("county","phed_2017", "phed_2018", "phed_2019")
colnames(phed) <- x
phed <- phed %>%
gather(year_,phed,-county)
phed$year <- str_sub(phed$year_,-4,-1)
phed <- phed[,-2]
phed$year <- as.numeric(phed$year)
ggplot(data=phed, aes(x=year, y=phed, group=county)) +
geom_line(aes(color=county))+
geom_text(data = phed %>% filter(year == last(year)), aes(label = county,
x = year + 0.2,
y = phed + 1,
color = county),size=3) +
guides(color = FALSE) + theme_bw() +
geom_text(aes(label=phed),hjust=1, vjust=-0.5, size =3)+
geom_point(aes(color=county))