To better validate the Tahoe Model outputs, Streetlight Data for the Tahoe region was gathered for the following time periods, including:
For this study, trips on typical weekdays (Monday - Thursday) are analyzed, and trips on Fridays or weekends are not included. The tidyverse package provides tools and functions used in this analysis. Please contact WSP USA for questions regarding the analysis.
The objective of this analysis is to summarize the VMT from I-E and E-I trips as observed in the Streetlight Dataset. “Gates” are the major entrance / exit point to the Tahoe Lake region, and there are a total of 7 gates considered in this study.
Once the gates are defined, the study team make the following assumptions regarding the travel patterns.
There are 8 internal zones for the Tahoe region. The block groups outside of the Tahoe region are external zones.
All external zones can be grouped in 1 of 29 external districts.
All I-E and E-I trips between a external district and a internal zone will use the same gate.
The Streetlight data contains the Streetlight Volume for I-E and E-I trips
The I-E and E-I trips contains 2 parts:
external_distance will be used to further categorize the I-E and E-I trips:
Based on the inputs and assumptions, VMT can be calculated by multiplying Streetlight Volume with external_distance and internal_distance. The results are then summarized by gates and by trip types (long- vs. short-distance trips). The summary tables will be used to validate the model outputs.
There are 3 Streetlight databases, a snapshot of the datasets are found below:
| Origin Zone ID | Origin Zone Name | Origin Zone Is Pass-Through | Origin Zone Direction (degrees) | Origin Zone is Bi-Direction |
|---|---|---|---|---|
| 11 | 11 | no | N/A | no |
| 11 | 11 | no | N/A | no |
| 11 | 11 | no | N/A | no |
| Some College (percent) | Bachelor’s Degree (percent) | Graduate Degree (percent) | White (percent) | Black (percent) |
|---|---|---|---|---|
| 0.422 | 0.226 | 0.066 | 0.461 | 0.047 |
| 0.422 | 0.226 | 0.066 | 0.461 | 0.047 |
| 0.248 | 0.446 | 0.205 | 0.852 | 0.005 |
| Avg All Trip Length (mi) | Avg Trip Speed (mph) | Avg All Trip Speed (mph) | Avg All Trip Circuity | Trip Duration 0-10 min (percent) |
|---|---|---|---|---|
| 218.5 | 51 | 51 | 1.380 | 0 |
| 218.5 | 51 | 51 | 1.380 | 0 |
| 197.6 | 53 | 53 | 1.456 | 0 |
There are 5 major steps during this phase, including:
# import data from local folder, and select the rows that are not all-day redcords and are on typical weekdays
dataset_1 <- read_csv('H:/model/model_update_2019/streetlight/95945_Tahoe_OD_Analysis_2020_01_02/95945_Tahoe_OD_Analysis_2020_01_02_odg_all.csv',guess_max=10000000) %>%
data.frame() %>% as_tibble() %>%
filter(Day.Part!='0: All Day (12am-12am)') %>%
filter(Day.Type=='1: Weekday (M-Th)')
dataset_2 <- read_csv('H:/model/model_update_2019/streetlight/95945_Tahoe_OD_Analysis_2020_01_02/95945_Tahoe_OD_Analysis_2020_01_02_odg_traveler_all.csv',guess_max=10000000)%>%
data.frame() %>% as_tibble() %>%
filter(Day.Part!='0: All Day (12am-12am)') %>%
filter(Day.Type=='1: Weekday (M-Th)')
dataset_3 <- read_csv('H:/model/model_update_2019/streetlight/95945_Tahoe_OD_Analysis_2020_01_02/95945_Tahoe_OD_Analysis_2020_01_02_odg_trip_all.csv',guess_max=10000000) %>%
data.frame() %>% as_tibble() %>%
filter(Day.Part!='0: All Day (12am-12am)') %>%
filter(Day.Type=='1: Weekday (M-Th)') # trim the undesired attributes in the data
dataset_3 <- dataset_3 %>%
select(Origin.Zone.Name, Destination.Zone.Name, Day.Part,Avg.All.Trip.Length..mi.,Avg.Trip.Length..mi.)
dataset_2 <- dataset_2 %>%
select(Day.Part,Origin.Zone.Name,Destination.Zone.Name,Purpose.HBW..percent.,Purpose.HBO..percent.,
Purpose.NHB..percent.)
# combine the Streetlight data, calculate the home-based work(HBW), home-based other(HBO), and non-home-based(NHB) trips, and trim attributes that are not needed
data_v1 <- dataset_1 %>%
left_join(dataset_2) %>%
left_join(dataset_3) %>%
mutate(Purpose.HBW..percent.=as.numeric(Purpose.HBW..percent.),
Purpose.HBO..percent.=as.numeric(Purpose.HBO..percent.),
Purpose.NHB..percent.=as.numeric(Purpose.NHB..percent.)) %>%
replace_na(list(Purpose.HBW..percent.=0,Purpose.HBO..percent.=0,Purpose.NHB..percent.=0)) %>%
mutate(HBW_vol = Average.Daily.O.D.Traffic..StL.Volume.*Purpose.HBW..percent.,
HBO_vol = Average.Daily.O.D.Traffic..StL.Volume.*Purpose.HBO..percent.,
NHB_vol = Average.Daily.O.D.Traffic..StL.Volume.*Purpose.NHB..percent.,
Tot_vol = Average.Daily.O.D.Traffic..StL.Volume.) %>%
select(-Type.of.Travel,-Day.Type,
-Origin.Zone.Is.Pass.Through,-Origin.Zone.Direction..degrees.,-Origin.Zone.is.Bi.Direction,
-Destination.Zone.Is.Pass.Through,-Destination.Zone.Direction..degrees.,-Destination.Zone.is.Bi.Direction,
-Avg.Trip.Duration..sec.,-Origin.Zone.ID,-Destination.Zone.ID,
-Average.Daily.Origin.Zone.Traffic..StL.Volume.,-Average.Daily.Destination.Zone.Traffic..StL.Volume.,
-Purpose.HBW..percent.,-Purpose.HBO..percent.,-Purpose.NHB..percent.,
-Average.Daily.O.D.Traffic..StL.Volume.)# define the relationship between the block groups and the 29 external districts
CA_NV_tract_to_district <- read_csv('H:/model/model_update_2019/streetlight/95945_Tahoe_OD_Analysis_2020_01_02/CA_NV_Tract_To_District.csv')
kable(CA_NV_tract_to_district[1:3,], align = c(rep('c',ncol(CA_NV_tract_to_district))), caption = "External districts information") %>%
kable_styling()
# define which gate to use for E-I and I-E trips. Gates are determined based on Gogole Map routing information. Assumed departure time on Tuesday, 7:30 AM
district_to_gate_relationship <- read_csv('H:/model/model_update_2019/streetlight/95945_Tahoe_OD_Analysis_2020_01_02/District_to_Gate.csv') %>%
gather(Destination, Gate, "06_0_Chico":"Grand Total") %>%
filter(!is.na(Gate)) %>%
rename("Origin" = "Row Labels")
kable(district_to_gate_relationship[1:3,], align = c(rep('c',ncol(district_to_gate_relationship))), caption = "Gate information") %>%
kable_styling()
# define distance between gate and internal zones. Distance measured from gate location to the population centroid of the internal zones
gate_to_internal_distance <- read_csv('H:/model/model_update_2019/streetlight/95945_Tahoe_OD_Analysis_2020_01_02/Gate_to_Internal.csv') %>%
gather(Internal, Distance, "11":"18")
kable(gate_to_internal_distance[1:3,], align = c(rep('c',ncol(gate_to_internal_distance))), caption = "Gate to internal zone distance") %>%
kable_styling()# add the state, county, and tract information, and retain only I-E and E-I trips
data_v2 <- data_v1 %>%
mutate(orig_state=ifelse(Origin.Zone.Source!='Input',substr(Origin.Zone.Name,2,3),'Input'),
orig_county=ifelse(Origin.Zone.Source!='Input',substr(Origin.Zone.Name,4,6),'Input'),
orig_tract=ifelse(Origin.Zone.Source!='Input',substr(Origin.Zone.Name,7,12),Origin.Zone.Name),
dest_state=ifelse(Destination.Zone.Source!='Input',substr(Destination.Zone.Name,2,3),'Input'),
dest_county=ifelse(Destination.Zone.Source!='Input',substr(Destination.Zone.Name,4,6),'Input'),
dest_tract=ifelse(Destination.Zone.Source!='Input',substr(Destination.Zone.Name,7,12),Destination.Zone.Name)) %>%
left_join(CA_NV_tract_to_district %>%
rename(orig_district=groupname),by=c('orig_state'='STATEFP','orig_county'='COUNTYFP',
'orig_tract'='TRACTCE')) %>%
left_join(CA_NV_tract_to_district %>%
rename(dest_district=groupname),by=c('dest_state'='STATEFP','dest_county'='COUNTYFP',
'dest_tract'='TRACTCE')) %>%
mutate(orig_district=ifelse(Origin.Zone.Source=='Input', Origin.Zone.Name, orig_district)) %>%
mutate(dest_district=ifelse(Destination.Zone.Source=='Input', Destination.Zone.Name, dest_district)) %>%
filter(!(is.na(orig_district)|is.na(dest_district)))
# calculate the statistics of the trip length, trip volumes, by oirigin and destination.
data_v3 <- data_v2 %>%
mutate(Avg.All.Trip.Length..mi.=as.numeric(Avg.All.Trip.Length..mi.),
Avg.Trip.Length..mi.=as.numeric(Avg.Trip.Length..mi.),
) %>%
mutate(Avg.Trip.Length..mi.=ifelse(is.na(Avg.Trip.Length..mi.),0,Avg.Trip.Length..mi.)) %>%
group_by(Origin.Zone.Name,Destination.Zone.Name) %>%
summarize( orig_state=first(orig_state),
orig_county=first(orig_county),
orig_tract=first(orig_tract),
dest_state=first(dest_state),
dest_county=first(dest_county),
dest_tract=first(dest_tract),
orig_district=first(orig_district),
dest_district=first(dest_district),
mean_distance = weighted.mean(Avg.All.Trip.Length..mi.,Tot_vol),
HBW_vol=sum(HBW_vol),
HBO_vol=sum(HBO_vol),
NHB_vol=sum(NHB_vol),
Tot_vol=sum(Tot_vol),
) %>%
ungroup() %>%
filter(!is.na(mean_distance))
# set the threshold for long-distance and short-distance trips
long_distance_threshold = 60
# define the internal and external zones for the I-E and E-I trips, and categorize the trips based on the average external_distance
# update the internal and external distances if the calculated external distance is negative
data_v4 <- data_v3 %>%
left_join(district_to_gate_relationship, by=c('orig_district'='Origin','dest_district'='Destination')) %>%
filter(!is.na(Gate)) %>% # Remove internal-internal trips
rename(gate = Gate) %>%
mutate(internal_zone = ifelse(orig_district %in% c('11','12','13','14','15','16','17','18'),
orig_district, dest_district),
external_zone = ifelse(Origin.Zone.Name %in% c('11','12','13','14','15','16','17','18'),
Destination.Zone.Name, Origin.Zone.Name)) %>%
left_join(gate_to_internal_distance, by=c('gate'='gate','internal_zone'='Internal')) %>%
rename(internal_distance = Distance) %>%
mutate(external_distance_to_gate = mean_distance - internal_distance,
flag = ifelse(external_distance_to_gate < 0, 1, 0),
long_distance = ifelse(external_distance_to_gate > long_distance_threshold, 1, 0)) %>%
mutate(external_distance_to_gate = ifelse(flag == 1, 0, external_distance_to_gate),
internal_distance = ifelse(flag == 1, mean_distance, internal_distance))# compute desired attributes
data_v5 <- data_v4 %>%
group_by(internal_zone, gate) %>%
summarize(total_trip = sum(Tot_vol),
external_VMT = sum(Tot_vol*external_distance_to_gate),
internal_VMT = sum(Tot_vol*internal_distance),
long_distance_external_VMT = sum(ifelse(long_distance == 1, Tot_vol*external_distance_to_gate, 0)),
short_distance_external_VMT = sum(ifelse(long_distance == 1, 0, Tot_vol*external_distance_to_gate)),
long_distance_internal_VMT = sum(ifelse(long_distance == 1, Tot_vol*internal_distance, 0)),
short_distance_internal_VMT = sum(ifelse(long_distance == 1, 0, Tot_vol*internal_distance)),
long_distance_trip = sum(ifelse(long_distance == 1, Tot_vol, 0)),
short_distance_trip = sum(ifelse(long_distance == 1, 0, Tot_vol)))
# define a function to output the data by gates and internal zones
summarize_data_1 <- function(sum_attribute){
data_temp <- data_v5 %>%
select(internal_zone, gate, sum_attribute) %>%
spread(internal_zone, sum_attribute) %>%
replace_na(list("11"=0,"12"=0,"13"=0,"14"=0,"15"=0,"16"=0,"17"=0,"18"=0)) %>%
rename("Gate / Internal zones" = "gate")
write_csv(data_temp, paste0(sum_attribute,"_summary_1.csv"))
}
# call the function
summarize_data_1("external_VMT")
summarize_data_1("internal_VMT")
summarize_data_1("long_distance_external_VMT")
summarize_data_1("short_distance_external_VMT")
summarize_data_1("long_distance_internal_VMT")
summarize_data_1("short_distance_internal_VMT")
summarize_data_1("total_trip")
summarize_data_1("long_distance_trip")
summarize_data_1("short_distance_trip")
# group desired summaries by gates
data_v6 <- data_v5 %>%
group_by(gate) %>%
summarize(short_distance_external_VMT = sum(short_distance_external_VMT) %>% round(),
long_distance_external_VMT = sum(long_distance_external_VMT) %>% round(),
short_distance_internal_VMT = sum(short_distance_internal_VMT) %>% round(),
long_distance_internal_VMT = sum(long_distance_internal_VMT) %>% round(),
short_distance_trip = sum(short_distance_trip) %>% round(),
long_distance_trip = sum(long_distance_trip) %>% round())
# define a function to output the srummaries by gates
summarize_data_2 <- function(attribute_1, attribute_2){
data_temp <- data_v6 %>%
select(gate, attribute_1, attribute_2) %>%
rename("Gate" = "gate",
"Short-Distance Trips" = paste0(attribute_1),
"Long-Distance Trips" = paste0(attribute_2))
write_csv(data_temp, paste0(attribute_1, "_", attribute_2, "_summary_2.csv"))
}
# call the function
summarize_data_2("short_distance_external_VMT", "long_distance_external_VMT")
summarize_data_2("short_distance_internal_VMT", "long_distance_internal_VMT")
summarize_data_2("short_distance_trip", "long_distance_trip")Systems Analysis Group, WSP USA 2018