pacman::p_load(dplyr, readr, sf, tidyverse, tmap, sfdep, ggpubr, Metrics, ggplot2, plotly, spdep, rjson, od, gifski, stplanr)
Caution
This article and analysis is a work-in-progress! Please read and interpret results at your own risk, check back for the final article!
Note: There is some inaccuracies with the original dataset provided by LTA on 24/4/2024, any analysis prior to 24/2/2024 may derive inaccurate conclusions
1 Notes
There are inaccuracies in the normalisation of transit data to extract bus service 167’s data, the code will be rewritten to fix issues in missing counts arising from: 1. Invalid bus service data - last bus is earlier than first bus on some services 2. Invalid assumptions - eg. Some AM Peak bus services run until outside AM Peak, however, AM Off peak schedule is not allocated, leading to invalid counts
Proposed workarounds: - Convert all bus services by preprocessing into a dataframe for bus per hour beofre using the bph data frame to normalise - leads to better performance as well
2 Overview
2.1 Background
With the introduction of Thomson East Coast Line 3 between Caldecott and Gardens by the Bay stations on DD/MM/YYYY, bridging the Upper Thomson area towards the city, the Land Transport Authority of Singapore (LTA) sought to reduce duplication of bus routes with new train lines, which was common practice in Singapore.
The announcement by the LTA to rationalise bus service 167 came with much negative response
2.2 Objectives
Understand more about the initial failure of the route rationalisation of bus service 167:
- Commuters perspective
- Why a hub-and-spoke approach (with the introduction of Thomson East Coast Line) is insufficient to shift demand? [pending analysis]
Click here to skip to the analysis
3 Getting Started
3.1 Setting Up
Packages required to be loaded for
3.2 Data Sources
| Dataset Name | Source | Methodology |
|---|---|---|
| Origin-Destination Passenger Count for Buses (OD) Nov 2023 | LTA Datamall | API |
| Bus Routes as of 26 Nov 2023 | LTA Datamall | API |
| Bus Stops as of 26 Nov 2023 | LTA Datamall | API |
4 Data Preparation
4.1 Loading Data
Loading the Origin-Destination Passenger Count for Buses
RAW_OD_2019_11 <- read.csv("data/167_OD_analysis/origin_destination_bus_201911.csv")
RAW_OD_2021_07 <- read.csv("data/167_OD_analysis/origin_destination_bus_202211.csv")
RAW_OD_2022_08 <- read.csv("data/167_OD_analysis/origin_destination_bus_202211.csv")
RAW_OD_2022_11 <- read.csv("data/167_OD_analysis/origin_destination_bus_202211.csv")
RAW_OD_2023_11 <- read.csv("data/167_OD_analysis/origin_destination_bus_202311.csv")Loading the Bus Routes JSON file:
BUS_ROUTE <- fromJSON(file="data/167_OD_analysis/busroute_2023-11-26.json")
BUS_ROUTE_2021_07 <- fromJSON(file="data/167_OD_analysis/busroute_2021-07.json")Loading the Bus Stops JSON file:
BUS_STOP <- fromJSON(file="data/167_OD_analysis/busstop_2023-11-26.json")Loading the Bus Service JSON file:
BUS_SERVICE <- fromJSON(file="data/167_OD_analysis/busservice_2023-11-26.json")
BUS_SERVICE_2021_07 <- fromJSON(file="data/167_OD_analysis/busservice_2021-07.json")Load MPSZ (2019):
mpsz <- st_read(dsn = "data/167_OD_analysis/",
layer = "MPSZ-2019") %>%
st_transform(crs = 3414)Reading layer `MPSZ-2019' from data source
`C:\Users\renji\OneDrive - Singapore Management University\0_git-projects\urbancoalesce\explore\data\167_OD_analysis'
using driver `ESRI Shapefile'
Simple feature collection with 332 features and 6 fields
Geometry type: MULTIPOLYGON
Dimension: XY
Bounding box: xmin: 103.6057 ymin: 1.158699 xmax: 104.0885 ymax: 1.470775
Geodetic CRS: WGS 844.2 Define Static Variables
4.2.1 Normalise Data
As the OD data from LTA sums trips from entire month, we need to normalise them to trips per day for ease of comparison between Weekdays, Saturdays and Sun_PH.
We first define the standard month information before executing the normalisation operations.
WEEKDAY_OF_MONTH = 21
SUN_PH_OF_MONTH = 5
SAT_OF_MONTH = 4
WEEKEND_OF_MONTH = SUN_PH_OF_MONTH + SAT_OF_MONTH
OD_2023_11 <- RAW_OD_2023_11 %>% mutate(TOTAL_TRIPS = ifelse(DAY_TYPE=="WEEKENDS/HOLIDAY", TOTAL_TRIPS / WEEKEND_OF_MONTH, TOTAL_TRIPS / WEEKDAY_OF_MONTH ))WEEKDAY_OF_MONTH = 22
SUN_PH_OF_MONTH = 4
SAT_OF_MONTH = 4
WEEKEND_OF_MONTH = SUN_PH_OF_MONTH + SAT_OF_MONTH
OD_2022_11 <- RAW_OD_2022_11 %>% mutate(TOTAL_TRIPS = ifelse(DAY_TYPE=="WEEKENDS/HOLIDAY", TOTAL_TRIPS / WEEKEND_OF_MONTH, TOTAL_TRIPS / WEEKDAY_OF_MONTH ))WEEKDAY_OF_MONTH = 21
SUN_PH_OF_MONTH = 5
SAT_OF_MONTH = 5
WEEKEND_OF_MONTH = SUN_PH_OF_MONTH + SAT_OF_MONTH
OD_2021_07 <- RAW_OD_2021_07 %>% mutate(TOTAL_TRIPS = ifelse(DAY_TYPE=="WEEKENDS/HOLIDAY", TOTAL_TRIPS / WEEKEND_OF_MONTH, TOTAL_TRIPS / WEEKDAY_OF_MONTH ))WEEKDAY_OF_MONTH = 22
SUN_PH_OF_MONTH = 4
SAT_OF_MONTH = 4
WEEKEND_OF_MONTH = SUN_PH_OF_MONTH + SAT_OF_MONTH
OD_2022_08 <- RAW_OD_2022_08 %>% mutate(TOTAL_TRIPS = ifelse(DAY_TYPE=="WEEKENDS/HOLIDAY", TOTAL_TRIPS / WEEKEND_OF_MONTH, TOTAL_TRIPS / WEEKDAY_OF_MONTH ))WEEKDAY_OF_MONTH = 21
SUN_PH_OF_MONTH = 4
SAT_OF_MONTH = 5
WEEKEND_OF_MONTH = SUN_PH_OF_MONTH + SAT_OF_MONTH
OD_2019_11 <- RAW_OD_2019_11 %>% mutate(TOTAL_TRIPS = ifelse(DAY_TYPE=="WEEKENDS/HOLIDAY", TOTAL_TRIPS / WEEKEND_OF_MONTH, TOTAL_TRIPS / WEEKDAY_OF_MONTH ))4.3 Extracting Relevant Information
For the OD Passenger Count, we are only interested in obtaining counts which involves bus service 167. We will need to extract it twice, once for each direction.
We are not implementing a check for stops since the JSON data from LTA Datamall is returned in stop sequence.
4.3.1 Extract 167 Bus Stops
Note
As LTA’s OD Count stores CBD area bus stops starting with 0 as 4 digit codes instead of 5 digit prefixed with 0, we recode the bus stops as numeric and drop the ‘0’ prefix
BS_167_DIR_1_DF <- data.frame(Seq = integer(), BS_Code = integer())
BS_167_DIR_2_DF <- data.frame(Seq = integer(), BS_Code = integer())
for (route_info in BUS_ROUTE){
if (route_info$ServiceNo == "167"){
if (route_info$Direction == 1){
BS_167_DIR_1_temp <- data.frame(Seq = as.numeric(route_info$StopSequence), BS_Code = as.numeric(route_info$BusStopCode))
BS_167_DIR_1_DF[nrow(BS_167_DIR_1_DF) +1,] <- BS_167_DIR_1_temp
}
else if (route_info$Direction == 2){
BS_167_DIR_2_temp <- data.frame(Seq = as.numeric(route_info$StopSequence), BS_Code = as.numeric(route_info$BusStopCode))
BS_167_DIR_2_DF[nrow(BS_167_DIR_2_DF) +1,] <- BS_167_DIR_2_temp
}
}
}
rm(BS_167_DIR_1_temp)
rm(BS_167_DIR_2_temp)4.3.2 Append Bus Stop Names to DataFrame
We convert the List format of Bus Stops to a more workable DataFrame format
BUS_STOP_DF <- data.frame(BS_Code = integer(), BS_Road_Name = character(), BS_Name = character(), Latitude = double(), Longitude = double())
for (bs in BUS_STOP){
BS_TEMP <- data.frame(BS_Code = as.numeric(bs$BusStopCode), BS_Road_Name = bs$RoadName, BS_Name = bs$Description, Latitude = as.numeric(bs$Latitude), Longitude = as.numeric(bs$Longitude))
BUS_STOP_DF[nrow(BUS_STOP_DF) +1,] <- BS_TEMP
}
rm(BS_TEMP)We then do a left join, merging the bus stop info into Bus Service direction DataFrames
BS_167_DIR_1_DF <- merge(x=BS_167_DIR_1_DF,y=BUS_STOP_DF,
by="BS_Code", all.x=TRUE)
BS_167_DIR_2_DF <- merge(x=BS_167_DIR_2_DF,y=BUS_STOP_DF,
by="BS_Code", all.x=TRUE)4.3.3 Reset Row Index Numbering
rownames(BS_167_DIR_1_DF) <- BS_167_DIR_1_DF$Seq
rownames(BS_167_DIR_2_DF) <- BS_167_DIR_2_DF$Seq4.3.5 Extract Bus Route Info to DataFrame
We save information that is required for our analysis from JSON to DataFrame format
BUS_ROUTE_DF <- data.frame(Service_No = character(), Direction = integer(), Seq = integer(), BS_Code = integer(), Distance = double(), WD_FirstBus = integer(), WD_LastBus = integer(), SAT_FirstBus = integer(), SAT_LastBus = integer(), SUN_FirstBus = integer(), SUN_LastBus = integer())
for (route in BUS_ROUTE){
BS_RT_TEMP <- data.frame(ServiceNo = route$ServiceNo, Direction = as.numeric(route$Direction), Seq = as.numeric(route$StopSequence), BS_Code = as.numeric(route$BusStopCode), Distance = as.numeric(route$Distance), WD_FirstBus = as.numeric(route$WD_FirstBus), WD_LastBus = as.numeric(route$WD_LastBus), SAT_FirstBus = as.numeric(route$SAT_FirstBus), SAT_LastBus = as.numeric(route$SAT_LastBus), SUN_FirstBus = as.numeric(route$SUN_FirstBus), SUN_LastBus = as.numeric(route$SUN_LastBus))
BUS_ROUTE_DF[nrow(BUS_ROUTE_DF) +1,] <- BS_RT_TEMP
}
rm(BS_RT_TEMP)BUS_ROUTE_2021_07_DF <- data.frame(Service_No = character(), Direction = integer(), Seq = integer(), BS_Code = integer(), Distance = double(), WD_FirstBus = integer(), WD_LastBus = integer(), SAT_FirstBus = integer(), SAT_LastBus = integer(), SUN_FirstBus = integer(), SUN_LastBus = integer())
for (route in BUS_ROUTE_2021_07){
BS_RT_TEMP <- data.frame(ServiceNo = route$ServiceNo, Direction = as.numeric(route$Direction), Seq = as.numeric(route$StopSequence), BS_Code = as.numeric(route$BusStopCode), Distance = as.numeric(route$Distance), WD_FirstBus = as.numeric(route$WD_FirstBus), WD_LastBus = as.numeric(route$WD_LastBus), SAT_FirstBus = as.numeric(route$SAT_FirstBus), SAT_LastBus = as.numeric(route$SAT_LastBus), SUN_FirstBus = as.numeric(route$SUN_FirstBus), SUN_LastBus = as.numeric(route$SUN_LastBus))
BUS_ROUTE_2021_07_DF[nrow(BUS_ROUTE_2021_07_DF) +1,] <- BS_RT_TEMP
}
BUS_ROUTE_2021_07_DF <- unique(BUS_ROUTE_2021_07_DF)
rm(BS_RT_TEMP)4.3.6 Extract Bus Service Info to DataFrame
PROCESS_BUS_SVC_DF <- function(BUS_SERVICE){
BUS_SVC_DF <- data.frame(Service_No = character(), Direction = integer(), Category = character(), AM_Peak_Freq = character(), AM_OffPeak_Freq = character(), PM_Peak_Freq = character(), PM_OffPeak_Freq = character(), LoopDesc = character())
for (svc in BUS_SERVICE){
BS_SVC_TEMP <- data.frame(Service_No = svc$ServiceNo, Direction = as.numeric(svc$Direction), Category = svc$Category, AM_Peak_Freq = svc$AM_Peak_Freq, AM_OffPeak_Freq = svc$AM_Offpeak_Freq, PM_OffPeak_Freq = svc$PM_Offpeak_Freq, PM_Peak_Freq = svc$PM_Peak_Freq, LoopDesc = svc$LoopDesc)
# data appears to have duplicated fields
if (nrow(BUS_SVC_DF %>% filter(Service_No == BS_SVC_TEMP$Service_No & Direction == BS_SVC_TEMP$Direction)) == 0) {
BUS_SVC_DF[nrow(BUS_SVC_DF) +1,] <- BS_SVC_TEMP
}
}
return (BUS_SVC_DF)
}
BUS_SVC_DF <- PROCESS_BUS_SVC_DF(BUS_SERVICE)
BUS_SVC_2021_07_DF <- PROCESS_BUS_SVC_DF(BUS_SERVICE_2021_07)4.3.7 Discard Unneeded Variables
rm(BUS_ROUTE)
rm(BUS_SERVICE)
rm(BUS_SERVICE_2021_07)
rm(route)
rm(svc)
rm(bs)
rm(route_info)
rm(RAW_OD_2021_07)
rm(RAW_OD_2022_08)
rm(RAW_OD_2022_11)
rm(RAW_OD_2023_11)
rm(RAW_OD_2019_11)
rm(BUS_ROUTE_2021_07)5 Exploratory Data Analysis
Investigating the Bus Stops on Bus Service 167
71 Stops
BS_167_DIR_1_DF[order(BS_167_DIR_1_DF$Seq),] BS_Code Seq BS_Road_Name BS_Name Latitude Longitude
1 58009 1 Sembawang Vista Sembawang Int 1.447482 103.8194
2 58151 2 Canberra Rd Bef Sembawang Stn 1.448359 103.8220
3 58331 3 Canberra Link Blk 589D 1.449741 103.8240
4 58039 4 Sembawang Rd Bef Canberra Dr 1.446742 103.8258
5 58029 5 Sembawang Rd The Nautical 1.443159 103.8240
6 58019 6 Sembawang Rd Aft Sembawang Shop Ctr 1.440850 103.8247
7 57139 7 Sembawang Rd Aft Jln Kemuning 1.437957 103.8256
8 57129 8 Sembawang Rd Blk 114 1.434187 103.8264
9 57119 9 Sembawang Rd Blk 101 1.431303 103.8269
10 57089 10 Sembawang Rd Blk 713 1.427405 103.8269
11 57079 11 Sembawang Rd Khatib Camp 1.424439 103.8257
12 57069 12 Sembawang Rd Opp Dieppe Barracks 1.418966 103.8246
13 57059 13 Sembawang Rd Opp Sembawang Air Base 1.414728 103.8236
14 57049 14 Sembawang Rd Opp Nee Soon HQ 22 SIB 1.410820 103.8223
15 57039 15 Sembawang Rd SPIRITUAL GRACE PRESBY CH 1.406118 103.8200
16 57029 16 Sembawang Rd Aft The Springside 1.403963 103.8186
17 57019 17 Upp Thomson Rd Springleaf Nature Pk 1.400563 103.8173
18 56099 18 Upp Thomson Rd Springleaf Stn Exit 2 1.396068 103.8188
19 56089 19 Upp Thomson Rd Aft SLE 1.392051 103.8186
20 56079 20 Upp Thomson Rd Aft Old Upp Thomson Rd 1.387566 103.8196
21 56069 21 Upp Thomson Rd Bef Tagore Dr 1.385305 103.8232
22 56059 22 Upp Thomson Rd Bef Tagore Rd 1.382688 103.8260
23 56049 23 Upp Thomson Rd Meadows @ Peirce 1.379456 103.8277
24 56039 24 Upp Thomson Rd Aft Yio Chu Kang Rd 1.376731 103.8285
25 56029 25 Upp Thomson Rd Bef Sembawang Hills Fc 1.373595 103.8287
26 56019 26 Upp Thomson Rd Bef Ang Mo Kio Ave 1 1.369486 103.8286
27 53099 27 Upp Thomson Rd Aft Ang Mo Kio Ave 1 1.366606 103.8284
28 53089 28 Upp Thomson Rd Faber Gdn 1.363977 103.8282
29 53079 29 Upp Thomson Rd Flame Tree Pk 1.360827 103.8286
30 53069 30 Upp Thomson Rd Aft Windsor Pk Rd 1.357772 103.8289
31 53059 31 Upp Thomson Rd Upp Thomson Stn Exit 2 1.355471 103.8312
32 53049 32 Upp Thomson Rd Bef Jln Todak 1.353627 103.8342
33 53039 33 Upp Thomson Rd Thomson CC 1.351447 103.8359
34 53029 34 Upp Thomson Rd Shunfu Est 1.349392 103.8373
35 53019 35 Upp Thomson Rd OPP ST. THERESA'S HME 1.346003 103.8387
36 51069 36 Thomson Rd Mt Alvernia Hosp 1.341258 103.8366
37 51059 37 Thomson Rd AFT TOA PAYOH RISE 1.337033 103.8374
38 51049 38 Thomson Rd SLF Cplx 1.333821 103.8380
39 51039 39 Thomson Rd Opp S'pore Polo Club 1.331658 103.8389
40 51029 40 Thomson Rd Opp Old Police Acad 1.330255 103.8397
41 51019 41 Thomson Rd Thomson Flyover 1.328942 103.8407
42 50059 42 Thomson Rd Opp Thomson Med Ctr 1.325264 103.8422
43 50049 43 Thomson Rd Opp Novena Lodge 1.323541 103.8419
44 50037 44 Thomson Rd Bef Novena Stn Exit B 1.321100 103.8422
45 50069 45 Newton Rd Hotel Royal 1.317022 103.8416
46 40129 46 Newton Rd Newton Life Ch 1.314538 103.8408
47 40189 47 Scotts Rd Newton Stn Exit B 1.312274 103.8381
48 40179 48 Scotts Rd Env Bldg 1.311332 103.8369
49 9219 49 Scotts Rd Far East Plaza 1.307320 103.8332
50 9047 50 Orchard Rd Orchard Stn/Tang Plaza 1.304461 103.8329
51 9037 51 Orchard Rd Bef Cairnhill Rd 1.302340 103.8370
52 8138 52 Orchard Rd Concorde Hotel S'pore 1.300479 103.8418
53 8057 53 Orchard Rd Dhoby Ghaut Stn 1.299310 103.8453
54 8069 54 Bras Basah Rd Bencoolen Stn Exit B 1.298214 103.8494
55 4179 55 Bras Basah Rd Aft Bras Basah Stn Exit A 1.296479 103.8515
56 2049 56 Bras Basah Rd Raffles Hotel 1.294521 103.8540
57 2029 57 Esplanade Dr Aft Esplanade Stn Exit D 1.290106 103.8546
58 3019 58 Collyer Quay OUE Bayfront 1.284245 103.8531
59 3059 59 Raffles Quay One Raffles Quay 1.281111 103.8515
60 3129 60 Shenton Way UIC Bldg 1.278070 103.8496
61 3218 61 Shenton Way Opp MAS Bldg 1.274079 103.8469
62 5631 62 Cantonment Link Blk 16 1.273461 103.8403
63 5521 63 Cantonment Rd Maritime Hse 1.276769 103.8406
64 10021 64 Neil Rd Blk 3 1.277448 103.8384
65 10041 65 Kg Bahru Rd BEF KAMPONG BAHRU TER 1.276058 103.8352
66 10051 66 Jln Bt Merah Blk 149 1.277412 103.8321
67 10061 67 Jln Bt Merah Blk 140 1.278605 103.8295
68 10071 68 Jln Bt Merah Blk 111 1.280453 103.8264
69 10501 69 Jln Bt Merah Blk 104 1.281058 103.8253
70 10081 70 Jln Bt Merah Opp Blk 120 1.282278 103.8224
71 10009 71 Bt Merah Ctrl Bt Merah Int 1.282102 103.817269 Stops
BS_167_DIR_2_DF[order(BS_167_DIR_2_DF$Seq),] BS_Code Seq BS_Road_Name BS_Name Latitude Longitude
1 10009 1 Bt Merah Ctrl Bt Merah Int 1.282102 103.8172
2 10089 2 Jln Bt Merah Blk 119 1.282923 103.8217
3 10079 3 Jln Bt Merah Blk 201 1.280395 103.8271
4 10069 4 Jln Bt Merah Opp Blk 140 1.278555 103.8301
5 10059 5 Jln Bt Merah Opp Blk 149 1.277397 103.8328
6 10049 6 Kg Bahru Rd OPP KAMPONG BAHRU TER 1.276233 103.8348
7 10017 7 Eu Tong Sen St Aft Hosp Dr 1.278320 103.8376
8 5519 8 Cantonment Rd Blk 1G 1.275535 103.8411
9 5629 9 Cantonment Rd Opp Southpoint 1.273211 103.8419
10 3223 10 Anson Rd Tanjong Pagar Stn Exit C 1.275703 103.8463
11 3151 11 Cecil St Opp GB Bldg 1.278921 103.8478
12 3021 12 Cecil St Prudential Twr 1.282555 103.8500
13 3011 13 Fullerton Rd Fullerton Sq 1.285618 103.8534
14 2111 14 Esplanade Dr Esplanade Bridge 1.290956 103.8545
15 4111 15 Stamford Rd Capitol Bldg 1.293954 103.8514
16 4121 16 Stamford Rd SMU 1.296185 103.8496
17 8041 17 Orchard Rd YMCA 1.298110 103.8478
18 8031 18 Penang Rd Dhoby Ghaut Stn Exit B 1.298312 103.8453
19 8111 19 Penang Rd Winsland Hse 1.299869 103.8409
20 8121 20 Somerset Rd Somerset Stn 1.300276 103.8388
21 9011 21 Orchard Turn Opp Ngee Ann City 1.302113 103.8343
22 9023 22 Orchard Turn Opp Orchard Stn/ION 1.303237 103.8325
23 9212 23 Scotts Rd Royal Plaza On Scotts 1.307022 103.8327
24 40171 24 Scotts Rd Opp Env Bldg 1.310952 103.8358
25 40181 25 Scotts Rd Newton Stn Exit A 1.312641 103.8383
26 40121 26 Newton Rd Opp Newton Life Ch 1.314582 103.8405
27 50061 27 Newton Rd Opp Hotel Royal 1.317435 103.8414
28 50031 28 Thomson Rd Opp Novena Ch 1.321378 103.8417
29 50041 29 Thomson Rd Novena Lodge 1.323623 103.8416
30 50051 30 Thomson Rd Thomson Med Ctr 1.325878 103.8418
31 51011 31 Thomson Rd Opp Tan Tong Meng Twr 1.327842 103.8406
32 51021 32 Thomson Rd Old Police Acad 1.330411 103.8391
33 51031 33 Thomson Rd S'pore Polo Club 1.331629 103.8386
34 51051 34 Thomson Rd AFT ANDREW RD 1.336354 103.8371
35 51071 35 Thomson Rd MacRitchie Resvr 1.342193 103.8360
36 53011 36 Upp Thomson Rd ST. THERESA'S HME 1.345554 103.8383
37 53021 37 Upp Thomson Rd Lakeview Estate 1.349680 103.8365
38 53041 38 Upp Thomson Rd Bef Thomson Ridge 1.353099 103.8343
39 53051 39 Upp Thomson Rd Upp Thomson Stn Exit 5 1.354995 103.8316
40 53061 40 Upp Thomson Rd Bef Windsor Pk Rd 1.357158 103.8288
41 53071 41 Upp Thomson Rd Opp Flame Tree Pk 1.360633 103.8283
42 53081 42 Upp Thomson Rd Opp Faber Gdn 1.363193 103.8278
43 53091 43 Upp Thomson Rd Bef Ang Mo Kio Ave 1 1.364820 103.8279
44 56011 44 Upp Thomson Rd Bef adana at thomson 1.368650 103.8283
45 56021 45 Upp Thomson Rd Opp Sembawang Hills FC 1.372666 103.8284
46 56031 46 Upp Thomson Rd Bef Yio Chu Kang Rd 1.376957 103.8282
47 56041 47 Upp Thomson Rd Opp Meadows @ Peirce 1.379094 103.8276
48 56051 48 Upp Thomson Rd Opp Tagore Rd 1.382495 103.8258
49 56061 49 Upp Thomson Rd Aft Tagore Dr 1.385154 103.8229
50 56071 50 Upp Thomson Rd Bef Old Upp Thomson Rd 1.387177 103.8196
51 56081 51 Upp Thomson Rd Bef SLE 1.391569 103.8182
52 56091 52 Upp Thomson Rd Springleaf Stn Exit 3 1.396200 103.8185
53 57011 53 Upp Thomson Rd Opp Springleaf Nature Pk 1.400157 103.8172
54 57021 54 Sembawang Rd Forest Hills Condo 1.404141 103.8183
55 57031 55 Sembawang Rd Nee Soon Driclad Ctr 1.407054 103.8201
56 57041 56 Sembawang Rd Nee Soon HQ 22 SIB 1.410693 103.8219
57 57051 57 Sembawang Rd Aft Sembawang Air Base 1.415206 103.8234
58 57061 58 Sembawang Rd Dieppe Barracks 1.419905 103.8245
59 57071 59 Sembawang Rd Opp Khatib Camp 1.424958 103.8255
60 57081 60 Sembawang Rd Opp Blk 713 1.427536 103.8266
61 57111 61 Sembawang Rd Opp Blk 101 1.431236 103.8265
62 57121 62 Sembawang Rd Opp Blk 115B 1.433451 103.8263
63 57131 63 Sembawang Rd Opp Jln Kemuning 1.438084 103.8253
64 58011 64 Sembawang Rd Opp Sembawang Shop Ctr 1.441356 103.8242
65 58021 65 Sembawang Rd Opp The Nautical 1.443241 103.8237
66 58031 66 Sembawang Rd Opp Canberra Dr 1.446287 103.8250
67 58339 67 Canberra Link Opp Blk 589D 1.449361 103.8243
68 58159 68 Canberra Rd Aft Admiral Hill 1.448217 103.8224
69 58009 69 Sembawang Vista Sembawang Int 1.447482 103.8194sf_BS_167_DIR_1 <- st_as_sf(BS_167_DIR_1_DF, coords = c("Longitude", "Latitude"), crs = 4326)
sf_BS_167_DIR_2 <- st_as_sf(BS_167_DIR_2_DF, coords = c("Longitude", "Latitude"), crs = 4326)
sf_BS_167_DIR_1 <- st_transform(sf_BS_167_DIR_1, crs = 3414)
sf_BS_167_DIR_2 <- st_transform(sf_BS_167_DIR_2, crs = 3414)tmap_mode("view")
tm_shape(sf_BS_167_DIR_1) +
tm_dots(col = "red") +
tm_shape(sf_BS_167_DIR_2) +
tm_dots(col = "blue")gen_od_timing <- function(input_OD, sf_bs, timing){
OD_TEST_DIR1 <- input_OD %>% filter(DAY_TYPE == "WEEKDAY" & TIME_PER_HOUR == timing)
OD_TEST_DIR1 <- OD_TEST_DIR1[5:7]
sf <- od_to_sf(OD_TEST_DIR1, sf_bs)
return (sf)
}
tmap_plot_route <- function(BS, OD) {
tmap_mode("view")
tm_shape(BS) +
tm_dots(col = "magenta", scale = 1.3) +
#tm_shape(sf_BS_167_DIR_2) +
# tm_dots(col = "blue", scale = 2) +
tm_shape(OD) +
tm_lines(col = "TOTAL_TRIPS", style="fixed", breaks = c(0, 1, 5, 10, 15, 25, 50, 80, 130, 250), lwd = "TOTAL_TRIPS", scale=20, palette="viridis")
}
plot_trip_summary <- function(OD){
summary(OD$TOTAL_TRIPS)
p <- ggplot(OD, aes(x=TOTAL_TRIPS)) + geom_histogram(binwidth=25) + xlim(0, 500) + ylim(0, 50)
ggplotly(p)
}temp_sf <- gen_od_timing(OD_2023_11_DIR1, sf_BS_167_DIR_1, 6)
tmap_plot_route(sf_BS_167_DIR_1, temp_sf)temp_sf %>% arrange(desc(TOTAL_TRIPS))Simple feature collection with 855 features and 3 fields
Geometry type: LINESTRING
Dimension: XY
Bounding box: xmin: 26208.89 ymin: 28438.32 xmax: 30372.89 ymax: 47930.55
Projected CRS: SVY21 / Singapore TM
First 10 features:
ORIGIN_PT_CODE DESTINATION_PT_CODE TOTAL_TRIPS
1 40189 9219 39.000000
2 56099 56059 33.095238
3 57029 56099 20.428571
4 56029 53059 12.761905
5 8057 2049 10.809524
6 8057 8069 10.047619
7 56019 53059 9.285714
8 56059 53059 8.333333
9 40189 40179 7.666667
10 57079 56099 6.333333
geometry
1 LINESTRING (28532.13 32730....
2 LINESTRING (26387.61 41995....
3 LINESTRING (26364.54 42868....
4 LINESTRING (27486.01 39510....
5 LINESTRING (29332.34 31296....
6 LINESTRING (29332.34 31296....
7 LINESTRING (27476.66 39056....
8 LINESTRING (27190.6 40516.1...
9 LINESTRING (28532.13 32730....
10 LINESTRING (27148.6 45132.7...plot_trip_summary(temp_sf)temp_sf <- gen_od_timing(OD_2023_11_DIR1, sf_BS_167_DIR_1, 7)
tmap_plot_route(sf_BS_167_DIR_1, temp_sf)plot_trip_summary(temp_sf)temp_sf <- gen_od_timing(OD_2023_11_DIR1, sf_BS_167_DIR_1, 8)
tmap_plot_route(sf_BS_167_DIR_1, temp_sf)plot_trip_summary(temp_sf)temp_sf <- gen_od_timing(OD_2023_11_DIR1, sf_BS_167_DIR_1, 9)
tmap_plot_route(sf_BS_167_DIR_1, temp_sf)plot_trip_summary(temp_sf)Animation of 24hrs
i_time = 5
tm_objs = list()
while (i_time < 24){
temp_sf <- gen_od_timing(OD_2023_11_DIR1, sf_BS_167_DIR_1, i_time)
result = paste("Bus Service 167 Weekday: Hour ", i_time, sep = " ")
temp_tm <-
#tm_shape(sf_BS_167_DIR_2) +
# tm_dots(col = "blue", scale = 2) +
tm_shape(mpsz, bbox = c(22000, 27000, 34000, 49000)) +
tm_polygons(alpha=0) +
tm_shape(temp_sf) +
tm_lines("TOTAL_TRIPS", style="fixed", breaks = c(0, 25, 50, 100, 250, 500, 700, 1000, 1500, 2500), lwd = "TOTAL_TRIPS", scale=10, palette="-viridis", alpha=0.8) +
tm_shape(sf_BS_167_DIR_1) +
tm_dots(col = "magenta", scale = 3, labels="BS_Code", ) +
tm_text("BS_Code", col="black", size=0.8)+
tm_layout(legend.position = c("right", "top"),
title = result,
title.position = c('right', 'top')
)
tm_objs <- append(tm_objs, list(temp_tm))
i_time = i_time + 1
}
tmap_animation(tm_objs,filename = "data/167_OD_analysis/test.gif", width=2500, height=1500, dpi=200, outer.margins = 0)I guess not very clear so we will analyse at subzone level
6 Data Analysis - Intra-Zonal Flows
Analyse by combining trips into subzone level to have a rough overview
mpsz_pln_area <- st_read(dsn = "data/167_OD_analysis/",
layer = "MP14_PLNG_AREA_WEB_PL") %>%
st_transform(crs = 3414)Reading layer `MP14_PLNG_AREA_WEB_PL' from data source
`C:\Users\renji\OneDrive - Singapore Management University\0_git-projects\urbancoalesce\explore\data\167_OD_analysis'
using driver `ESRI Shapefile'
Simple feature collection with 55 features and 12 fields
Geometry type: MULTIPOLYGON
Dimension: XY
Bounding box: xmin: 2667.538 ymin: 15748.72 xmax: 56396.44 ymax: 50256.33
Projected CRS: SVY21sf_BS_167_DIR_1_MPSZ <- st_intersection(sf_BS_167_DIR_1, mpsz_pln_area) %>%
select(BS_Code, PLN_AREA_C)
BUS_STOP_DF_MPSZ <- sf_BS_167_DIR_1_MPSZ %>% st_drop_geometry()6.1 Normalisation of values
OD Matrix shows flows between pairs of bus stops. For bus stop pairs served by different services, they will contribute to the same OD count.
This is especially evident in certain bus stop pairs, such as BS 40189 Newton Stn Exit B to BS 09219 Far East Plaza, amongst others, where commuters would likely hop on any of the many buses along the road.
6.1.0.1 Methodology
We will use this formula in calculating and estimating the OD flows for 167 bus stops using this formula below.
<insert latex formula>
Bus Per Hour (BPH) for given service at given hour = 60 / Average Frequency at given timing for the given service*
* if given service operates at 8 - 12 min during AM Peak, 10 minutes will be used, hence, computing a 10 min interval between buses and 6 buses per hour (bph)
Flow between OD Pair for a given service at given hour = Total Flow between OD Pair at given hr x (BPH for given service at given hour / Sum of BPH on all services servicing between OD Pair at given hr) ^
6.1.0.2 ^ Rules
Trip distance of services shall not exceed 3km of mean distance of all services between the OD pair for normal services (non-express)
- If services takes a large detour, we assume that passengers will not be inclined to take the detour of services since its longer
Exclusion of services that charges express fares (Express or City Direct) if OD pair is less than 5km (ie. shorter than ‘express’ sector)
Issues with assumptions:
Assumes uniform distribution across all services
For express services with express sectors, it is hard to estimate the split of passengers taking normal and express services - Assumption will be that they are equal
6.1.0.3 Computing
As LTA’s data does not provide a differentiation for bus frequencies on weekdays and weekends, we will take the average time between the intervals provided
Additionally, we will derive the frequencies as follows:
For the following timings below, LTA’s definition will be used, we will use the average of the frequency band provided:
AM Peak - 0630h to 0830h
AM Off Peak - 0831h to 1659h
PM Peak - 1700h to 1900h
PM Off Peak - after 1900h
For the following timings below:
- From start of service to 0630h - We take upper limit of AM Peak frequency
#Preprocess Bus Svc DF data to clean
BUS_SVC_DF_temp <- BUS_SVC_DF %>%
mutate(AM_Peak_Freq = lapply(AM_Peak_Freq, function(val) {
if (val == "-") {
return("-") # Keep "-" as is
}
parts <- strsplit(val, "-")[[1]]
if (length(parts) == 2 && parts[1] == parts[2]) {
return(as.numeric(parts[1])) # If the range is the same, return as a single number
} else if (length(parts) == 2) {
return(as.numeric(parts)) # Split and return as a numeric list
} else {
return(as.numeric(val)) # Return as a single numeric value
}
})) %>%
mutate(AM_OffPeak_Freq = lapply(AM_OffPeak_Freq, function(val) {
if (val == "-") {
return("-") # Keep "-" as is
}
parts <- strsplit(val, "-")[[1]]
if (length(parts) == 2 && parts[1] == parts[2]) {
return(as.numeric(parts[1])) # If the range is the same, return as a single number
} else if (length(parts) == 2) {
return(as.numeric(parts)) # Split and return as a numeric list
} else {
return(as.numeric(val)) # Return as a single numeric value
}
})) %>%
mutate(PM_Peak_Freq = lapply(PM_Peak_Freq, function(val) {
if (val == "-") {
return("-") # Keep "-" as is
}
parts <- strsplit(val, "-")[[1]]
if (length(parts) == 2 && parts[1] == parts[2]) {
return(as.numeric(parts[1])) # If the range is the same, return as a single number
} else if (length(parts) == 2) {
return(as.numeric(parts)) # Split and return as a numeric list
} else {
return(as.numeric(val)) # Return as a single numeric value
}
})) %>%
mutate(PM_OffPeak_Freq = lapply(PM_OffPeak_Freq, function(val) {
if (val == "-") {
return("-") # Keep "-" as is
}
parts <- strsplit(val, "-")[[1]]
if (length(parts) == 2 && parts[1] == parts[2]) {
return(as.numeric(parts[1])) # If the range is the same, return as a single number
} else if (length(parts) == 2) {
return(as.numeric(parts)) # Split and return as a numeric list
} else {
return(as.numeric(val)) # Return as a single numeric value
}
})) norm_bph_checker <- function(bph, BUS_SVC, DIR, BS_CODE_ORIGIN){
if (is.na(bph)){
print(BUS_SVC)
print(DIR)
print(BS_CODE_ORIGIN)
bph <- 0 #if unable to determine, zero the bph, fix this later
return (bph)
}
return (bph)
}
norm_bph <- function(BUS_SVC, DIR, HOUR, NUM_DAY_OF_WEEK, BS_CODE_ORIGIN, BS_SEQ_ORIGIN, INPUT_BUS_SVC_DF, BUS_ROUTE_DF){
# check operational
temp_flag = FALSE
temp_flag1 = FALSE
temp_flag2 = FALSE
if (HOUR < 3){
HOUR <- HOUR + 24
if (NUM_DAY_OF_WEEK > 1){
NUM_DAY_OF_WEEK <- NUM_DAY_OF_WEEK - 1
}
else{
NUM_DAY_OF_WEEK <- 7
}
}
total_time <- norm_bph_bs_operational(BUS_SVC, DIR, HOUR, NUM_DAY_OF_WEEK, BS_CODE_ORIGIN, BS_SEQ_ORIGIN, BUS_ROUTE_DF)
if (total_time == -1){
return (0)
}
else {
SEL_BUS_SVC <- INPUT_BUS_SVC_DF %>% filter(Service_No == BUS_SVC & Direction == DIR)
if (HOUR >= 19){
# Legacy code has '15' instead of '15-15'
if (SEL_BUS_SVC$PM_OffPeak_Freq == 0|| SEL_BUS_SVC$PM_OffPeak_Freq == "-"){
temp_flag = TRUE
}
if (grepl("-", SEL_BUS_SVC$PM_OffPeak_Freq) && temp_flag == FALSE){
time <- strsplit(SEL_BUS_SVC$PM_OffPeak_Freq, "-")
if (as.numeric(time[[1]][1]) == 0 && (as.numeric(time[[1]][2]) == 0)) {
temp_flag = TRUE
}
freq <- (as.numeric(time[[1]][1]) + as.numeric(time[[1]][2])) / 2
}
else{
freq = as.numeric(SEL_BUS_SVC$PM_OffPeak_Freq)
}
if (temp_flag == TRUE){
time <- strsplit(SEL_BUS_SVC$PM_Peak_Freq, "-")
freq <- (as.numeric(time[[1]][1]) + as.numeric(time[[1]][2])) / 2
}
bph <- total_time / freq
bph <- norm_bph_checker(bph, BUS_SVC, DIR, BS_CODE_ORIGIN)
}
else if(HOUR >= 17 && HOUR < 19){
if (SEL_BUS_SVC$PM_Peak_Freq == 0 || SEL_BUS_SVC$PM_Peak_Freq == "-"){
temp_flag = TRUE
}
if (grepl("-", SEL_BUS_SVC$PM_Peak_Freq) && temp_flag == FALSE){
time <- strsplit(SEL_BUS_SVC$PM_Peak_Freq, "-")
freq <- (as.numeric(time[[1]][1]) + as.numeric(time[[1]][2])) / 2
if (as.numeric(time[[1]][1]) == 0 && (as.numeric(time[[1]][2]) == 0)) {
temp_flag = TRUE
}
}
else{
freq = as.numeric(SEL_BUS_SVC$PM_Peak_Freq)
}
if (temp_flag == TRUE){
time <- strsplit(SEL_BUS_SVC$AM_OffPeak_Freq, "-")
freq <- (as.numeric(time[[1]][1]) + as.numeric(time[[1]][2])) / 2
}
bph <- total_time / freq
bph <- norm_bph_checker(bph, BUS_SVC, DIR, BS_CODE_ORIGIN)
}
else if(HOUR >= 9 && HOUR < 17){
if (SEL_BUS_SVC$AM_OffPeak_Freq == 0 || SEL_BUS_SVC$AM_OffPeak_Freq == "-"){
temp_flag = TRUE
}
if (grepl("-", SEL_BUS_SVC$AM_OffPeak_Freq) && temp_flag == FALSE){
time <- strsplit(SEL_BUS_SVC$AM_OffPeak_Freq, "-")
freq <- (as.numeric(time[[1]][1]) + as.numeric(time[[1]][2])) / 2
if (as.numeric(time[[1]][1]) == 0 && (as.numeric(time[[1]][2]) == 0)) {
temp_flag = TRUE
}
}
else{
freq = as.numeric(SEL_BUS_SVC$AM_OffPeak_Freq)
}
if (temp_flag == TRUE){
time <- strsplit(SEL_BUS_SVC$AM_Peak_Freq, "-")
freq <- (as.numeric(time[[1]][1]) + as.numeric(time[[1]][2])) / 2
}
bph <- total_time / freq
bph <- norm_bph_checker(bph, BUS_SVC, DIR, BS_CODE_ORIGIN)
}
else if(HOUR == 8){
if (SEL_BUS_SVC$AM_Peak_Freq == 0 || SEL_BUS_SVC$AM_Peak_Freq == "-"){
temp_flag1 = TRUE
}
if (SEL_BUS_SVC$AM_OffPeak_Freq == 0 || SEL_BUS_SVC$AM_OffPeak_Freq == "-"){
temp_flag2 = TRUE
}
if (grepl("-", SEL_BUS_SVC$AM_Peak_Freq)){
time <- strsplit(SEL_BUS_SVC$AM_Peak_Freq, "-")
freq1 <- (as.numeric(time[[1]][1]) + as.numeric(time[[1]][2])) / 2
if (length(time) == 2){
if (as.numeric(time[[1]][1]) == 0 && (as.numeric(time[[1]][2]) == 0)) {
temp_flag1 = TRUE
}
}
}
else{
freq1 = as.numeric(SEL_BUS_SVC$AM_Peak_Freq)
}
if (grepl("-", SEL_BUS_SVC$AM_OffPeak_Freq)){
time <- strsplit(SEL_BUS_SVC$AM_OffPeak_Freq, "-")
freq2 <- (as.numeric(time[[1]][1]) + as.numeric(time[[1]][2])) / 2
if (length(time) == 2){
if (as.numeric(time[[1]][1]) == 0 && (as.numeric(time[[1]][2]) == 0)) {
temp_flag2 = TRUE
}
}
}
else{
freq2 = as.numeric(SEL_BUS_SVC$AM_OffPeak_Freq)
}
if (total_time <= 30){
if (temp_flag1 == TRUE){
bph <- total_time / freq2
bph <- norm_bph_checker(bph, BUS_SVC, DIR, BS_CODE_ORIGIN)
}
else if (temp_flag1 == TRUE && temp_flag2 == TRUE){
print(BUS_SVC)
print(DIR)
print(origin)
print("welp")
bph <- 0
}
else{
bph <- total_time / freq1
bph <- norm_bph_checker(bph, BUS_SVC, DIR, BS_CODE_ORIGIN)
}
}
else{
if (temp_flag1 == TRUE){
bph <- total_time / freq2
bph <- norm_bph_checker(bph, BUS_SVC, DIR, BS_CODE_ORIGIN)
}
else if (temp_flag2 == TRUE){
bph <- total_time / freq1
bph <- norm_bph_checker(bph, BUS_SVC, DIR, BS_CODE_ORIGIN)
}
else{
temp_bph <- total_time / freq1
bph <- ((((total_time) / freq2) + temp_bph) / 2)
bph <- norm_bph_checker(bph, BUS_SVC, DIR, BS_CODE_ORIGIN)
}
}
}
else if(HOUR == 7){
if (grepl("-", SEL_BUS_SVC$AM_Peak_Freq)){
time <- strsplit(SEL_BUS_SVC$AM_Peak_Freq, "-")
freq <- (as.numeric(time[[1]][1]) + as.numeric(time[[1]][2])) / 2
}
else{
freq = as.numeric(SEL_BUS_SVC$AM_Peak_Freq)
}
bph <- total_time / freq
bph <- norm_bph_checker(bph, BUS_SVC, DIR, BS_CODE_ORIGIN)
}
else if(HOUR == 6){
if (grepl("-", SEL_BUS_SVC$AM_Peak_Freq)){
time <- strsplit(SEL_BUS_SVC$AM_Peak_Freq, "-")
freq1 <- as.numeric(time[[1]][2])
}
else{
freq1 = as.numeric(SEL_BUS_SVC$AM_Peak_Freq)
}
if (grepl("-", SEL_BUS_SVC$AM_Peak_Freq)){
time <- strsplit(SEL_BUS_SVC$AM_Peak_Freq, "-")
freq2 <- (as.numeric(time[[1]][1]) + as.numeric(time[[1]][2])) / 2
}
else{
freq2 = as.numeric(SEL_BUS_SVC$AM_Peak_Freq)
}
if (total_time <= 30){
bph <- total_time / freq1
bph <- norm_bph_checker(bph, BUS_SVC, DIR, BS_CODE_ORIGIN)
}
else{
temp_bph <- total_time / freq1
bph <- ((((total_time - 30) / freq2) + temp_bph) / 2)
bph <- norm_bph_checker(bph, BUS_SVC, DIR, BS_CODE_ORIGIN)
}
}
else if(HOUR >= 4 && HOUR < 6){
if (grepl("-", SEL_BUS_SVC$AM_Peak_Freq)){
time <- strsplit(SEL_BUS_SVC$AM_Peak_Freq, "-")
freq <- as.numeric(time[[1]][2])
}
else{
freq = as.numeric(SEL_BUS_SVC$AM_Peak_Freq)
}
bph <- total_time / freq
bph <- norm_bph_checker(bph, BUS_SVC, DIR, BS_CODE_ORIGIN)
}
return (bph)
}
}
norm_bph_bs_operational <- function(BUS_SVC, DIR, HOUR, NUM_DAY_OF_WEEK, BS_CODE_ORIGIN, BS_SEQ_ORIGIN, BUS_ROUTE_DF){
# BS_SEQ_ORIGIN verifies that it is the correct bus stop (eg. starting stop instead of ending terminus)
SEL_BUS_ROUTE <- BUS_ROUTE_DF %>% filter(Service_No == BUS_SVC & BS_Code == BS_CODE_ORIGIN & Direction == DIR & Seq == BS_SEQ_ORIGIN)
temp_timing <- -1
if (NUM_DAY_OF_WEEK > 0 & NUM_DAY_OF_WEEK < 6){
if (is.na(SEL_BUS_ROUTE$WD_FirstBus)){
return (-1)
}
if (SEL_BUS_ROUTE$WD_LastBus < 3 * 100){
WD_LastBus <- 2400 + SEL_BUS_ROUTE$WD_LastBus
}
else{
WD_LastBus <- SEL_BUS_ROUTE$WD_LastBus
}
if ((SEL_BUS_ROUTE$WD_FirstBus < (as.numeric(HOUR) * 100)) && (SEL_BUS_ROUTE$WD_LastBus > as.numeric(HOUR) * 100)){
temp_timing <- WD_LastBus - as.numeric(HOUR) * 100
}
else if ((SEL_BUS_ROUTE$WD_FirstBus == (as.numeric(HOUR) * 100)) && (SEL_BUS_ROUTE$WD_LastBus > as.numeric(HOUR) * 100)){
temp_timing <- as.numeric(HOUR) * 100 + 60 - SEL_BUS_ROUTE$WD_FirstBus
}
else if ((SEL_BUS_ROUTE$WD_FirstBus == (as.numeric(HOUR) * 100)) && (SEL_BUS_ROUTE$WD_LastBus == as.numeric(HOUR) * 100)){
temp_timing <- WD_LastBus - SEL_BUS_ROUTE$WD_FirstBus
}
else{
return(-1) # Not operational
}
}
else if (NUM_DAY_OF_WEEK == 6){
if (is.na(SEL_BUS_ROUTE$SAT_FirstBus)){
return (-1)
}
if (SEL_BUS_ROUTE$SAT_LastBus < 3 * 100){
Sat_LastBus <- 2400 + SEL_BUS_ROUTE$SAT_LastBus
}
else{
Sat_LastBus <- SEL_BUS_ROUTE$SAT_LastBus
}
if ((SEL_BUS_ROUTE$SAT_FirstBus < (as.numeric(HOUR) * 100)) && (SEL_BUS_ROUTE$SAT_LastBus > as.numeric(HOUR) * 100)){
temp_timing <- Sat_LastBus - as.numeric(HOUR) * 100
}
else if ((SEL_BUS_ROUTE$SAT_FirstBus == (as.numeric(HOUR) * 100)) && (SEL_BUS_ROUTE$SAT_LastBus > as.numeric(HOUR) * 100)){
temp_timing <- as.numeric(HOUR) * 100 + 60 - SEL_BUS_ROUTE$SAT_FirstBus
}
else if ((SEL_BUS_ROUTE$SAT_FirstBus == (as.numeric(HOUR) * 100)) && (SEL_BUS_ROUTE$SAT_LastBus == as.numeric(HOUR) * 100)){
temp_timing <- Sat_LastBus - SEL_BUS_ROUTE$SAT_FirstBus
}
}
else if (NUM_DAY_OF_WEEK == 7){
if (is.na(SEL_BUS_ROUTE$SUN_FirstBus)){
return (-1)
}
if (SEL_BUS_ROUTE$SUN_LastBus < 3 * 100){
Sun_LastBus <- 2400 + SEL_BUS_ROUTE$SUN_LastBus
}
else{
Sun_LastBus <- SEL_BUS_ROUTE$SUN_LastBus
}
if ((SEL_BUS_ROUTE$SUN_FirstBus < (as.numeric(HOUR) * 100)) && (SEL_BUS_ROUTE$SUN_LastBus > as.numeric(HOUR) * 100)){
temp_timing <- Sun_LastBus - as.numeric(HOUR) * 100
}
else if ((SEL_BUS_ROUTE$SUN_FirstBus == (as.numeric(HOUR) * 100)) && (SEL_BUS_ROUTE$SUN_LastBus > as.numeric(HOUR) * 100)){
temp_timing <- as.numeric(HOUR) * 100 + 60 - SEL_BUS_ROUTE$SUN_FirstBus
}
else if ((SEL_BUS_ROUTE$SUN_FirstBus == (as.numeric(HOUR) * 100)) && (SEL_BUS_ROUTE$SUN_LastBus == as.numeric(HOUR) * 100)){
temp_timing <- Sun_LastBus - SEL_BUS_ROUTE$SUN_FirstBus
}
}
if (temp_timing > 60){
return (60)
}
else{
return (temp_timing)
}
}
norm_common_bus_svcs <- function(BS_CODE_ORIGIN, BS_CODE_DEST, BUS_ROUTE_DF){
TEMP_BUS_ROUTE_DF <- BUS_ROUTE_DF[1:5]
# Filter ensures correct pairs are selected (in event of start/end stop same) and filters out inaccurate data where stops are recorded in reverse (eg. 167 Nov 8am Weekday data between 3218 and 3129)
TEMP_BUS_ROUTE_DF <- left_join(TEMP_BUS_ROUTE_DF, TEMP_BUS_ROUTE_DF, by=c("Service_No", "Direction"), suffix=c("Origin", "Dest"))
TEMP_BUS_ROUTE_OD_PAIR <- TEMP_BUS_ROUTE_DF %>% filter(BS_CodeOrigin == BS_CODE_ORIGIN & BS_CodeDest == BS_CODE_DEST & SeqOrigin < SeqDest)
return (TEMP_BUS_ROUTE_OD_PAIR)
}
norm_verify_express <- function(BUS_SVC, DIR, INPUT_BUS_SVC_DF){
SEL_BUS_SVC <- INPUT_BUS_SVC_DF %>% filter(Service_No == BUS_SVC & DIR == Direction)
BUS_CAT <- c("CITY_LINK", "EXPRESS")
if (SEL_BUS_SVC$Category %in% BUS_CAT){
return (FALSE)
}
return (TRUE)
}
norm_calc_bph <- function(BS_CODE_ORIGIN, BS_CODE_DEST, HOUR, NUM_DAY_OF_WEEK, SVC, DIR, INPUT_BUS_SVC_DF, BUS_ROUTE_DF){
common_svcs <- norm_common_bus_svcs(BS_CODE_ORIGIN, BS_CODE_DEST, BUS_ROUTE_DF)
common_svcs <- common_svcs %>% mutate(mileage = DistanceDest - DistanceOrigin)
mean_mileage <- mean(common_svcs$mileage)
bph_total <- 0
bph_svc <- 0
# if no rows (ie. all invalid data, dont run bph)
if (nrow(common_svcs) > 0){
for (i in 1:nrow(common_svcs)) {
if (common_svcs[i,]$mileage <= mean_mileage + 3){
temp_bph <- norm_bph(common_svcs[i,]$Service_No, common_svcs[i,]$Direction, HOUR, NUM_DAY_OF_WEEK, BS_CODE_ORIGIN, common_svcs[i,]$SeqOrigin, INPUT_BUS_SVC_DF, BUS_ROUTE_DF)
if (common_svcs[i,]$Service_No == SVC){
bph_svc <- temp_bph
bph_total <- bph_total + temp_bph
}
# Let us verify for express service
else if (common_svcs[i,]$mileage <= 5){
if (norm_verify_express(common_svcs[i,]$Service_No, common_svcs[i,]$Direction, INPUT_BUS_SVC_DF)){
bph_total <- bph_total + temp_bph
}
}
else{
bph_total <- bph_total + temp_bph
}
}
}
}
bph <- list(bph_svc, bph_total)
return (bph)
}
norm_flow_od <- function(FLOW, BS_CODE_ORIGIN, BS_CODE_DEST, HOUR, NUM_DAY_OF_WEEK, SVC, DIR, INPUT_BUS_SVC_DF, BUS_ROUTE_DF){
bph <- norm_calc_bph(BS_CODE_ORIGIN, BS_CODE_DEST, HOUR, NUM_DAY_OF_WEEK, SVC, DIR, INPUT_BUS_SVC_DF, BUS_ROUTE_DF)
bph_svc <- bph[[1]]
bph_total <- bph[[2]]
svc_flow <- FLOW * (bph_svc / bph_total)
if (is.nan(svc_flow)){
return (0)
}
return (svc_flow)
}6.2 Generating Flows
gen_od_timing_flows <- function(input_OD, sf_bs, timing, INPUT_BUS_SVC_DF, BUS_ROUTE_DF){
OD_TEST_DIR1 <- input_OD %>% filter(DAY_TYPE == "WEEKDAY" & TIME_PER_HOUR == timing)
#norm_flow_od <- function(FLOW, BS_CODE_ORIGIN, BS_CODE_DEST, HOUR, NUM_DAY_OF_WEEK, SVC){
OD_TEST_DIR1 <- OD_TEST_DIR1 %>% rowwise() %>% mutate(NORM_TRIPS = (norm_flow_od(TOTAL_TRIPS, ORIGIN_PT_CODE, DESTINATION_PT_CODE, TIME_PER_HOUR, 1, "167", 1, INPUT_BUS_SVC_DF, BUS_ROUTE_DF)))
OD <- left_join(OD_TEST_DIR1 , sf_bs, by = c("ORIGIN_PT_CODE" = "BS_Code")) %>% rename(ORIGIN_BS = ORIGIN_PT_CODE, ORIGIN_PA = PLN_AREA_C, DESTIN_BS = DESTINATION_PT_CODE)
OD <- left_join(OD , sf_bs, by = c("DESTIN_BS" = "BS_Code"))
return (OD)
}
gen_od_timing_PA <- function(OD_PA){
OD_PA <- OD_PA %>% rename(DESTIN_PA = PLN_AREA_C) %>% drop_na() %>% group_by(ORIGIN_PA, DESTIN_PA) %>% summarise(PA_TRIPS = sum(NORM_TRIPS))
return (OD_PA)
}
gen_od_timing_PA_intra <- function(OD_PA){
OD_PA_INTRA <- OD_PA[OD_PA$ORIGIN_PA!=OD_PA$DESTIN_PA,]
return (OD_PA_INTRA)
}
gen_od_timing_PA_inter <- function(OD_PA){
OD_PA_INTER <- OD_PA[OD_PA$ORIGIN_PA==OD_PA$DESTIN_PA,]
return (OD_PA_INTER)
}
gen_od_timing_PA_flows <- function(OD_PA_INTRA){
sf_OD_PA_INTRA_FLOWS <- od2line(flow = OD_PA_INTRA, zones = mpsz_pln_area, zone_code = "PLN_AREA_C")
return (sf_OD_PA_INTRA_FLOWS)
}
tmap_plot_pa <- function(BS, OD) {
tmap_mode("view")
tm_shape(mpsz_pln_area) +
tm_polygons("PLN_AREA_C", legend.show = FALSE, palette="Set3") +
tm_shape(BS) +
tm_dots("PLN_AREA_C", scale = 1.3, legend.show = FALSE, palette="Set3") +
#tm_shape(sf_BS_167_DIR_2) +
# tm_dots(col = "blue", scale = 2) +
tm_shape(OD) +
tm_lines(col = "PA_TRIPS", style="fixed", breaks = c(0, 1, 5, 10, 15, 25, 50, 80, 130, 250), lwd = "PA_TRIPS", scale=20, palette="viridis")
}
plot_trip_summary <- function(OD){
summary(OD$NORM_TRIPS)
p <- ggplot(OD, aes(x=NORM_TRIPS)) + geom_histogram(binwidth=25) + xlim(0, 500) + ylim(0, 50)
ggplotly(p)
}Pre-generate results
temp_sf_pa <- gen_od_timing_flows(OD_2023_11_DIR1, BUS_STOP_DF_MPSZ, 6, BUS_SVC_DF, BUS_ROUTE_DF)
saveRDS(temp_sf_pa, "data/167_OD_Analysis/sf_norm_6.rds")
temp_sf_pa <- gen_od_timing_flows(OD_2023_11_DIR1, BUS_STOP_DF_MPSZ, 7, BUS_SVC_DF, BUS_ROUTE_DF)
saveRDS(temp_sf_pa, "data/167_OD_Analysis/sf_norm_7.rds")
temp_sf_pa <- gen_od_timing_flows(OD_2023_11_DIR1, BUS_STOP_DF_MPSZ, 8, BUS_SVC_DF, BUS_ROUTE_DF)
saveRDS(temp_sf_pa, "data/167_OD_Analysis/sf_norm_8.rds")
temp_sf_pa <- gen_od_timing_flows(OD_2023_11_DIR1, BUS_STOP_DF_MPSZ, 9, BUS_SVC_DF, BUS_ROUTE_DF)
saveRDS(temp_sf_pa, "data/167_OD_Analysis/sf_norm_9.rds")
temp_sf_pa <- gen_od_timing_flows(OD_2023_11_DIR1, BUS_STOP_DF_MPSZ, 10, BUS_SVC_DF, BUS_ROUTE_DF)
saveRDS(temp_sf_pa, "data/167_OD_Analysis/sf_norm_10.rds")
temp_sf_pa <- gen_od_timing_flows(OD_2023_11_DIR1, BUS_STOP_DF_MPSZ, 11, BUS_SVC_DF, BUS_ROUTE_DF)
saveRDS(temp_sf_pa, "data/167_OD_Analysis/sf_norm_11.rds")
temp_sf_pa <- gen_od_timing_flows(OD_2023_11_DIR1, BUS_STOP_DF_MPSZ, 12, BUS_SVC_DF, BUS_ROUTE_DF)
saveRDS(temp_sf_pa, "data/167_OD_Analysis/sf_norm_12.rds")
temp_sf_pa <- gen_od_timing_flows(OD_2023_11_DIR1, BUS_STOP_DF_MPSZ, 18, BUS_SVC_DF, BUS_ROUTE_DF)
#saveRDS(temp_sf_pa, "data/167_OD_Analysis/sf_norm_18.rds")
#temp_sf_pa <- gen_od_timing_flows(OD_2023_11_DIR1, BUS_STOP_DF_MPSZ, 19, BUS_SVC_DF)
#saveRDS(temp_sf_pa, "data/167_OD_Analysis/sf_norm_19.rds")
#temp_sf_pa <- gen_od_timing_flows(OD_2023_11_DIR1, BUS_STOP_DF_MPSZ, 20, BUS_SVC_DF)
#saveRDS(temp_sf_pa, "data/167_OD_Analysis/sf_norm_20.rds")temp_sf_pa <- gen_od_timing_flows(OD_2019_11_DIR1, BUS_STOP_DF_MPSZ, 6, BUS_SVC_2021_07_DF, BUS_ROUTE_2021_07_DF)
saveRDS(temp_sf_pa, "data/167_OD_Analysis/sf_2019_11_norm_6.rds")
temp_sf_pa <- gen_od_timing_flows(OD_2019_11_DIR1, BUS_STOP_DF_MPSZ, 7, BUS_SVC_2021_07_DF, BUS_ROUTE_2021_07_DF)
saveRDS(temp_sf_pa, "data/167_OD_Analysis/sf_2019_11_norm_7.rds")
temp_sf_pa <- gen_od_timing_flows(OD_2019_11_DIR1, BUS_STOP_DF_MPSZ, 8, BUS_SVC_2021_07_DF, BUS_ROUTE_2021_07_DF)
saveRDS(temp_sf_pa, "data/167_OD_Analysis/sf_2019_11_norm_8.rds")
temp_sf_pa <- gen_od_timing_flows(OD_2019_11_DIR1, BUS_STOP_DF_MPSZ, 9, BUS_SVC_2021_07_DF, BUS_ROUTE_2021_07_DF)
saveRDS(temp_sf_pa, "data/167_OD_Analysis/sf_2019_11_norm_9.rds")
temp_sf_pa <- gen_od_timing_flows(OD_2019_11_DIR1, BUS_STOP_DF_MPSZ, 10, BUS_SVC_2021_07_DF, BUS_ROUTE_2021_07_DF)
saveRDS(temp_sf_pa, "data/167_OD_Analysis/sf_2019_11_norm_10.rds")
temp_sf_pa <- gen_od_timing_flows(OD_2019_11_DIR1, BUS_STOP_DF_MPSZ, 11, BUS_SVC_2021_07_DF, BUS_ROUTE_2021_07_DF)
saveRDS(temp_sf_pa, "data/167_OD_Analysis/sf_2019_11_norm_11.rds")
temp_sf_pa <- gen_od_timing_flows(OD_2019_11_DIR1, BUS_STOP_DF_MPSZ, 12, BUS_SVC_2021_07_DF, BUS_ROUTE_2021_07_DF)
saveRDS(temp_sf_pa, "data/167_OD_Analysis/sf_2019_11_norm_12.rds")tmap_options(check.and.fix = TRUE)
temp_sf <- readRDS("data/167_OD_Analysis/sf_norm_6.rds")
temp_sf_pa <- gen_od_timing_PA(temp_sf)
temp_sf_pa_intra <- gen_od_timing_PA_intra(temp_sf_pa)
temp_sf_pa_inter <- gen_od_timing_PA_inter(temp_sf_pa)
temp_sf_pa_intra_flows <- gen_od_timing_PA_flows(temp_sf_pa_intra)
tmap_plot_pa(sf_BS_167_DIR_1_MPSZ, temp_sf_pa_intra_flows)st_drop_geometry(temp_sf_pa_intra_flows) %>% arrange(desc(PA_TRIPS)) ORIGIN_PA DESTIN_PA PA_TRIPS
1 YS AM 54.74234771
2 AM BS 38.51508192
3 SB YS 25.77903551
4 YS BS 15.42857143
5 YS NV 9.19047619
6 YS TP 9.14285714
7 SB BS 6.19532364
8 SB TP 4.83033932
9 SB AM 4.21642429
10 YS OR 3.85714286
11 SB OR 3.61904762
12 AM TP 3.42857143
13 YS DT 3.28571429
14 AM OR 2.38095238
15 AM NV 2.28571429
16 AM DT 2.23809524
17 SB BM 1.76190476
18 AM MU 1.28571429
19 YS NT 1.28571429
20 SB NV 1.26603935
21 SB NT 0.85714286
22 BS TP 0.83564537
23 YS BM 0.80952381
24 YS MU 0.66666667
25 BS OR 0.55535831
26 BS DT 0.50757576
27 SB MU 0.33333333
28 SB DT 0.28571429
29 AM NT 0.19047619
30 BS NV 0.18881430
31 AM BM 0.04761905
32 BS MU 0.01839827
33 BS BM 0.00000000
34 BS NT 0.00000000
35 DT BM 0.00000000
36 MU BM 0.00000000
37 MU DT 0.00000000
38 NT BM 0.00000000
39 NT DT 0.00000000
40 NT MU 0.00000000
41 NT OR 0.00000000
42 NV BM 0.00000000
43 NV DT 0.00000000
44 NV MU 0.00000000
45 NV NT 0.00000000
46 NV OR 0.00000000
47 OR BM 0.00000000
48 OR DT 0.00000000
49 OR MU 0.00000000
50 TP BM 0.00000000
51 TP DT 0.00000000
52 TP MU 0.00000000
53 TP NT 0.00000000
54 TP NV 0.00000000
55 TP OR 0.00000000plot_trip_summary(temp_sf)temp_sf_pa_inter %>% arrange(desc(PA_TRIPS))# A tibble: 11 × 3
# Groups: ORIGIN_PA [11]
ORIGIN_PA DESTIN_PA PA_TRIPS
<chr> <chr> <dbl>
1 YS YS 71.6
2 SB SB 3.57
3 BS BS 1.68
4 AM AM 1.21
5 BM BM 0
6 DT DT 0
7 MU MU 0
8 NT NT 0
9 NV NV 0
10 OR OR 0
11 TP TP 0 temp_sf <- readRDS("data/167_OD_Analysis/sf_2019_11_norm_6.rds")
temp_sf_pa <- gen_od_timing_PA(temp_sf)
temp_sf_pa_intra <- gen_od_timing_PA_intra(temp_sf_pa)
temp_sf_pa_inter <- gen_od_timing_PA_inter(temp_sf_pa)
temp_sf_pa_intra_flows <- gen_od_timing_PA_flows(temp_sf_pa_intra)
tmap_plot_pa(sf_BS_167_DIR_1_MPSZ, temp_sf_pa_intra_flows)st_drop_geometry(temp_sf_pa_intra_flows) %>% arrange(desc(PA_TRIPS)) ORIGIN_PA DESTIN_PA PA_TRIPS
1 AM BS 786.05784
2 YS BS 774.85714
3 SB YS 679.77357
4 YS AM 425.14286
5 SB BS 320.30898
6 YS TP 286.28571
7 YS OR 252.00000
8 SB AM 246.06193
9 SB DT 157.71429
10 YS NV 155.14286
11 YS DT 126.00000
12 YS NT 108.00000
13 SB TP 107.82602
14 SB OR 103.71429
15 AM NV 87.42857
16 YS MU 81.42857
17 AM OR 72.85714
18 SB MU 71.14286
19 AM TP 70.28571
20 SB NT 55.71429
21 SB NV 49.52949
22 YS BM 39.42857
23 SB BM 35.14286
24 AM BM 31.71429
25 AM MU 25.71429
26 AM DT 18.00000
27 AM NT 6.00000
28 BS BM 0.00000
29 BS DT 0.00000
30 BS MU 0.00000
31 BS NT 0.00000
32 BS NV 0.00000
33 BS OR 0.00000
34 BS TP 0.00000
35 DT BM 0.00000
36 MU BM 0.00000
37 MU DT 0.00000
38 NT BM 0.00000
39 NT DT 0.00000
40 NT MU 0.00000
41 NT OR 0.00000
42 NV BM 0.00000
43 NV DT 0.00000
44 NV MU 0.00000
45 NV NT 0.00000
46 NV OR 0.00000
47 OR BM 0.00000
48 OR DT 0.00000
49 OR MU 0.00000
50 TP BM 0.00000
51 TP DT 0.00000
52 TP MU 0.00000
53 TP NT 0.00000
54 TP NV 0.00000
55 TP OR 0.00000plot_trip_summary(temp_sf)temp_sf_pa_inter %>% arrange(desc(PA_TRIPS))# A tibble: 11 × 3
# Groups: ORIGIN_PA [11]
ORIGIN_PA DESTIN_PA PA_TRIPS
<chr> <chr> <dbl>
1 YS YS 895.
2 SB SB 89.1
3 AM AM 47.5
4 BM BM 0
5 BS BS 0
6 DT DT 0
7 MU MU 0
8 NT NT 0
9 NV NV 0
10 OR OR 0
11 TP TP 0 tmap_options(check.and.fix = TRUE)
temp_sf <- readRDS("data/167_OD_Analysis/sf_norm_7.rds")
temp_sf_pa <- gen_od_timing_PA(temp_sf)
temp_sf_pa_intra <- gen_od_timing_PA_intra(temp_sf_pa)
temp_sf_pa_inter <- gen_od_timing_PA_inter(temp_sf_pa)
temp_sf_pa_intra_flows <- gen_od_timing_PA_flows(temp_sf_pa_intra)
tmap_plot_pa(sf_BS_167_DIR_1_MPSZ, temp_sf_pa_intra_flows)st_drop_geometry(temp_sf_pa_intra_flows) %>% arrange(desc(PA_TRIPS)) ORIGIN_PA DESTIN_PA PA_TRIPS
1 YS AM 33.57826831
2 SB YS 31.09948302
3 AM BS 28.73420840
4 YS BS 11.18796992
5 OR DT 10.57549732
6 SB AM 9.85964912
7 NV DT 9.61231495
8 NV NT 9.10384571
9 MU DT 9.05398997
10 BS NV 8.55373148
11 NT OR 7.77622980
12 SB BS 7.39097744
13 BS TP 5.89719357
14 NV OR 5.80429713
15 YS OR 5.47619048
16 DT BM 5.15935139
17 AM TP 5.15288221
18 TP NV 4.82434563
19 YS NV 4.66917293
20 AM OR 4.57142857
21 AM NV 3.88471178
22 NT BM 3.73729941
23 NV MU 3.31962520
24 YS DT 2.71428571
25 BS OR 2.38187633
26 YS TP 2.26566416
27 BS DT 2.07088989
28 AM MU 2.00000000
29 TP OR 1.96015832
30 NV BM 1.76207235
31 OR BM 1.66452805
32 OR MU 1.54323233
33 SB DT 1.52380952
34 TP DT 1.47252747
35 AM DT 1.38095238
36 YS NT 1.33333333
37 SB TP 1.22055138
38 NT DT 1.12380952
39 TP NT 1.11875822
40 MU BM 0.88216961
41 AM NT 0.85714286
42 BS BM 0.82509158
43 BS NT 0.80000000
44 BS MU 0.78095238
45 YS MU 0.76190476
46 SB OR 0.61904762
47 TP MU 0.59047619
48 SB MU 0.57142857
49 SB NV 0.48120301
50 TP BM 0.44041154
51 SB BM 0.42857143
52 NT MU 0.37895761
53 YS BM 0.23809524
54 AM BM 0.19047619
55 SB NT 0.04761905plot_trip_summary(temp_sf)temp_sf_pa_inter %>% arrange(desc(PA_TRIPS))# A tibble: 11 × 3
# Groups: ORIGIN_PA [11]
ORIGIN_PA DESTIN_PA PA_TRIPS
<chr> <chr> <dbl>
1 YS YS 40.9
2 BM BM 20.7
3 SB SB 8.32
4 BS BS 5.22
5 DT DT 2.40
6 MU MU 2.01
7 TP TP 1.66
8 NV NV 1.65
9 OR OR 1.33
10 AM AM 1.24
11 NT NT 0.279temp_sf <- readRDS("data/167_OD_Analysis/sf_2019_11_norm_7.rds")
temp_sf_pa <- gen_od_timing_PA(temp_sf)
temp_sf_pa_intra <- gen_od_timing_PA_intra(temp_sf_pa)
temp_sf_pa_inter <- gen_od_timing_PA_inter(temp_sf_pa)
temp_sf_pa_intra_flows <- gen_od_timing_PA_flows(temp_sf_pa_intra)
tmap_plot_pa(sf_BS_167_DIR_1_MPSZ, temp_sf_pa_intra_flows)st_drop_geometry(temp_sf_pa_intra_flows) %>% arrange(desc(PA_TRIPS)) ORIGIN_PA DESTIN_PA PA_TRIPS
1 AM BS 1509.72857
2 SB YS 1238.18966
3 SB AM 677.78571
4 YS BS 650.18571
5 YS AM 595.02857
6 SB BS 440.70000
7 YS OR 325.71429
8 YS DT 316.28571
9 YS NT 266.57143
10 AM TP 210.42857
11 YS NV 205.41429
12 AM NV 159.00000
13 YS TP 152.65714
14 AM OR 150.85714
15 BS TP 134.85285
16 SB OR 127.71429
17 YS MU 112.28571
18 BS NV 89.84221
19 SB DT 81.42857
20 SB NV 78.77143
21 AM DT 78.00000
22 SB NT 78.00000
23 SB TP 73.50000
24 BS OR 62.11296
25 SB MU 60.00000
26 AM MU 54.85714
27 AM NT 51.42857
28 BS DT 18.68571
29 BS BM 17.03571
30 BS NT 15.42857
31 SB BM 15.42857
32 BS MU 13.02857
33 AM BM 10.28571
34 YS BM 10.28571
35 DT BM 0.00000
36 MU BM 0.00000
37 MU DT 0.00000
38 NT BM 0.00000
39 NT DT 0.00000
40 NT MU 0.00000
41 NT OR 0.00000
42 NV BM 0.00000
43 NV DT 0.00000
44 NV MU 0.00000
45 NV NT 0.00000
46 NV OR 0.00000
47 OR BM 0.00000
48 OR DT 0.00000
49 OR MU 0.00000
50 TP BM 0.00000
51 TP DT 0.00000
52 TP MU 0.00000
53 TP NT 0.00000
54 TP NV 0.00000
55 TP OR 0.00000plot_trip_summary(temp_sf)temp_sf_pa_inter %>% arrange(desc(PA_TRIPS))# A tibble: 11 × 3
# Groups: ORIGIN_PA [11]
ORIGIN_PA DESTIN_PA PA_TRIPS
<chr> <chr> <dbl>
1 YS YS 875.
2 BS BS 241.
3 SB SB 195.
4 AM AM 64.0
5 BM BM 0
6 DT DT 0
7 MU MU 0
8 NT NT 0
9 NV NV 0
10 OR OR 0
11 TP TP 0 tmap_options(check.and.fix = TRUE)
temp_sf <- readRDS("data/167_OD_Analysis/sf_norm_8.rds")
temp_sf_pa <- gen_od_timing_PA(temp_sf)
temp_sf_pa_intra <- gen_od_timing_PA_intra(temp_sf_pa)
temp_sf_pa_inter <- gen_od_timing_PA_inter(temp_sf_pa)
temp_sf_pa_intra_flows <- gen_od_timing_PA_flows(temp_sf_pa_intra)
tmap_plot_pa(sf_BS_167_DIR_1_MPSZ, temp_sf_pa_intra_flows)st_drop_geometry(temp_sf_pa_intra_flows) %>% arrange(desc(PA_TRIPS)) ORIGIN_PA DESTIN_PA PA_TRIPS
1 YS AM 54.2710323
2 AM BS 31.6403363
3 MU DT 30.5803798
4 SB YS 28.7579756
5 NV OR 18.0658537
6 OR DT 17.9298779
7 NV NT 17.8644522
8 NV DT 14.8688962
9 NT OR 13.1950568
10 YS BS 11.1175987
11 BS NV 9.1853777
12 DT BM 8.2857811
13 SB AM 8.0134077
14 BS OR 6.8846852
15 TP NV 6.3871104
16 BS TP 6.0623215
17 NV MU 5.7794747
18 SB BS 5.2853683
19 NT BM 5.1880693
20 OR BM 4.8051573
21 YS OR 3.9523810
22 NV BM 3.7346189
23 YS NV 3.6384672
24 OR MU 3.2319503
25 AM NV 2.8946412
26 AM DT 2.8571429
27 BS DT 2.7208639
28 TP OR 2.5683165
29 YS TP 2.5591454
30 MU BM 2.2396705
31 SB OR 2.0000000
32 AM OR 1.8571429
33 NT DT 1.7244444
34 TP NT 1.7220120
35 SB NV 1.6173608
36 TP DT 1.5734196
37 YS NT 1.5714286
38 BS BM 1.4939711
39 BS MU 1.2793651
40 AM MU 1.2380952
41 SB DT 1.1428571
42 YS DT 1.1428571
43 NT MU 0.9330574
44 SB BM 0.9047619
45 SB MU 0.8571429
46 YS MU 0.8571429
47 BS NT 0.7932275
48 TP BM 0.7242923
49 SB NT 0.7142857
50 AM TP 0.6502746
51 TP MU 0.6158730
52 AM BM 0.5238095
53 AM NT 0.5238095
54 YS BM 0.5238095
55 SB TP 0.3106700plot_trip_summary(temp_sf)temp_sf_pa_inter %>% arrange(desc(PA_TRIPS))# A tibble: 11 × 3
# Groups: ORIGIN_PA [11]
ORIGIN_PA DESTIN_PA PA_TRIPS
<chr> <chr> <dbl>
1 YS YS 42.4
2 BM BM 23.3
3 SB SB 15.9
4 BS BS 8.02
5 DT DT 6.40
6 MU MU 6.15
7 NV NV 4.37
8 OR OR 3.33
9 TP TP 1.72
10 AM AM 0.927
11 NT NT 0.388temp_sf <- readRDS("data/167_OD_Analysis/sf_2022_08_norm_8.rds")
temp_sf_pa <- gen_od_timing_PA(temp_sf)
temp_sf_pa_intra <- gen_od_timing_PA_intra(temp_sf_pa)
temp_sf_pa_inter <- gen_od_timing_PA_inter(temp_sf_pa)
temp_sf_pa_intra_flows <- gen_od_timing_PA_flows(temp_sf_pa_intra)
tmap_plot_pa(sf_BS_167_DIR_1_MPSZ, temp_sf_pa_intra_flows)st_drop_geometry(temp_sf_pa_intra_flows) %>% arrange(desc(PA_TRIPS)) ORIGIN_PA DESTIN_PA PA_TRIPS
1 YS AM 34.07596623
2 SB YS 30.11558226
3 MU DT 17.50312366
4 AM BS 13.74581896
5 NV NT 13.31479073
6 NT OR 10.42373226
7 YS BS 9.81361332
8 NV OR 9.26508277
9 BS OR 8.89583921
10 BS NV 8.82433153
11 NV DT 8.64074929
12 SB AM 8.07348055
13 OR DT 7.92913657
14 DT BM 6.91241364
15 BS TP 6.71294019
16 TP NV 4.97525238
17 SB BS 4.85434345
18 AM OR 3.95454545
19 NT BM 3.92788997
20 NV MU 3.40236268
21 TP OR 3.30260869
22 YS OR 3.22727273
23 AM NV 2.63637230
24 OR BM 2.47676305
25 YS NV 2.31003753
26 YS TP 2.16785282
27 NV BM 2.11790061
28 BS NT 2.01718518
29 BS DT 1.97900894
30 MU BM 1.96673914
31 AM DT 1.54545455
32 BS MU 1.45079869
33 SB NV 1.32401155
34 TP NT 1.29948458
35 OR MU 1.25179954
36 SB TP 1.14569120
37 AM TP 1.04896104
38 SB OR 1.04545455
39 NT DT 0.99672158
40 AM NT 0.90909091
41 SB BM 0.86363636
42 YS BM 0.72727273
43 YS DT 0.72727273
44 BS BM 0.64610641
45 TP DT 0.64566814
46 AM MU 0.54545455
47 SB MU 0.50000000
48 YS MU 0.45454545
49 NT MU 0.42109735
50 SB DT 0.40909091
51 YS NT 0.22727273
52 TP BM 0.19808992
53 SB NT 0.13636364
54 AM BM 0.04545455
55 TP MU 0.04529843plot_trip_summary(temp_sf)temp_sf_pa_inter %>% arrange(desc(PA_TRIPS))# A tibble: 10 × 3
# Groups: ORIGIN_PA [10]
ORIGIN_PA DESTIN_PA PA_TRIPS
<chr> <chr> <dbl>
1 BM BM 28.8
2 YS YS 23.6
3 SB SB 15.9
4 BS BS 5.05
5 MU MU 4.37
6 NV NV 3.10
7 DT DT 2.53
8 TP TP 1.18
9 AM AM 0.483
10 NT NT 0.443tmap_options(check.and.fix = TRUE)
temp_sf <- readRDS("data/167_OD_Analysis/sf_norm_9.rds")
temp_sf_pa <- gen_od_timing_PA(temp_sf)
temp_sf_pa_intra <- gen_od_timing_PA_intra(temp_sf_pa)
temp_sf_pa_inter <- gen_od_timing_PA_inter(temp_sf_pa)
temp_sf_pa_intra_flows <- gen_od_timing_PA_flows(temp_sf_pa_intra)
tmap_plot_pa(sf_BS_167_DIR_1_MPSZ, temp_sf_pa_intra_flows)st_drop_geometry(temp_sf_pa_intra_flows) %>% arrange(desc(PA_TRIPS)) ORIGIN_PA DESTIN_PA PA_TRIPS
1 YS AM 44.4343029
2 SB YS 30.5689412
3 AM BS 30.0865350
4 YS BS 10.2073733
5 BS OR 6.8376469
6 BS NV 6.2699710
7 SB BS 4.7250384
8 SB AM 4.5161290
9 BS TP 4.4519105
10 AM OR 4.2380952
11 YS OR 2.9047619
12 YS NV 2.5145929
13 SB OR 2.3333333
14 AM NV 1.8156682
15 YS DT 1.5714286
16 YS TP 1.4976959
17 BS DT 1.3604724
18 BS MU 1.2505495
19 SB BM 1.1428571
20 SB MU 1.0952381
21 BS NT 1.0373626
22 AM TP 1.0368664
23 AM MU 0.9047619
24 SB TP 0.8663594
25 SB NV 0.7987711
26 BS BM 0.6570839
27 YS BM 0.6190476
28 YS MU 0.5714286
29 YS NT 0.5238095
30 SB NT 0.4761905
31 SB DT 0.4285714
32 AM DT 0.3333333
33 AM BM 0.2857143
34 AM NT 0.1904762
35 DT BM 0.0000000
36 MU BM 0.0000000
37 MU DT 0.0000000
38 NT BM 0.0000000
39 NT DT 0.0000000
40 NT MU 0.0000000
41 NT OR 0.0000000
42 NV BM 0.0000000
43 NV DT 0.0000000
44 NV MU 0.0000000
45 NV NT 0.0000000
46 NV OR 0.0000000
47 OR BM 0.0000000
48 OR DT 0.0000000
49 OR MU 0.0000000
50 TP BM 0.0000000
51 TP DT 0.0000000
52 TP MU 0.0000000
53 TP NT 0.0000000
54 TP NV 0.0000000
55 TP OR 0.0000000plot_trip_summary(temp_sf)temp_sf_pa_inter %>% arrange(desc(PA_TRIPS))# A tibble: 11 × 3
# Groups: ORIGIN_PA [11]
ORIGIN_PA DESTIN_PA PA_TRIPS
<chr> <chr> <dbl>
1 YS YS 40.8
2 SB SB 11.0
3 BS BS 9.45
4 AM AM 2.12
5 BM BM 0
6 DT DT 0
7 MU MU 0
8 NT NT 0
9 NV NV 0
10 OR OR 0
11 TP TP 0 temp_sf <- readRDS("data/167_OD_Analysis/sf_2022_08_norm_9.rds")
temp_sf_pa <- gen_od_timing_PA(temp_sf)
temp_sf_pa_intra <- gen_od_timing_PA_intra(temp_sf_pa)
temp_sf_pa_inter <- gen_od_timing_PA_inter(temp_sf_pa)
temp_sf_pa_intra_flows <- gen_od_timing_PA_flows(temp_sf_pa_intra)
tmap_plot_pa(sf_BS_167_DIR_1_MPSZ, temp_sf_pa_intra_flows)st_drop_geometry(temp_sf_pa_intra_flows) %>% arrange(desc(PA_TRIPS)) ORIGIN_PA DESTIN_PA PA_TRIPS
1 SB YS 23.52388899
2 NT OR 13.11159840
3 YS AM 12.39929348
4 AM BS 11.78810901
5 NV OR 10.87292276
6 YS BS 9.78056426
7 MU DT 9.75765634
8 BS OR 8.58422589
9 NV NT 7.58918104
10 OR DT 7.03574694
11 DT BM 4.92796058
12 BS NV 4.82779222
13 YS OR 4.13636364
14 SB BS 3.89341693
15 NV DT 3.65195039
16 TP NV 3.55175622
17 TP OR 3.01961239
18 BS TP 2.80914925
19 AM OR 2.77272727
20 YS NV 2.60188088
21 NV MU 2.44651958
22 OR BM 2.42647067
23 SB OR 2.18181818
24 BS MU 1.89445300
25 NV BM 1.78671034
26 AM NV 1.62225705
27 NT DT 1.43297381
28 OR MU 1.36214865
29 NT BM 1.35217723
30 YS TP 1.34012539
31 MU BM 1.33266058
32 BS NT 1.32819723
33 YS DT 1.27272727
34 BS DT 1.26668396
35 SB NV 1.21159875
36 TP NT 1.12547902
37 SB AM 1.03291536
38 YS BM 0.81818182
39 SB BM 0.81818182
40 AM DT 0.72727273
41 YS MU 0.68181818
42 TP DT 0.58636946
43 TP MU 0.54930663
44 AM TP 0.51724138
45 SB MU 0.50000000
46 AM MU 0.45454545
47 AM NT 0.45454545
48 NT MU 0.44581990
49 SB TP 0.37304075
50 SB DT 0.27272727
51 YS NT 0.27272727
52 BS BM 0.22477889
53 AM BM 0.13636364
54 TP BM 0.12397456
55 SB NT 0.04545455plot_trip_summary(temp_sf)temp_sf_pa_inter %>% arrange(desc(PA_TRIPS))# A tibble: 11 × 3
# Groups: ORIGIN_PA [11]
ORIGIN_PA DESTIN_PA PA_TRIPS
<chr> <chr> <dbl>
1 BM BM 18.6
2 YS YS 16.4
3 SB SB 7.07
4 BS BS 3.66
5 MU MU 2.52
6 DT DT 2.13
7 OR OR 2.07
8 NV NV 1.82
9 AM AM 0.765
10 TP TP 0.503
11 NT NT 0.201tmap_options(check.and.fix = TRUE)
temp_sf <- readRDS("data/167_OD_Analysis/sf_norm_10.rds")
temp_sf_pa <- gen_od_timing_PA(temp_sf)
temp_sf_pa_intra <- gen_od_timing_PA_intra(temp_sf_pa)
temp_sf_pa_inter <- gen_od_timing_PA_inter(temp_sf_pa)
temp_sf_pa_intra_flows <- gen_od_timing_PA_flows(temp_sf_pa_intra)
tmap_plot_pa(sf_BS_167_DIR_1_MPSZ, temp_sf_pa_intra_flows)st_drop_geometry(temp_sf_pa_intra_flows) %>% arrange(desc(PA_TRIPS)) ORIGIN_PA DESTIN_PA PA_TRIPS
1 AM BS 21.2747834
2 SB YS 21.0954385
3 YS AM 17.7397835
4 YS BS 9.4700461
5 BS OR 8.6380552
6 BS NV 5.1985960
7 YS OR 3.8095238
8 BS TP 3.2914145
9 AM OR 2.8571429
10 YS NV 2.8371736
11 SB BS 2.8033794
12 AM NV 1.9508449
13 BS MU 1.9047619
14 SB NV 1.8986175
15 SB OR 1.7142857
16 AM MU 1.5238095
17 SB AM 1.4270353
18 YS TP 1.3133641
19 BS DT 1.1970846
20 SB BM 1.1428571
21 AM DT 0.9523810
22 AM TP 0.9216590
23 SB DT 0.9047619
24 YS MU 0.9047619
25 SB MU 0.8095238
26 YS BM 0.6666667
27 YS DT 0.6666667
28 BS NT 0.6527473
29 BS BM 0.5867891
30 SB TP 0.3010753
31 AM NT 0.2857143
32 YS NT 0.2857143
33 SB NT 0.1904762
34 AM BM 0.0952381
35 DT BM 0.0000000
36 MU BM 0.0000000
37 MU DT 0.0000000
38 NT BM 0.0000000
39 NT DT 0.0000000
40 NT MU 0.0000000
41 NT OR 0.0000000
42 NV BM 0.0000000
43 NV DT 0.0000000
44 NV MU 0.0000000
45 NV NT 0.0000000
46 NV OR 0.0000000
47 OR BM 0.0000000
48 OR DT 0.0000000
49 OR MU 0.0000000
50 TP BM 0.0000000
51 TP DT 0.0000000
52 TP MU 0.0000000
53 TP NT 0.0000000
54 TP NV 0.0000000
55 TP OR 0.0000000plot_trip_summary(temp_sf)temp_sf_pa_inter %>% arrange(desc(PA_TRIPS))# A tibble: 11 × 3
# Groups: ORIGIN_PA [11]
ORIGIN_PA DESTIN_PA PA_TRIPS
<chr> <chr> <dbl>
1 YS YS 36.5
2 SB SB 7.18
3 BS BS 6.70
4 AM AM 1.56
5 BM BM 0
6 DT DT 0
7 MU MU 0
8 NT NT 0
9 NV NV 0
10 OR OR 0
11 TP TP 0 temp_sf <- readRDS("data/167_OD_Analysis/sf_2022_08_norm_10.rds")
temp_sf_pa <- gen_od_timing_PA(temp_sf)
temp_sf_pa_intra <- gen_od_timing_PA_intra(temp_sf_pa)
temp_sf_pa_inter <- gen_od_timing_PA_inter(temp_sf_pa)
temp_sf_pa_intra_flows <- gen_od_timing_PA_flows(temp_sf_pa_intra)
tmap_plot_pa(sf_BS_167_DIR_1_MPSZ, temp_sf_pa_intra_flows)st_drop_geometry(temp_sf_pa_intra_flows) %>% arrange(desc(PA_TRIPS)) ORIGIN_PA DESTIN_PA PA_TRIPS
1 SB YS 23.70643555
2 NT OR 14.98442916
3 NV OR 11.10588830
4 AM BS 10.01186494
5 BS OR 9.52055775
6 YS BS 7.35893417
7 MU DT 6.41002806
8 DT BM 6.02473026
9 YS AM 5.66385857
10 OR DT 5.47792942
11 BS NV 4.76305766
12 YS OR 4.45454545
13 SB BS 4.41849530
14 NV NT 4.34459988
15 AM OR 3.68181818
16 TP OR 3.17858732
17 YS NV 3.05172414
18 OR MU 2.41135024
19 NV MU 2.39306248
20 TP NV 2.35968691
21 BS MU 2.33590139
22 BS TP 2.04174059
23 NV DT 1.70338534
24 SB OR 1.54545455
25 OR BM 1.54499142
26 BS DT 1.41859994
27 YS TP 1.36363636
28 MU BM 1.23805997
29 YS MU 1.22727273
30 AM NV 1.22100313
31 SB NV 1.05015674
32 AM MU 1.04545455
33 SB AM 1.01880878
34 NT BM 0.97191472
35 YS DT 0.81818182
36 NV BM 0.80058152
37 BS NT 0.71417565
38 YS BM 0.68181818
39 TP DT 0.63788051
40 AM DT 0.63636364
41 YS NT 0.63636364
42 AM TP 0.61128527
43 NT MU 0.57601644
44 SB BM 0.54545455
45 BS BM 0.50150790
46 AM NT 0.50000000
47 TP NT 0.46359864
48 SB DT 0.45454545
49 TP MU 0.40600924
50 SB TP 0.37147335
51 SB MU 0.36363636
52 NT DT 0.35593220
53 AM BM 0.31818182
54 TP BM 0.05122898
55 SB NT 0.04545455plot_trip_summary(temp_sf)temp_sf_pa_inter %>% arrange(desc(PA_TRIPS))# A tibble: 11 × 3
# Groups: ORIGIN_PA [11]
ORIGIN_PA DESTIN_PA PA_TRIPS
<chr> <chr> <dbl>
1 BM BM 17.0
2 YS YS 14.4
3 SB SB 7.38
4 BS BS 3.62
5 OR OR 1.88
6 MU MU 1.59
7 NV NV 1.25
8 DT DT 1.09
9 AM AM 0.472
10 TP TP 0.275
11 NT NT 0.110tmap_options(check.and.fix = TRUE)
temp_sf <- readRDS("data/167_OD_Analysis/sf_norm_11.rds")
temp_sf_pa <- gen_od_timing_PA(temp_sf)
temp_sf_pa_intra <- gen_od_timing_PA_intra(temp_sf_pa)
temp_sf_pa_inter <- gen_od_timing_PA_inter(temp_sf_pa)
temp_sf_pa_intra_flows <- gen_od_timing_PA_flows(temp_sf_pa_intra)
tmap_plot_pa(sf_BS_167_DIR_1_MPSZ, temp_sf_pa_intra_flows)st_drop_geometry(temp_sf_pa_intra_flows) %>% arrange(desc(PA_TRIPS)) ORIGIN_PA DESTIN_PA PA_TRIPS
1 AM BS 23.1021945
2 SB YS 21.1604270
3 YS AM 9.5641540
4 BS NV 8.9579231
5 YS BS 6.6820276
6 BS OR 6.4885775
7 SB BS 3.5437788
8 YS OR 3.4285714
9 BS TP 3.2688161
10 AM OR 3.0476190
11 YS NV 2.4992320
12 BS MU 1.8095238
13 AM NV 1.7250384
14 AM MU 1.5238095
15 SB OR 1.3333333
16 YS MU 1.2380952
17 SB AM 1.2104455
18 YS TP 1.1059908
19 BS DT 0.9648447
20 SB BM 0.9523810
21 YS BM 0.9047619
22 SB NV 0.7803379
23 SB DT 0.7619048
24 AM DT 0.6666667
25 SB NT 0.6666667
26 BS BM 0.6369320
27 SB MU 0.5714286
28 SB TP 0.4685100
29 YS DT 0.4285714
30 AM TP 0.4147465
31 AM NT 0.3809524
32 BS NT 0.3142857
33 AM BM 0.2857143
34 YS NT 0.2857143
35 DT BM 0.0000000
36 MU BM 0.0000000
37 MU DT 0.0000000
38 NT BM 0.0000000
39 NT DT 0.0000000
40 NT MU 0.0000000
41 NT OR 0.0000000
42 NV BM 0.0000000
43 NV DT 0.0000000
44 NV MU 0.0000000
45 NV NT 0.0000000
46 NV OR 0.0000000
47 OR BM 0.0000000
48 OR DT 0.0000000
49 OR MU 0.0000000
50 TP BM 0.0000000
51 TP DT 0.0000000
52 TP MU 0.0000000
53 TP NT 0.0000000
54 TP NV 0.0000000
55 TP OR 0.0000000plot_trip_summary(temp_sf)temp_sf_pa_inter %>% arrange(desc(PA_TRIPS))# A tibble: 11 × 3
# Groups: ORIGIN_PA [11]
ORIGIN_PA DESTIN_PA PA_TRIPS
<chr> <chr> <dbl>
1 YS YS 41.5
2 SB SB 9.21
3 BS BS 7.51
4 AM AM 4.52
5 BM BM 0
6 DT DT 0
7 MU MU 0
8 NT NT 0
9 NV NV 0
10 OR OR 0
11 TP TP 0 temp_sf <- readRDS("data/167_OD_Analysis/sf_2022_08_norm_11.rds")
temp_sf_pa <- gen_od_timing_PA(temp_sf)
temp_sf_pa_intra <- gen_od_timing_PA_intra(temp_sf_pa)
temp_sf_pa_inter <- gen_od_timing_PA_inter(temp_sf_pa)
temp_sf_pa_intra_flows <- gen_od_timing_PA_flows(temp_sf_pa_intra)
tmap_plot_pa(sf_BS_167_DIR_1_MPSZ, temp_sf_pa_intra_flows)st_drop_geometry(temp_sf_pa_intra_flows) %>% arrange(desc(PA_TRIPS)) ORIGIN_PA DESTIN_PA PA_TRIPS
1 SB YS 17.9809515
2 NT OR 14.9389157
3 NV OR 14.1748976
4 AM BS 10.9059058
5 BS NV 7.6524662
6 DT BM 7.6284027
7 BS OR 6.5732211
8 MU DT 6.5110928
9 OR DT 6.3631264
10 YS BS 5.3840125
11 TP OR 4.6741084
12 NV NT 4.5787345
13 YS AM 4.2788372
14 TP NV 3.9576175
15 YS OR 3.3636364
16 OR MU 3.2098482
17 SB BS 3.1661442
18 YS NV 2.9357367
19 NV MU 2.3715720
20 BS TP 2.3348854
21 AM NV 2.2664577
22 AM OR 2.0909091
23 OR BM 2.0229314
24 BS MU 1.5770416
25 NT MU 1.5444142
26 MU BM 1.4118396
27 YS MU 1.4090909
28 YS TP 1.2931034
29 AM MU 1.0909091
30 NV BM 1.0889000
31 NV DT 0.9871697
32 BS NT 0.9653313
33 SB OR 0.9545455
34 TP MU 0.9075501
35 NT BM 0.8942427
36 SB AM 0.8652038
37 TP BM 0.8344283
38 BS DT 0.7770966
39 SB BM 0.7727273
40 NT DT 0.7642527
41 YS BM 0.7272727
42 AM TP 0.7053292
43 TP NT 0.6699143
44 SB TP 0.6003135
45 SB NV 0.5031348
46 AM DT 0.4545455
47 YS NT 0.4545455
48 YS DT 0.4090909
49 SB NT 0.3636364
50 BS BM 0.3197187
51 SB DT 0.3181818
52 AM BM 0.2272727
53 AM NT 0.2272727
54 SB MU 0.1363636
55 TP DT 0.1202809plot_trip_summary(temp_sf)temp_sf_pa_inter %>% arrange(desc(PA_TRIPS))# A tibble: 11 × 3
# Groups: ORIGIN_PA [11]
ORIGIN_PA DESTIN_PA PA_TRIPS
<chr> <chr> <dbl>
1 BM BM 19.6
2 YS YS 15.4
3 SB SB 6.67
4 BS BS 3.89
5 NV NV 2.70
6 OR OR 2.17
7 MU MU 1.47
8 AM AM 1.22
9 DT DT 1.13
10 TP TP 0.397
11 NT NT 0.122tmap_options(check.and.fix = TRUE)
temp_sf <- readRDS("data/167_OD_Analysis/sf_norm_12.rds")
temp_sf_pa <- gen_od_timing_PA(temp_sf)
temp_sf_pa_intra <- gen_od_timing_PA_intra(temp_sf_pa)
temp_sf_pa_inter <- gen_od_timing_PA_inter(temp_sf_pa)
temp_sf_pa_intra_flows <- gen_od_timing_PA_flows(temp_sf_pa_intra)
tmap_plot_pa(sf_BS_167_DIR_1_MPSZ, temp_sf_pa_intra_flows)st_drop_geometry(temp_sf_pa_intra_flows) %>% arrange(desc(PA_TRIPS)) ORIGIN_PA DESTIN_PA PA_TRIPS
1 AM BS 21.0200907
2 SB YS 16.2956036
3 YS AM 12.2789541
4 YS BS 8.7557604
5 BS OR 5.0818342
6 BS NV 4.7899094
7 BS TP 3.7610780
8 YS OR 3.3809524
9 SB BS 2.7050691
10 YS NV 2.5637481
11 AM OR 2.2380952
12 SB OR 1.7142857
13 AM NV 1.6513057
14 SB AM 1.6175115
15 AM MU 1.5714286
16 YS TP 1.4976959
17 YS MU 1.4285714
18 BS DT 1.2286029
19 YS BM 1.1428571
20 BS MU 1.1355311
21 SB BM 1.0476190
22 BS BM 0.9717770
23 AM DT 0.9047619
24 SB TP 0.8586790
25 AM TP 0.6682028
26 YS DT 0.6666667
27 BS NT 0.6490842
28 SB MU 0.6190476
29 SB NV 0.4685100
30 AM NT 0.4285714
31 SB NT 0.4285714
32 SB DT 0.3333333
33 YS NT 0.3333333
34 AM BM 0.2380952
35 DT BM 0.0000000
36 MU BM 0.0000000
37 MU DT 0.0000000
38 NT BM 0.0000000
39 NT DT 0.0000000
40 NT MU 0.0000000
41 NT OR 0.0000000
42 NV BM 0.0000000
43 NV DT 0.0000000
44 NV MU 0.0000000
45 NV NT 0.0000000
46 NV OR 0.0000000
47 OR BM 0.0000000
48 OR DT 0.0000000
49 OR MU 0.0000000
50 TP BM 0.0000000
51 TP DT 0.0000000
52 TP MU 0.0000000
53 TP NT 0.0000000
54 TP NV 0.0000000
55 TP OR 0.0000000plot_trip_summary(temp_sf)temp_sf_pa_inter %>% arrange(desc(PA_TRIPS))# A tibble: 11 × 3
# Groups: ORIGIN_PA [11]
ORIGIN_PA DESTIN_PA PA_TRIPS
<chr> <chr> <dbl>
1 YS YS 51.6
2 SB SB 11.1
3 BS BS 8.16
4 AM AM 6.96
5 BM BM 0
6 DT DT 0
7 MU MU 0
8 NT NT 0
9 NV NV 0
10 OR OR 0
11 TP TP 0 temp_sf <- readRDS("data/167_OD_Analysis/sf_2022_08_norm_12.rds")
temp_sf_pa <- gen_od_timing_PA(temp_sf)
temp_sf_pa_intra <- gen_od_timing_PA_intra(temp_sf_pa)
temp_sf_pa_inter <- gen_od_timing_PA_inter(temp_sf_pa)
temp_sf_pa_intra_flows <- gen_od_timing_PA_flows(temp_sf_pa_intra)
tmap_plot_pa(sf_BS_167_DIR_1_MPSZ, temp_sf_pa_intra_flows)st_drop_geometry(temp_sf_pa_intra_flows) %>% arrange(desc(PA_TRIPS)) ORIGIN_PA DESTIN_PA PA_TRIPS
1 NT OR 24.85549247
2 SB YS 13.90229578
3 NV OR 13.28310736
4 AM BS 10.91327757
5 DT BM 8.90601900
6 YS BS 7.19435737
7 OR DT 7.01158812
8 MU DT 6.24309310
9 BS OR 5.93354205
10 OR MU 4.68234172
11 NV NT 4.48868463
12 BS NV 3.94236101
13 YS AM 3.59061125
14 TP OR 3.51598654
15 TP NV 3.24403400
16 NV MU 3.16478835
17 OR BM 3.14465229
18 MU BM 2.83015368
19 AM OR 2.77272727
20 YS OR 2.72727273
21 BS TP 2.52009477
22 YS BM 2.13636364
23 YS NV 2.09717868
24 SB BM 2.09090909
25 SB BS 1.93103448
26 SB AM 1.66457680
27 YS MU 1.45454545
28 BS MU 1.35901387
29 SB TP 1.32131661
30 YS TP 1.31661442
31 NV DT 1.27386426
32 SB OR 1.27272727
33 AM NV 1.21473354
34 NV BM 1.19540213
35 NT MU 1.17444833
36 SB NV 1.09874608
37 AM MU 1.04545455
38 TP MU 0.93143297
39 BS NT 0.83590139
40 YS NT 0.72727273
41 BS DT 0.67925375
42 TP NT 0.67192273
43 NT BM 0.63557886
44 AM DT 0.59090909
45 SB MU 0.59090909
46 TP BM 0.49677156
47 NT DT 0.49460709
48 AM NT 0.45454545
49 BS BM 0.34042337
50 AM TP 0.28213166
51 SB DT 0.27272727
52 TP DT 0.24056183
53 YS DT 0.18181818
54 AM BM 0.09090909
55 SB NT 0.09090909plot_trip_summary(temp_sf)temp_sf_pa_inter %>% arrange(desc(PA_TRIPS))# A tibble: 11 × 3
# Groups: ORIGIN_PA [11]
ORIGIN_PA DESTIN_PA PA_TRIPS
<chr> <chr> <dbl>
1 BM BM 18.2
2 YS YS 17.8
3 SB SB 9.77
4 BS BS 4.13
5 DT DT 3.27
6 OR OR 2.79
7 AM AM 2.24
8 NV NV 2.16
9 MU MU 1.59
10 TP TP 0.405
11 NT NT 0.0976gen_od_timing2 <- function(input_OD, sf_bs){
sf <- od_to_sf(input_OD, sf_bs)
return (sf)
}
tmap_plot_route <- function(BS, OD) {
tmap_mode("view")
tm_shape(BS) +
tm_dots(col = "magenta", scale = 2) +
#tm_shape(sf_BS_167_DIR_2) +
# tm_dots(col = "blue", scale = 2) +
tm_shape(OD) +
tm_lines(col = "TOTAL_TRIPS", style="fixed", breaks = c(0, 1, 5, 10, 15, 25, 40, 60, 80, 100), lwd = "TOTAL_TRIPS", scale=15, palette="viridis")
}
plot_trip_summary <- function(OD){
summary(OD$TOTAL_TRIPS)
p <- ggplot(OD, aes(x=TOTAL_TRIPS)) + geom_histogram(binwidth=25) + xlim(0, 500) + ylim(0, 50)
ggplotly(p)
}od_norm <- readRDS("data/167_OD_Analysis/sf_norm_8.rds")
temp_bs_data <- BS_167_DIR_1_DF %>% arrange(BS_167_DIR_1_DF$Seq)
bs_flow_norm <- data.frame(ORIGIN_BS = integer(), DESTIN_BS = integer(), TOTAL_TRIPS = double())
current_bs <- temp_bs_data[1,]$BS_Code
current_flow <- 0
for (i in 2:nrow(temp_bs_data)){
next_bs <- temp_bs_data[i,]$BS_Code
# Boarding Pax
temp_flow <- sum((od_norm %>% filter(ORIGIN_BS == current_bs))$NORM_TRIPS)
if (is.na(temp_flow) == FALSE){
current_flow <- current_flow + temp_flow
}
# Alighting Pax
temp_flow <- sum((od_norm %>% filter(DESTIN_BS == current_bs))$NORM_TRIPS)
if (is.na(temp_flow) == FALSE){
current_flow <- current_flow - temp_flow
}
bs_flow_norm_temp <- data.frame(ORIGIN_BS = current_bs, DESTIN_BS = next_bs, TOTAL_TRIPS = current_flow)
bs_flow_norm[nrow(bs_flow_norm) +1,] <- bs_flow_norm_temp
current_bs <- next_bs
}
bs_flow_norm ORIGIN_BS DESTIN_BS TOTAL_TRIPS
1 58009 58151 9.500948
2 58151 58331 9.863217
3 58331 58039 36.287934
4 58039 58029 47.335553
5 58029 58019 54.096452
6 58019 57139 55.691207
7 57139 57129 49.603830
8 57129 57119 66.936578
9 57119 57089 75.835138
10 57089 57079 81.108014
11 57079 57069 83.762319
12 57069 57059 83.565107
13 57059 57049 81.144957
14 57049 57039 80.247547
15 57039 57029 84.617757
16 57029 57019 93.170721
17 57019 56099 92.768264
18 56099 56089 100.479717
19 56089 56079 100.461802
20 56079 56069 100.421754
21 56069 56059 96.196801
22 56059 56049 51.764144
23 56049 56039 63.578077
24 56039 56029 69.254491
25 56029 56019 74.806136
26 56019 53099 80.380529
27 53099 53089 79.850883
28 53089 53079 83.258058
29 53079 53069 85.616415
30 53069 53059 87.793696
31 53059 53049 61.077342
32 53049 53039 63.058500
33 53039 53029 64.910006
34 53029 53019 61.320146
35 53019 51069 60.757038
36 51069 51059 61.675243
37 51059 51049 62.499156
38 51049 51039 60.222727
39 51039 51029 60.917687
40 51029 51019 61.760596
41 51019 50059 64.765650
42 50059 50049 69.742622
43 50049 50037 73.772003
44 50037 50069 65.784210
45 50069 40129 80.066044
46 40129 40189 101.355989
47 40189 40179 98.880239
48 40179 9219 99.207401
49 9219 9047 86.267413
50 9047 9037 78.329942
51 9037 8138 76.964359
52 8138 8057 76.650951
53 8057 8069 94.106168
54 8069 4179 95.598935
55 4179 2049 94.678899
56 2049 2029 93.023967
57 2029 3019 91.790829
58 3019 3059 76.124086
59 3059 3129 56.511681
60 3129 3218 34.566237
61 3218 5631 28.423941
62 5631 5521 25.343490
63 5521 10021 27.606474
64 10021 10041 28.827638
65 10041 10051 31.053511
66 10051 10061 29.731031
67 10061 10071 30.540106
68 10071 10501 28.196094
69 10501 10081 28.251659
70 10081 10009 10.246177tmap_plot_route(sf_BS_167_DIR_1, gen_od_timing2(bs_flow_norm, sf_BS_167_DIR_1))od_norm <- readRDS("data/167_OD_Analysis/sf_2022_08_norm_8.rds")
temp_bs_data <- BS_167_DIR_1_DF %>% arrange(BS_167_DIR_1_DF$Seq)
bs_flow_norm <- data.frame(ORIGIN_BS = integer(), DESTIN_BS = integer(), TOTAL_TRIPS = double())
current_bs <- temp_bs_data[1,]$BS_Code
current_flow <- 0
for (i in 2:nrow(temp_bs_data)){
next_bs <- temp_bs_data[i,]$BS_Code
# Boarding Pax
temp_flow <- sum((od_norm %>% filter(ORIGIN_BS == current_bs))$NORM_TRIPS)
if (is.na(temp_flow) == FALSE){
current_flow <- current_flow + temp_flow
}
# Alighting Pax
temp_flow <- sum((od_norm %>% filter(DESTIN_BS == current_bs))$NORM_TRIPS)
if (is.na(temp_flow) == FALSE){
current_flow <- current_flow - temp_flow
}
bs_flow_norm_temp <- data.frame(ORIGIN_BS = current_bs, DESTIN_BS = next_bs, TOTAL_TRIPS = current_flow)
bs_flow_norm[nrow(bs_flow_norm) +1,] <- bs_flow_norm_temp
current_bs <- next_bs
}
bs_flow_norm ORIGIN_BS DESTIN_BS TOTAL_TRIPS
1 58009 58151 0.000000
2 58151 58331 0.370632
3 58331 58039 35.961541
4 58039 58029 42.552450
5 58029 58019 45.928612
6 58019 57139 42.358280
7 57139 57129 37.010858
8 57129 57119 34.355141
9 57119 57089 54.246291
10 57089 57079 55.280606
11 57079 57069 54.813015
12 57069 57059 54.451175
13 57059 57049 51.013129
14 57049 57039 50.948759
15 57039 57029 52.467239
16 57029 57019 57.732522
17 57019 56099 56.864001
18 56099 56089 67.874545
19 56089 56079 67.874545
20 56079 56069 67.792461
21 56069 56059 65.587640
22 56059 56049 34.463993
23 56049 56039 42.368519
24 56039 56029 45.578747
25 56029 56019 48.466882
26 56019 53099 50.156250
27 53099 53089 49.959232
28 53089 53079 52.261437
29 53079 53069 54.454077
30 53069 53059 57.443489
31 53059 53049 52.503237
32 53049 53039 53.763319
33 53039 53029 56.945371
34 53029 53019 52.720287
35 53019 51069 52.268685
36 51069 51059 51.937465
37 51059 51049 52.708777
38 51049 51039 50.896768
39 51039 51029 50.093635
40 51029 51019 48.672663
41 51019 50059 51.659642
42 50059 50049 50.952868
43 50049 50037 52.173153
44 50037 50069 45.582504
45 50069 40129 54.578685
46 40129 40189 68.330523
47 40189 40179 66.643827
48 40179 9219 66.195776
49 9219 9047 44.025566
50 9047 9037 44.025566
51 9037 8138 44.025566
52 8138 8057 44.025566
53 8057 8069 60.185733
54 8069 4179 59.479678
55 4179 2049 58.473773
56 2049 2029 56.116295
57 2029 3019 54.879382
58 3019 3059 46.204501
59 3059 3129 46.204501
60 3129 3218 46.204501
61 3218 5631 47.931546
62 5631 5521 46.912613
63 5521 10021 49.768524
64 10021 10041 52.683549
65 10041 10051 55.228638
66 10051 10061 56.311844
67 10061 10071 55.932815
68 10071 10501 54.659104
69 10501 10081 54.289465
70 10081 10009 40.333258tmap_plot_route(sf_BS_167_DIR_1, gen_od_timing2(bs_flow_norm, sf_BS_167_DIR_1))Todo list:
Visualisation tmap for Subzone / bus stop see how to display data
EDA on trip - derivation on initial analysis (eg. focus on AM Peak Dir 1?)
- Sequential trial and error, might be worthwhile to check off peak trends as well - without data cannot determine which user group but maybe can guess?
K-means clustering on types of stops based on temporal data - each stop, pattern based on day type [probably seperate article]