Composite traffic model: Difference between revisions

From Opasnet
Jump to navigation Jump to search
(new version, more streamlined but some bugs persist)
 
(26 intermediate revisions by 3 users not shown)
Line 1: Line 1:
[[Category:Composite traffic]]
[[Category:Composite traffic]]
[[Category:Online model]]
[[Category:Code under inspection]]
{{method|moderator=Smxb|stub=Yes}}
{{method|moderator=Smxb|stub=Yes}}


This page is about a '''composite traffic model''' that is an updated version of [[file:Composite traffic.ANA]]. The new version is coded with [[R]].
This page is about a '''composite traffic model''' that is an updated version of [[file:Composite traffic.ANA]]. The new version is coded with [[R]].


== Definition ==
== Question ==


=== R model ===
How to estimate potential to aggregate individual trips into public transportation or composite vehicles (airport-taxi-like vehicles for several passengers)?
 
== Answer ==
 
== Rationale ==
 
=== Variables ===
 
*[[Trip rate on a workday in the Helsinki metropolitan area]]
*[[Route matrix in the Helsinki metropolitan area]]
*[[Distance matrix in the Helsinki metropolitan area]]
 
<rcode name="initiate" label="Initiate data objects">
 
library(OpasnetUtils)
 
roads <- opbase.data("Op_en2634") # , series_id = 2575, apply.utf8 = FALSE)
colnames(roads)[3] <- "Through"
 
distance <- opbase.data("Op_en5322") # , include = 14299, exclude = c(53097, 53098))
 
trips <- opbase.data(
"Op_en2625",
include = list(Time = c("7", "7.2", "7.4", "7.6", "7.8", "8", "8.2", "8.4", "8.6", "8.8", "9"))
) # , include = 53096)
 
objects.store(roads, distance, trips)
 
cat("Successfully stored roads, distance, and trips.\n")
 
</rcode>
 
