Implemented by Anderson Rocha Tavares -- artavares .at. inf .dot. ufrgs.br
The applet requires Java 5 or higher. Java must be enabled in your browser settings. Mac users must have Mac OS X 10.4 or higher. Windows and Linux users may obtain the latest Java from Sun's Java site. Apparently, it does not work on Linux anymore. Anyway, you can copy the .nlogo code and run in NetLogo 4.1.3.
powered by NetLogo
view/download model file: MktBasedPigou.nlogo -- view/download road network file: inputs/pigou.txt
This model presents a road pricing approach to Pigou's example [1].
Drivers must choose between two roads: main (1-2-4) and side (1-3-4), also known as Give it a Try road and Sure Thing road (names given by [2]). The travel time on Give it a Try road is x minutes, where x is the number of drivers in it. The travel time om Sure Thing Road is N minutes, where N is the number of drivers on the scenario.
Example: there are 60 drivers on the scenario. On the first trip, 40 drivers choose Give it a Try road and 20 choose Sure Thing road. The travel times on the main road are 40 minutes on the main road and 60 minutes on the side road.
The Pigou's example is about the selfishness of routing: if one can use a road that can make him arrive earlier at the destination (Give it a Try road), why choose the other one? But, if everyone think in this way, all drivers will end up with the same travel time as if they would have by using Sure Thing road.
In order to resolve this issue, a road-pricing approach is proposed: drivers must pay to use the main road. And then, they must decide whether they will prioritize their travel times (paying to use the main road) or expenses (using the long side road for free).
Use the wealth distribution to configure the drivers preferences. Each element of this list is a pair with a probability (from 1 to 100) and the wealth value (from 0 to 1). The wealthier the driver, the more it will accept to pay for using the main road. Note that the probabilities must add up to 100.
- Example: [[50 1] [25 0.5] [25 0]] -- in this setup, 50% of drivers will have wealth = 1, 25% will have a wealth = 0.5 and 25% will have wealth = 0.
Use setup button to load the scenario and prepare the experiment.
The mkt-on? switch activates the road pricing. Without it, drivers will make choices regarding only their travel times.
Roads capacity, capacity randomness, alpha, beta and lambda can be disregarded in this model as well as travel-time-alpha and travel-time-beta.
Notice how drivers will prefer the main road with the pricing deactivated. The number of drivers on main road increase until all drivers choose it. Then, as travel time on main road is the same as in the side road, in the next trip drivers will choose randomly. In the sequence, as the main road results in smaller travel times, more and more drivers will try it, and the cycle repeats.
With the pricing activated, this is solved: wealthier drivers will use the main road and mingy drivers will use the side road. There is a cost function that balances this, where W is the wealth, t is travel time and p is the expenditure:
z = W * t + (1 - W) * e
Try changing the distribution of wealth among drivers to notice how many chooses each road.
Implemented by Anderson R. Tavares. Supervisor: Ana L. C. Bazzan.
Universidade Federal do Rio Grande do Sul - UFRGS
Dijkstra algorithm obtained from "Being Kevin Bacon" NetLogo model from the book series "Artificial Intelligence". Author: W. J. Teahan; Publisher: Ventus Publishing Aps, Denmark - http://files.bookboon.com/ai/Being-Kevin-Bacon.html
References:
[1] A. C. Pigou. The Economics of Welfare. Macmillan, 1920
[2] Vanderbilt, Tom. Traffic: Why We Drive the Way We Do (and What It Says About Us). Vintage. 2009
; Expectations: no-replan (+fwd-knowledge), no-exploration: congestions will simply change place
;TODO set malicious RED
;BUGFIX on choosing roads - FIXED
;BUGFIX: dijkstra-distances contains the number of hops - FIXED (phew!)
;TODO v2i: initialize previous(tt/price) on the roads?
extensions [ array ]
breed [ intersections intersection ]
breed [ drivers driver ]
directed-link-breed [ roads road ]
directed-link-breed [ ways way]
globals [
dijkstra-distances ;; shortest path distance from initial node to all other nodes
dijkstra-directions ;; which direction to head in for shortest path --> the 'previous' array
nodes-visited ;; total number of nodes visited by all walkers
wealth-distrib ;list with probabilities of assigning a wealth value for drivers
wealth-probabilities ;probabilities of assigning a wealth value for drivers
wealth-values ;possible values of drivers' wealth
num-intersections
num-roads
ideal-segment-length
od-pairs
avg-occ-dev ;average deviation of the difference of "optimal" # of cars and actual # of cars
]
intersections-own [
x y
id
]
roads-own [
; components of the price-occupation curve: price = lambda + alpha(occ)^beta
price
last-price ;value of price on the previous trip
last-tt ;value of travel time on the previous trip
;; old attributes ;;
road-id ;identificador da via
capacity ;capacidade [130:250]
num-drv ;numero de motoristas
opt-num-drv ;numero proporcional de motoristas
avg-num-drv ;ocupacao real media
avg-opt-drv ;ocupacao proporcional media
fftt ;free-flow travel time
travel-time ;tempo de viagem
history ;historico de ocupacao
]
drivers-own [
;total, current-trip and average per-trip credits expenditure, respectively
total-expenditure
credits-spent
avg-credits-spent
;cost function
trip-z
wealth
tau
replan?
v2v?
malicious?
prices ;list of prices for every road
travel-times ;list of travel-times for every road
z-values ;z-values for every road
intended-route ;list of nodes that driver will traverse in it's way from origin to destination
trip-history ;list of roads used
;; old attributes ;;
current-route ;lista de road-id descrevendo a rota atual
route-weight ;peso da rota a ser calculado na chegada
actual-tt ;tempo de viagem real do motorista
average-tt ;tempo medio de viagem do motorista
optimal-route ;rota otima (menor #nos ate o destino)
expected-tt ;tempo de viagem esperado (considera os motoristas no mesmo par OD
roads-weight ;lista com o peso das rotas TODO: sera' necessario?
origin ;ID do no' de origemsetup
destination ;ID do no' de destino
current-node ;ID do no' atual
current-road ;via atual (a via mesmo, nao o ID)
q-table ;tabela Q
]
;executes one trip for all the drivers
to go
prepare-next-trip ;recalculates the route
while [not all-trips-finished?] [
step
]
if save-history? [store-last-trip]
experience-travel-times
adjust-credits-balance
update-z
update-roads-visual
do-plots
tick
end
to store-last-trip
ask drivers [
set trip-history lput ([road-id] of item 0 current-route) trip-history
]
end
;updates roads colors according to the occupancy
to update-roads-visual
ask roads [
;set label (precision travel-time 2)
let occ avg-num-drv / capacity
let inst-road-view? true
if inst-road-view?
[set occ num-drv / capacity]
set color 68
if occ > 0.80 [set color green]
if occ > 1.00 [set color yellow]
if occ > 1.20 [set color orange]
if occ > 1.40 [set color red]
]
end
;; executes one step, which consists of going to the next node on route
to step
ask drivers [
;if at destination, do nothing
if current-node = destination [stop]
;finds the position of current-node on the intended route, then finds the node itself
let next-node-id first intended-route
if current-node != origin [
let curr-node-pos position current-node intended-route
set next-node-id item (curr-node-pos + 1) intended-route
]
let next-node one-of intersections with [id = next-node-id]
;gets the node whose id is current-node
let nid current-node
let cnode one-of intersections with [id = nid]
;sets the current-road, increment the number of drivers in it and add it to the route
set current-road one-of roads with [end1 = cnode and end2 = next-node] ;type next-node type " " write current-road
ask current-road [set num-drv num-drv + 1]
set current-route lput current-road current-route
;requests the costs of the outbound links of the next nodes (v2i)
let the-z-values z-values
let the-wealth wealth
ask [my-out-links] of next-node [
set the-z-values replace-item (road-id - 1) the-z-values calculate-z the-wealth last-price last-tt
]
;test: not update z-values on 1st iteration (coz prices/tt's are zero)
if ticks != 0 [set z-values the-z-values] ;updates the z-table with the costs of the next links
;go to next-node
move-to next-node
set current-node [id] of next-node
]
end
;configures the experiments
to setup
clear-all
;; START - configures the wealth lists ;;
;read the user input
set wealth-distrib read-from-string wealth-distribution
let accum 0
set wealth-probabilities []
;extracts the probabilities from the user input
;they are the first item of each list inside the user input
foreach wealth-distrib [
let prob item 0 ?
set accum accum + prob
set wealth-probabilities lput accum wealth-probabilities
]
;extracts the values from the user input
;they are the second item of each list inside the user input
set wealth-values []
foreach wealth-distrib [
set wealth-values lput (item 1 ?) wealth-values
]
;; FINISH - configures the wealth lists ;;
setup-network "inputs/pigou.txt"
setup-drivers
end
;configures all endities for the next trip
to prepare-next-trip
;reset drivers' state
ask drivers [
set current-node origin
set current-route []
set credits-spent 0
;calculates the intended route
set intended-route calculate-min-z-route origin destination
let myorig origin
let mydest destination
move-to one-of intersections with [id = myorig]
face-nowrap one-of intersections with [id = mydest]
]
;reset roads state
ask roads [
;stores the previous values
set last-tt travel-time
set last-price price
set num-drv 0
;set opt-num-drv 0
set travel-time 0
set price 0
]
end
;configures the network
to setup-network [network-file]
clear-turtles
set avg-occ-dev 0
; file-open "inputs/mgta2" ;user-file
file-open network-file ;user-file
set num-intersections file-read
set num-roads file-read
set ideal-segment-length file-read
repeat num-intersections [
create-intersections 1 [
set id file-read ;id-counter
set xcor file-read / 1.1
set ycor file-read / 1.1
update-node-visual
]
]
repeat num-roads [
let r-id file-read
let id1 file-read
let id2 file-read
let primary? file-read
ask intersections with [ id = id1 ] [
create-roads-to intersections with [id = id2] [
set road-id r-id
set num-drv 0
set opt-num-drv 0
set avg-num-drv 0
set avg-opt-drv 0
set fftt 5
set capacity roads-capacity + random (cap-randomness + 1);130 ;+ random 121
;set capacity num-drivers / 7.5 ;TODO REMOVER ISSO APOS TESTAR
set label road-id
set label-color red
;set history n-values history-size [60 + random 81] ;historico de valores entre 60 e 140
]
]
]
file-close
setup-roads-thickness
end
;adjust roads thickness according to the capacity
to setup-roads-thickness
let min-cap min [capacity] of roads
if cap-randomness = 0 [
ask roads [set thickness .2]
stop
]
ask roads [
set thickness (capacity - min-cap) * .7 / cap-randomness + .2
]
end
;configures the nodes appearence
to update-node-visual
set shape "circle 2"
set size ideal-segment-length / 3
set color 5
ask intersections [ set label id ]
end
;initializes the drivers
to setup-drivers
;monta a lista com os pares OD, a partir dos valores selecionados pelos usuarios
set od-pairs []
; if one-eight [ set od-pairs fput [1 8] od-pairs ]
; if one-nine [ set od-pairs fput [1 9] od-pairs ]
; if one-ten [ set od-pairs fput [1 10] od-pairs ]
; if two-eight [ set od-pairs fput [2 8] od-pairs ]
; if two-nine [ set od-pairs fput [2 9] od-pairs ]
; if two-ten [ set od-pairs fput [2 10] od-pairs ]
; if three-eight [ set od-pairs fput [3 8] od-pairs ]
; if three-nine [ set od-pairs fput [3 9] od-pairs ]
; if three-ten [ set od-pairs fput [3 10] od-pairs ]
;REMOVE AFTER TESTING V2V -- better: parametrize in file
;set od-pairs [[1 9]]
;set od-pairs [[1 25]] ;this one is for the 5x5 scenario
;set od-pairs [[1 36]] ;this one is for the 6x6 scenario
set od-pairs [[1 4]] ;for Pigou's example
create-drivers num-drivers [
let od-pair one-of od-pairs
set origin item 0 od-pair ;1 + random 3 ;origem em nos 1, 2 ou 3
set destination item 1 od-pair ;8 + random 3 ;destino em 8, 9 ou 10
setup-driver origin destination
]
end
;configures a driver's attributes
to setup-driver [the-origin the-destination]
;; initialise the market-based approach attributes
set credits-spent 0
set total-expenditure 0
set avg-credits-spent 0
;assign a random wealth for the driver
let mingy-type random 3
if mingy-type = 0 [ set wealth 0 ]
if mingy-type = 1 [ set wealth 1 ]
if mingy-type = 2 [set wealth 0.5]
;assign a random wealth for the driver inside the ones provided by the user
let wealth-prob random 100 ;assign a random from 0 to 99
let index 0
let found false
;search for a value inside the wealth-probabilities array
while [not found] [
ifelse wealth-prob < item index wealth-probabilities
[set found true]
[set index index + 1 ]
]
set wealth item index wealth-values
set tau 100000
set replan? false
set v2v? false
set malicious? false
set trip-history []
;; end mkt-based attr init
set origin the-origin
set destination the-destination
set current-node origin
set current-route []
;prepare to initialize the prices, travel-times and z-values
let the-prices n-values num-roads [0]
let the-z-values n-values num-roads [0]
let the-travel-times n-values num-roads [0]
let the-wealth wealth
;calculates the initial travel-times, prices and z-values for each road
ask roads [
;calculate price and travel time as if the road was half-loaded
let prc road-price (num-drivers / 2)
let tt road-travel-time (num-drivers / 2)
set the-prices replace-item (road-id - 1) the-prices prc
set the-travel-times replace-item (road-id - 1) the-travel-times tt
set the-z-values replace-item (road-id - 1) the-z-values calculate-z the-wealth prc tt
]
;finally stores the travel-times, prices and z-values
set prices the-prices
set travel-times the-travel-times
set z-values the-z-values
set intended-route calculate-min-z-route origin destination
;set optimal-route calculate-opt-route origin destination
;set q-table n-values num-roads [0]
let myorig origin
let mydest destination
move-to one-of intersections with [id = myorig]
face-nowrap one-of intersections with [id = mydest]
set average-tt 0
set shape "car"
set size 3
end
;loads the scenario used in Galib&Moser2011
to setup-std-scenario
clear-all
setup-network "inputs/mgta2"
setup-drivers
let inputfile "inputs/MGTA_compare2.txt"
load-setup-from-file inputfile
end
;loads a scenario from a file
to load-setup-from-file [thefile]
;reset-experiment
clear-all-plots
file-open thefile
set num-drivers file-read
set travel-time-alpha file-read
set travel-time-beta file-read
;set reward-by decode-reward-type file-read
let reward-by file-read
let num-odpairs file-read
ask drivers [die]
repeat num-odpairs [
let the-origin file-read
let the-destination file-read
let num-commuters file-read
create-drivers num-commuters [
setup-driver the-origin the-destination
]
]
;calculate-ett
let number-roads file-read
repeat num-roads [
let r-id file-read ;road-id
let cap file-read ;capacity
ask roads with [road-id = r-id] [
set capacity cap
]
]
file-close
setup-roads-thickness
end
;calculates travel times experienced by drivers
to experience-travel-times
;uses the travel time equation for each roads
ask roads [
set travel-time road-travel-time (num-drv)
if num-drv > 0 [ ;TODO porque num-drv > 0 ???
set avg-num-drv ((num-drv - avg-num-drv) / (ticks + 1)) + avg-num-drv
; set avg-opt-drv ((opt-num-drv - avg-opt-drv) / (ticks + 1)) + avg-opt-drv
]
]
;updates the travel-times array and the total route time
ask drivers [
let attR 0 ;initializes the travel time
;calcula o custo da rota
foreach current-route [
set travel-times replace-item ([road-id - 1] of ?) travel-times ([travel-time] of ?)
ask ? [set attR attR + travel-time]
]
set actual-tt attR
set average-tt ((actual-tt - average-tt) / (ticks + 1)) + average-tt
]
end
;; calculates the price for every road and ajusts the credit's balance for all driver
to adjust-credits-balance
;sets up the price for every road
ask roads [
set price road-price (num-drv / capacity)
]
;adjusts driver balance
ask drivers [
set credits-spent 0
foreach current-route [
set prices replace-item ([road-id - 1] of ?) prices ([price] of ?)
set credits-spent credits-spent + [price] of ?
]
set total-expenditure total-expenditure + credits-spent
set avg-credits-spent ((credits-spent - avg-credits-spent) / (ticks + 1)) + avg-credits-spent
]
end
;initialise the dijkstra distances array and the 'previous' array as well
to initialise-distances [initial-node]
set dijkstra-distances array:from-list n-values num-intersections [1000000] ;; "infinity"
set dijkstra-directions array:from-list n-values num-intersections [nobody]
array:set dijkstra-distances initial-node 0 ;; set distance to 0 for initial node
end
;; calculates the distance array for the Dijkstra algorithm using the initial node
;; as the focal point -- z-values contains the weight of each edge
to perform-dijkstra [initial-node nodes-to-visit weights]
set nodes-visited 0
initialise-distances [who] of initial-node
let visited-set [] ;; this is the list of nodes that have been visited
let unvisited-set nodes-to-visit ;; this is the list of nodes yet to have been visited
let curr-node initial-node
while [count unvisited-set > 0]
[
ask curr-node
[
set nodes-visited nodes-visited + 1
set visited-set fput who visited-set
set unvisited-set other unvisited-set
ask out-link-neighbors
[
;let dist-thru-here (array:item dijkstra-distances [who] of curr-node) + 1 ;cost of next hop
let dist-thru-here (array:item dijkstra-distances [id - 1] of curr-node) + dist-between curr-node self weights;cost of next hop
let dist-thru-to-there array:item dijkstra-distances (id - 1)
;show (word dist-thru-here " " dist-thru-to-there)
;show dijkstra-distances
if (dist-thru-here < dist-thru-to-there) [
array:set dijkstra-distances who dist-thru-here
array:set dijkstra-directions who [who] of curr-node
]
]
;; set the curr-node to the remaining unvisited node that has the smallest distance to the initial node
set curr-node min-one-of unvisited-set [array:item dijkstra-distances who]
]
]
;; print array:to-list dijkstra-distances
end
to-report dist-between [node-a node-b weights]
let rid [road-id] of one-of roads with [end1 = node-a and end2 = node-b]
report item (rid - 1) weights
end
; shows the 'previous' array
to dump-dijkstra-directions
show dijkstra-directions
let i 0
foreach array:to-list dijkstra-directions
[
if (? != nobody) [ type " from: " type i type " thru: " type ? type " dist: " print array:item dijkstra-distances i ]
set i i + 1
]
end
; reports the z-value for the given wealth, price and travel time
; the reported value is different when the market is activated
to-report calculate-z [the-wealth the-price the-travel-time]
if mkt-on? [report the-wealth * the-travel-time + (1 - the-wealth) * the-price]
report the-travel-time
end
;reports the travel time, using the values on pigou's example
to-report road-travel-time [num-of-drivers]
if (road-id = 1 or road-id = 3) [report num-of-drivers / 2]
report num-drivers / 2
end
;reports the road price, it will be 0 if the market is not on
to-report road-price [occupation]
if mkt-on? [
if (road-id = 1 or road-id = 3) [report 10] ;lambda + alpha * occupation ^ beta
;report 0
]
report 0
end
;calculates the shortest path between orig and dest
;using the z-values as the edges weight
to-report calculate-min-z-route [orig dest]
let initial-node one-of intersections with [id = orig]
initialise-distances [who] of initial-node
let nodes-to-visit []
ask initial-node [
set nodes-to-visit other intersections;; this is the list of nodes yet to have been visited
]
;performs dijkstra using the z-values as the graph weights
perform-dijkstra initial-node nodes-to-visit z-values
;now dijkstra-directions is the 'previous' vector
let previous array:to-list dijkstra-directions
let curr-node dest
let the-route []
while [curr-node != orig] [
;show curr-node
set the-route fput curr-node the-route
set curr-node 1 + item (curr-node - 1) previous
]
report the-route
end
;; calculates the z-value for the current trip of every driver
to update-z
ask drivers [
set trip-z calculate-z wealth credits-spent actual-tt
;updates z-values for all links
let i 0
while [i < length z-values] [
let z calculate-z wealth (item i prices) (item i travel-times)
set z-values replace-item i z-values z
set i i + 1
]
]
end
;;
to do-plots
;plot the cost functions
set-current-plot "costs"
set-current-plot-pen "tt"
plotxy ticks mean [actual-tt] of drivers
if mkt-on? [
set-current-plot-pen "$"
plotxy ticks mean [credits-spent] of drivers
]
set-current-plot-pen "z"
plotxy ticks mean [trip-z] of drivers
;plot the value of z for each driver type
set-current-plot "z-eval"
if mkt-on? [
if (count drivers with [wealth = 1] > 0) [
set-current-plot-pen "1.0"
plotxy ticks mean [trip-z] of drivers with [wealth = 1]
]
if (count drivers with [wealth = 0.5] > 0) [
set-current-plot-pen "0.5"
plotxy ticks mean [trip-z] of drivers with [wealth = 0.5]
]
]
if (count drivers with [wealth = 0] > 0) [
set-current-plot-pen "0.0"
plotxy ticks mean [trip-z] of drivers with [wealth = 0]
]
;plot number of cars in roads
set-current-plot "num-cars-in-roads"
clear-plot
set-current-plot-pen "curr"
ask roads [plotxy road-id num-drv]
;plot cars in roads along time
set-current-plot "cars-roads"
set-current-plot-pen "road1"
plot item 0 [num-drv] of roads with [road-id = 1]
set-current-plot-pen "road2"
plot item 0 [num-drv] of roads with [road-id = 2]
;plot travel time experienced in roads
set-current-plot "tt-road"
set-current-plot-pen "road1"
plot item 0 [travel-time] of roads with [road-id = 1]
set-current-plot-pen "road2"
plot item 0 [travel-time] of roads with [road-id = 2]
end
;reports whether all the drivers have finished their trips
to-report all-trips-finished?
let all-finished true
ask drivers [
if current-node != destination [
set all-finished false
stop
]
]
report all-finished
end