Asssignment 3: Trip Distribution
Prepared by Gregory Mallon
November 23rd, 2021
Transportation Demand Modeling
Package load and data connection
Preparation: read data into a R data frame:
#install.packages("tidyverse")
library(tidyverse)
library(readxl)
library(dplyr)
library(ipfr)
td_dememp <- read_csv("/Users/gregmallon/Desktop/TDM_Assignment_3_Mallon/data/HW3-trip-distribution-csvfiles/HW3-trip-distriubtion-DEMEMP.csv")
td_ffactor <- read_csv("/Users/gregmallon/Desktop/TDM_Assignment_3_Mallon/data/HW3-trip-distribution-csvfiles/HW3-trip-distriubtion-F-factors.csv")
td_ot <- read_csv("/Users/gregmallon/Desktop/TDM_Assignment_3_Mallon/data/HW3-trip-distribution-csvfiles/HW3-trip-distriubtion-observed-trips.csv")
td_skims <- read_csv("/Users/gregmallon/Desktop/TDM_Assignment_3_Mallon/data/HW3-trip-distribution-csvfiles/HW3-trip-distriubtion-skims.csv", )
td_skims <- td_skims %>% rename(origin_taz=`...1`)
td_skims <- pivot_longer(td_skims,
-origin_taz,
names_to="destination_taz",
values_to="travel_time")
td_skims <- td_skims %>% mutate(
origin_taz=as.integer(origin_taz),
destination_taz=as.integer(destination_taz),
travel_time_rounded = as.integer(round(travel_time)))
seed_df <- td_skims %>%
left_join(td_ffactor, by=c("travel_time_rounded"="Minutes"))
seed_matrix <- pivot_wider(seed_df,
id_cols=origin_taz,
names_from=destination_taz,
values_from=HBW)
seed_matrix <- seed_matrix %>%
select(-origin_taz) %>%
as.matrix()
dimnames(seed_matrix)[1] <- dimnames(seed_matrix)[2]
dimnames(seed_matrix)[[1]]## [1] "263" "264" "269" "271" "272" "274" "499" "500" "513" "515" "516" "517"
## [13] "518" "519"td_dememp <- td_dememp %>%
mutate(hbw_prod=`1 Person HHs` * 3.7 * .20 +
`2 Person HHs` * 7.6 * .22 +
`3 Person HHs` * 10.6 * .19 +
`4 Person HHs` * 13.6 * .19 +
`5+ Person HHs` * 16.6 * .17)
td_dememp <- td_dememp %>%
mutate(hbw_attr=`Total Employment` *1.45)
##added other other hhsiz
row_targets <- td_dememp$hbw_prod
col_targets <- td_dememp$hbw_attr
#print col_targets
col_targets## [1] 8689.85 983.10 261.00 3448.10 40800.10 372.65 15662.90 1003.40
## [9] 343.65 11868.25 15764.40 1149.85 648.15 363.95#balancing
col_targets <- col_targets * sum(row_targets)/sum(col_targets)
#Print col_targets again
col_targets## [1] 2599.94881 294.13738 78.08957 1031.64997 12207.13491 111.49455
## [7] 4686.24178 300.21101 102.81793 3550.90622 4716.60995 344.02793
## [13] 193.92243 108.89157#iterative prop fitting
trips_matrix <- ipu_matrix(seed_matrix, row_targets, col_targets)
trips_df <- round(trips_matrix, 2) %>%
as_tibble() %>%
mutate(otaz=dimnames(seed_matrix)[[1]]) %>%
select(otaz, everything())
#trips_df
trips_df## # A tibble: 14 × 15
## otaz `263` `264` `269` `271` `272` `274` `499` `500` `513` `515` `516`
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 263 752. 40.3 8.83 104. 1216. 8.52 443. 23.7 10.2 355. 486.
## 2 264 331. 54.9 10.6 124. 1454. 10.2 467. 25.0 8.39 375. 514.
## 3 269 211. 30.7 9.82 115. 1346. 9.4 382. 20.4 6.05 348. 420.
## 4 271 115. 16.8 5.35 118. 1214. 9.59 303. 14.3 3.75 190. 229.
## 5 272 8.84 1.29 0.36 7.02 106. 0.74 20.6 1.1 0.29 14.6 17.6
## 6 274 188. 24.2 7.69 168. 2234. 37.5 494. 20.7 6.12 309. 374.
## 7 499 57.0 7.32 2.06 35.1 412. 3.26 218. 10.3 2.69 120. 146.
## 8 500 36.6 4.7 1.32 17.6 206. 1.44 123. 23.0 2.84 77.0 93.2
## 9 513 46.0 4.07 1.14 10.5 123. 1.11 83.3 7.34 6.7 59.0 80.8
## 10 515 4.77 0.61 0.2 2.03 23.7 0.19 12.6 0.67 0.2 10.2 12.2
## 11 516 188. 24.2 6.8 70.4 825. 6.53 385. 23.4 7.83 352. 425.
## 12 517 189. 24.3 6.83 70.9 831. 6.59 498. 30.2 16.7 399. 547.
## 13 518 234. 30.1 8.47 87.8 1029. 8.16 545. 29.2 12.5 438. 680.
## 14 519 239. 30.7 8.63 101. 1189. 8.33 712. 71 18.6 504. 691.
## # … with 3 more variables: 517 <dbl>, 518 <dbl>, 519 <dbl>trips_df_flattened <- trips_df %>%
pivot_longer(-otaz,
names_to="dtaz",
values_to="trips") %>%
mutate(otaz=as.integer(otaz),
dtaz=as.integer(dtaz))
#trips_df_flattened
trips_df_flattened## # A tibble: 196 × 3
## otaz dtaz trips
## <int> <int> <dbl>
## 1 263 263 752.
## 2 263 264 40.3
## 3 263 269 8.83
## 4 263 271 104.
## 5 263 272 1216.
## 6 263 274 8.52
## 7 263 499 443.
## 8 263 500 23.7
## 9 263 513 10.2
## 10 263 515 355.
## # … with 186 more rowstrips_df_flattened <- trips_df_flattened %>%
left_join(td_skims, by=c("otaz"="origin_taz", "dtaz"="destination_taz"))
#trips_df_flattened again
trips_df_flattened## # A tibble: 196 × 5
## otaz dtaz trips travel_time travel_time_rounded
## <int> <int> <dbl> <dbl> <int>
## 1 263 263 752. 6.05 6
## 2 263 264 40.3 9.86 10
## 3 263 269 8.83 10.7 11
## 4 263 271 104. 13.3 13
## 5 263 272 1216. 14.3 14
## 6 263 274 8.52 18.1 18
## 7 263 499 443. 14.5 14
## 8 263 500 23.7 18.3 18
## 9 263 513 10.2 14.5 15
## 10 263 515 355. 10.6 11
## # … with 186 more rowstrips_df_flattened %>%
summarize(avg_travltime=sum(trips * travel_time)/sum(trips))## # A tibble: 1 × 1
## avg_travltime
## <dbl>
## 1 10.2ggplot(trips_df_flattened) +
geom_density(aes(x=travel_time, weights=trips))
Write Up
5.) Summarize trip length frequency distribution (TLFD). Using the balanced trip matrix and the travel time skims, calculate the average travel time (in minutes) per trip. Worksheet “Observed Trip” provides the observed TLFD and average travel costs per trip. How different is your average travel time per trip are from the observed value? Explain what may contribute to this difference. Optionally, you can plot the TLFD of your trip matrix in a line chart, superimpose it against the observed TLFD line in the “Observed Trip” worksheet, and see how different these two lines are.
My avg trip time was 10.2 minutes while the observed average trip time was 7.45 minutes. Contributions to this difference may include a number of internal-external or external-internal trips that were short in duration but unaccounted for within the model. Additionally, trip rates for the households with differing number of people could potentially over count the number of trips taken for a particular category combined with an issue with household number of people types living farther away from working locations. If those HBW trips were overcounted based on HHs then those hhs were concentrated in a particular taz then the modeled number of trips with longer trip times would be reported in the model.