[http://en.opasnet.org/en-opwiki/index.php?title=Special:RTools&id=SY82hcxhmS9tQkRQ Initiation code]
 
=== Actual model ===


*Trip aggregator
*Trip aggregator
Line 17: Line 53:
:#Re-check vehicle configurations, when exact numbers of primary and secondary passengers as well as transferees are known
:#Re-check vehicle configurations, when exact numbers of primary and secondary passengers as well as transferees are known


<rcode>
<rcode graphics=1>
 
library(OpasnetUtils)
library(ggplot2)
library(reshape2)
 
objects.latest("Op_en5136", code_name = "initiate")
 
# Trip aggregator, sampled passenger data as input
# Trip aggregator, sampled passenger data as input


Line 27: Line 70:
trips.secondary <- data.frame()
trips.secondary <- data.frame()


times <- seq(1, 25, 1 / n.intervals.per.h)
times <- seq(7, 9, 1 / n.intervals.per.h)
times[length(times)] <- 1


library(OpasnetBaseUtils)
speed <- 40 # kmh^-1


roads <- op_baseGetData("opasnet_base", "Op_en2634", apply.utf8 = FALSE)
tdelay <- distance[distance$Mode == "Car" & distance$Time == "1", c("From", "To", "Result")]
colnames(roads)[6] <- "Through"
tdelay$Result <- ceiling((tdelay$Result / speed) * n.intervals.per.h) / n.intervals.per.h
 
colnames(tdelay)[colnames(tdelay) %in% "Result"] <- "Delay"
trips.locs <- op_baseGetLocs("opasnet_base", "Op_en2625", apply.utf8 = FALSE)


for (i in 1:(length(times) - 2)) {
for (i in 1:(length(times) - 2)) {
if(i == 1) {
if(i == 1) {
trips.sample.1 <- op_baseGetData("opasnet_base", "Op_en2625", include = trips.locs$loc_id[trips.locs$ind == "Time" &
trips.sample.1 <- trips[trips$Time == times[1],]
trips.locs$loc == times[1]])
trips.sample.1$Secondary <- 0
trips.sample.1$Secondary <- 0
} else {
} else {
Line 47: Line 89:
}
}
trips.sample.2 <- op_baseGetData("opasnet_base", "Op_en2625", include = trips.locs$loc_id[trips.locs$ind == "Time" &
trips.sample.2 <- trips[trips$Time == times[i + 1],]
trips.locs$loc == times[i + 1]])
# Optimizer main code
# Optimizer main code
Line 90: Line 131:
colnames(trips.left.trans)[3] <- "Destination"
colnames(trips.left.trans)[3] <- "Destination"
colnames(trips.left.trans)[2] <- "To"
colnames(trips.left.trans)[2] <- "To"
# print(i)
# if(i >9) print(head(trips.left.trans))
trips.sample.1 <- merge(trips.sample.1, as.data.frame(as.table(tapply(trips.left.trans$Transferred, trips.left.trans[,c("From","To")], sum))),  
trips.sample.1 <- merge(trips.sample.1, as.data.frame(as.table(tapply(trips.left.trans$Transferred, trips.left.trans[,c("From","To")], sum))),  
all.x = TRUE)
all.x = TRUE)
Line 122: Line 165:
# Add transferred passengers to the next time slot as secondary passengers
# Add transferred passengers to the next time slot as secondary passengers
# delay <- distance / speed
trips.left.trans <- merge(trips.left.trans, tdelay)
delay <- 0.2
colnames(trips.left.trans)[5] <- "Secondary"
colnames(trips.left.trans)[5] <- "Secondary"
Line 129: Line 171:
colnames(trips.left.trans)[2] <- "From"
colnames(trips.left.trans)[2] <- "From"
colnames(trips.left.trans)[3] <- "To"
colnames(trips.left.trans)[3] <- "To"
trips.left.trans$Time <- as.character(as.numeric(as.character(trips.left.trans$Time)) + delay)
trips.left.trans$Time <- as.character(as.numeric(as.character(trips.left.trans$Time)) + trips.left.trans$Delay)
trips.left.trans <- as.data.frame(as.table(tapply(trips.left.trans$Secondary, trips.left.trans[,
trips.left.trans <- as.data.frame(as.table(tapply(trips.left.trans$Secondary, trips.left.trans[,
Line 140: Line 182:
trips.out <- rbind(trips.out, data.frame(trips.sample.1[, c("From", "To", "Time")], d8, d4, d3, d2, d1, c8, c4, c3, c2, c1))
trips.out <- rbind(trips.out, data.frame(trips.sample.1[, c("From", "To", "Time")], d8, d4, d3, d2, d1, c8, c4, c3, c2, c1))
}
}
# Summary
d8 <- tapply(trips.out$d8, trips.out$Time, sum)
d4 <- tapply(trips.out$d4, trips.out$Time, sum)
d3 <- tapply(trips.out$d3, trips.out$Time, sum)
d2 <- tapply(trips.out$d2, trips.out$Time, sum)
d1 <- tapply(trips.out$d1, trips.out$Time, sum)
c8 <- tapply(trips.out$c8, trips.out$Time, sum)
c4 <- tapply(trips.out$c4, trips.out$Time, sum)
c3 <- tapply(trips.out$c3, trips.out$Time, sum)
c2 <- tapply(trips.out$c2, trips.out$Time, sum)
c1 <- tapply(trips.out$c1, trips.out$Time, sum)
test <- data.frame(Time = names(d8), Type = rep(colnames(trips.out)[4:13], each = length(d8)),
Result = c(d8, d4, d3, d2, d1, c8, c4, c3, c2, c1))
test$Time <- as.numeric(as.character(test$Time))
ggplot(test, aes(x = Time, y = Result, fill = Type)) + geom_area()
# Vehicle kilometers
d8 <- tapply(trips.out$d8, trips.out[,c("From","To")], sum)
d4 <- tapply(trips.out$d4, trips.out[,c("From","To")], sum)
d3 <- tapply(trips.out$d3, trips.out[,c("From","To")], sum)
d2 <- tapply(trips.out$d2, trips.out[,c("From","To")], sum)
d1 <- tapply(trips.out$d1, trips.out[,c("From","To")], sum)
c8 <- tapply(trips.out$c8, trips.out[,c("From","To")], sum)
c4 <- tapply(trips.out$c4, trips.out[,c("From","To")], sum)
c3 <- tapply(trips.out$c3, trips.out[,c("From","To")], sum)
c2 <- tapply(trips.out$c2, trips.out[,c("From","To")], sum)
c1 <- tapply(trips.out$c1, trips.out[,c("From","To")], sum)
n.full.8.cars <- as.data.frame(as.table((d8 + c8) / 8))
n.full.4.cars <- as.data.frame(as.table((d4 + c4) / 4))
n.4.cars.3.pas <- as.data.frame(as.table((d3 + c3) / 3))
n.4.cars.2.pas <- as.data.frame(as.table((d2 + c2) / 2))
n.4.cars.1.pas <- as.data.frame(as.table(d1 + c1))
colnames(n.full.8.cars)[3] <- "n.full.8.cars"
colnames(n.full.4.cars)[3] <- "n.full.4.cars"
colnames(n.4.cars.3.pas)[3] <- "n.4.cars.3.pas"
colnames(n.4.cars.2.pas)[3] <- "n.4.cars.2.pas"
colnames(n.4.cars.1.pas)[3] <- "n.4.cars.1.pas"
test2 <- merge(n.full.8.cars, n.full.4.cars)
test2 <- merge(test2, n.4.cars.3.pas)
test2 <- merge(test2, n.4.cars.2.pas)
test2 <- merge(test2, n.4.cars.1.pas)
test2 <- melt(test2, id.vars = c("From","To"), variable_name = "Type")
test2 <- merge(test2, distance[,c("From", "To", "Result")])
colnames(test2)[5] <- "Distance"
test2$vehicle.kilometers <- test2$value * test2$Distance
# Costs
oprint(head(test2))
test3 <- as.data.frame(as.table(tapply(test2$vehicle.kilometers, test2$Type, sum)))
colnames(test3) <- c("Type", "vehicle.kilometers")
fuel.cons.emis.CO2 <- data.frame(Type = c("n.full.8.cars", "n.full.4.cars", "n.4.cars.3.pas", "n.4.cars.2.pas", "n.4.cars.1.pas"),
Consumption = c(8.7, 5.7, 5.7, 5.7, 5.7) / 100, Emis.factor.CO2 = c(232, 153, 153, 153, 153))
emis.factor.PM <- 0.1 # gkm^-1
fuel.price <- 1.374 # 4.8. average cost of a liter of diesel fuel in Finland
maint.price <- 0.0582 # €km^-1
driver.salary <- 2313 / 160 * 1.35 # €h^-1
test3 <- merge(test3, fuel.cons.emis.CO2)
test3$Fuel.cost <- test3$vehicle.kilometers * test3$Consumption * fuel.price
test3$Maint.cost <- test3$vehicle.kilometers * maint.price
test3$Emis.CO2 <- test3$vehicle.kilometers * test3$Emis.factor.CO2
test3$Emis.PM <- test3$vehicle.kilometers * emis.factor.PM
test3$Driver.cost <- test3$vehicle.kilometers / speed * driver.salary
PM.lethality <- c(-7.223e-004, 5.640e-006, 4.228e-005, 5.987e-005, 8.013e-005, 1.150e-004, 2.037e-004, 2.939e-004, 3.598e-004, 4.132e-004,
4.640e-004, 5.139e-004, 5.662e-004, 6.233e-004, 6.854e-004, 7.577e-004, 8.441e-004, 9.519e-004, 1.093e-003, 1.314e-003, 2.805e-003)
PM.lethality <- median(PM.lethality) # deaths / kg
value.of.life <- (2e6 + 0.98e6) / 2 # runif(n, 0.98e6, 2e6) # € / death
emis.price.PM <- PM.lethality * value.of.life # 201.879 # €kg^-1
emis.price.CO2 <- 10e-3 # runif(n, 5e-3, 40e-3) # €kg^-1, the price of CO2 allowances fluctuates quite a bit, in 8.8.2011 they
# were going for 10.74 € per ton of CO2 equivalent
test3$CO2.cost <- test3$Emis.CO2 * emis.price.CO2
test3$PM.cost <- test3$Emis.PM * emis.price.PM
oprint(test3)
</rcode>
</rcode>


{{todo|Ruvetaan keräämään tälle sivulle matskua mallin uudesta versiosta.|Smxb}}
{{comment|# |Takes below 10 minutes to run. Neat!|--[[User:Teemu R|Teemu R]] 14:08, 2 August 2011 (EEST)}}
:{{comment|# |Though much slower on the serverside R...|--[[User:Teemu R|Teemu R]] 14:26, 2 August 2011 (EEST)}}
 
{{attack|# |Current problems: 1) The whole trip data does not load from the database, but 2 hours works. 2) The last time point with trips.left.trans has 0 rows, so the code temporarily calculates up to the second last time point.|--[[User:Jouni|Jouni]] ([[User talk:Jouni|talk]]) 20:42, 18 March 2015 (UTC)}}
 
Plans for further development:
* Make an input form for bus transport subsidies (user can decide)
* Based on subsidies less or more bus routes will be running.
{{comment|# |Got any ideas on how the active bus routes should be derived from the amount of subsidies?|--[[User:Teemu R|Teemu R]] 10:12, 18 August 2011 (EEST)}}
* If bus is not available, trips will be made by private cars.
* Calculate the impacts on costs due to a) fine particles and health, b) CO2 and climate, c) fuel costs, d) driver salary costs based on kilometres driven. Parking, rush delay, and capital costs due to vehicle maintenance are ignored. (All these ignorances are biased towards cars looking good.)
* Play with the model in the course. The model runs should be quick because there is no optimising.
{{attack|# |Though there will be more data (private + public trips vs. only private) downloaded. Which might also cause memory problems, since the data is fairly large (4M rows).|--[[User:Teemu R|Teemu R]] 10:12, 18 August 2011 (EEST)}}
* Practical implementation: Teemu does as much of the model as he can; Sami finalises the work.
{{comment|# |By the way, what should be the name for a new page considering the model described in these comments? Since we're no longer talking about composite traffic... Something like "Helsinki metropolitan area traffic model"?|--[[User:Teemu R|Teemu R]] 14:50, 18 August 2011 (EEST)}}
 
== See also ==
 
*[[Composite traffic]]
*[[:fi:Helsingin seudun liikennemalli]]
*[[Recommended R functions]]
*[[Cost-benefit assessment on composite traffic in Helsinki]]
*[[Cost-benefit analysis on composite traffic in the Helsinki Metropolitan area]]

Latest revision as of 07:14, 12 January 2018



This page is about a composite traffic model that is an updated version of File:Composite traffic.ANA. The new version is coded with R.

Question

How to estimate potential to aggregate individual trips into public transportation or composite vehicles (airport-taxi-like vehicles for several passengers)?

Answer

Rationale

Variables

+ Show code

Initiation code

Actual model

  • Trip aggregator
    • Optimization rules:
  1. No second transfer -> prioritize "secondary" passengers
  2. Fill as many 8-person-vehicles as possible
  3. Fill as many 4-person-vehicles as possible
  4. Special rule: for trips with no possible transfer-point -> direct trip
  5. Transfer the rest (will always be 4-person-vehicles)
  6. Re-check vehicle configurations, when exact numbers of primary and secondary passengers as well as transferees are known

+ Show code

----#: . Takes below 10 minutes to run. Neat! --Teemu R 14:08, 2 August 2011 (EEST) (type: truth; paradigms: science: comment)

----#: . Though much slower on the serverside R... --Teemu R 14:26, 2 August 2011 (EEST) (type: truth; paradigms: science: comment)

⇤--#: . Current problems: 1) The whole trip data does not load from the database, but 2 hours works. 2) The last time point with trips.left.trans has 0 rows, so the code temporarily calculates up to the second last time point. --Jouni (talk) 20:42, 18 March 2015 (UTC) (type: truth; paradigms: science: attack)

Plans for further development:

  • Make an input form for bus transport subsidies (user can decide)
  • Based on subsidies less or more bus routes will be running.

----#: . Got any ideas on how the active bus routes should be derived from the amount of subsidies? --Teemu R 10:12, 18 August 2011 (EEST) (type: truth; paradigms: science: comment)

  • If bus is not available, trips will be made by private cars.
  • Calculate the impacts on costs due to a) fine particles and health, b) CO2 and climate, c) fuel costs, d) driver salary costs based on kilometres driven. Parking, rush delay, and capital costs due to vehicle maintenance are ignored. (All these ignorances are biased towards cars looking good.)
  • Play with the model in the course. The model runs should be quick because there is no optimising.

⇤--#: . Though there will be more data (private + public trips vs. only private) downloaded. Which might also cause memory problems, since the data is fairly large (4M rows). --Teemu R 10:12, 18 August 2011 (EEST) (type: truth; paradigms: science: attack)

  • Practical implementation: Teemu does as much of the model as he can; Sami finalises the work.

----#: . By the way, what should be the name for a new page considering the model described in these comments? Since we're no longer talking about composite traffic... Something like "Helsinki metropolitan area traffic model"? --Teemu R 14:50, 18 August 2011 (EEST) (type: truth; paradigms: science: comment)

See also

Retrieved from "https://en.opasnet.org/index.php?title=Composite_traffic_model&oldid=41596"