Traffic Flow at kiss-and-ride facility

globals [
  selected-car      ; the currently selected car
  lanes             ; a list of the y coordinates of different lanes
  entry-barrier-x   ; position x of the entry abrriers
  barrier-x         ; position x of the exit barriers
  stop-lane         ; lane where cars stop
  meters-per-patch  ; to convert patch to meters
  
  anpr-start-x
  anpr-end-x
  
  ; --- METRICS ----
  cars-entered          ; number of vehicles that enters the system
  cars-exited           ; number of vehicles that left the system
  exit-cars-processed   ; number of cars processed in the ANPR zone
  total-system-time     ; accumulated time spent in the system
  sum-entry-queue       ; accumulate sum of vehicles entering
  sum-exit-queue        ; accumulated sum of vehicles exiting
  
  total-entry-anpr-time ; accumulated time inside the entry APNR zone
  max-entry-anpr-queue  ; maximum queue observed before the entry camera
  total-exit-anpr-time  ; accumulated time inside the exit APNR zone
  max-exit-anpr-queue   ; maximum queue observed before the exit camera
  total-exit-system-time; total exit time
  system-times         ; list to compute percentiles
  total-time-to-exit-queue
  cars-reached-exit-queue
]

breed [ cars car]
breed [ barriers barrier]

cars-own [
  speed               ; the current speed of the car
  top-speed           ; the maximum speed of the car (different for all cars)
  target-lane         ; the desired lane of the car
  patience            ; the driver's current level of patience
  entry-passed?       ; if the car already passed the entry barrier
  exit-passed?     ; if the car already passed the exit barrier
  
  ; Now we set variables to instruct a car to stop in the right lane in order to dropp off passage
  searching-stop?     ; if the car is searching for a place to stop
  stopping?           ; if the car is doing the stop
  has-stopped?        ; if the car has already stopped
  residence-remaining ; ticks left
  dropoff-x           ; x position where it will stop
  reached-exit-queue? ; if the car has reached the exit queue
  
  entry-time          ; tick when the car enters the system
  anpr-entry-time     ; tick when the car enters the ANPR zone
  exit-start-time     ; tick after completting the stop until it exits
  
]

barriers-own [
  lane-y        ; y of the lane where the barrier is
  serving-car   ; car that is being served in the barrier
  remaining     ; ticks left to finish the "plate reading"
  open?         ; if the barrier is open (it allows car to go through)
  barrier-type  ; if its entry or exit barrier
  busy-time     ; time that the barrier is occupied
]

to setup
  clear-all
  set-default-shape cars "car"
  draw-road
  set entry-barrier-x (min-pxcor + 15) ; for example, 8 patches after the beginning (so there is enough room for cars to arrive)
  set barrier-x (max-pxcor - 3) ; for example, 3 patches before the end
  draw-toll-plaza
  setup-barriers
  set selected-car nobody
  set anpr-start-x barrier-x - 1.5
  set anpr-end-x barrier-x + 0.8
  set cars-entered 0
  set meters-per-patch 5
  set total-time-to-exit-queue 0
  set cars-reached-exit-queue 0
  set exit-cars-processed 0
  set total-entry-anpr-time 0
  set max-entry-anpr-queue 0
  set cars-exited 0 
  set total-system-time 0
  set total-exit-anpr-time 0
  set max-exit-anpr-queue 0
  set system-times []
  reset-ticks
end 

to setup-barriers
  ; remove old barriers (if num-of-lanes is changed after new setup)
  ask barriers [die]
  
  ; one barrier at each lane
  foreach lanes [y ->
    ; entry barriers
    create-barriers 1 [
      set busy-time 0
      set lane-y y
      setxy entry-barrier-x lane-y
      set barrier-type "entry"
      set serving-car nobody
      set remaining 0
      set open? false
      
      set shape "line"
      set size 1.2
      set color red
      set heading 0
    ]
    
    ; exit barriers
    create-barriers 1 [
      set busy-time 0
      set lane-y y
      setxy barrier-x lane-y
      set barrier-type "exit"
      ;hide-turtle
      set serving-car nobody
      set remaining 0
      set open? false
      
      set shape "line"
      set size 1.2
      set color red
      set heading 0
    ]
  ]
end 

to generate-arrivals
  ; 1 tick = 1 second
  let lambda-per-tick arrivals-per-minute / 60
  let k random-poisson lambda-per-tick

  let road-patches patches with [ member? pycor lanes ]
  let entry-x min-pxcor
  let entry-patches road-patches with [ pxcor <= entry-x + 1 ]

  repeat k [
    let spot one-of entry-patches
    if spot != nobody [
      create-cars 1 [
        set entry-passed? false
        set reached-exit-queue? false
        set exit-passed? false
        set color car-color
        move-to spot
        set target-lane pycor
        set heading 90
        set top-speed 1.6 + random-float 0.5
        set speed 0.5
        set patience random max-patience

        set stopping? false
        set has-stopped? false
        set searching-stop? false
        set residence-remaining 0
        
        set anpr-entry-time -1

        ; random point where the car will stop (before the barrier)
        set dropoff-x (min-pxcor + 5 + random (barrier-x - min-pxcor - 10))
      ]
    ]
  ]
end 

; --- DRAWINGS ---

to draw-toll-plaza
  ; toll zone --> 3 patches wide
  let x0 barrier-x
  let booth-x (barrier-x + 1)

  ; stop line in each lane
  ask patches with [ pxcor = x0 and member? pycor lanes ] [
    set pcolor grey
  ]
    
  ask patches with [ pxcor = entry-barrier-x and member? pycor lanes ] [
    set pcolor grey
  ]
end 

to draw-road
  ask patches [
    ; the road is surrounded by green grass of varying shades
    set pcolor green - random-float 0.5
  ]
  set lanes n-values number-of-lanes [ n -> number-of-lanes - (n * 2) - 1 ]
  set stop-lane (last lanes - 2)
  
  ask patches with [ abs pycor <= number-of-lanes ] [
    ; the road itself is varying shades of grey
    set pcolor grey - 2.5 + random-float 0.25
  ]
  ask patches with [ pycor = stop-lane ] [
    set pcolor grey - 2.5 + random-float 0.25
  ]
  draw-road-lines
end 

to draw-road-lines
  let y (last lanes) - 1 ; start below the "lowest" lane
  while [ y <= first lanes + 1 ] [
    if not member? y lanes [
      ; draw lines on road patches that are not part of a lane
      ifelse abs y = number-of-lanes
        [ draw-line y yellow 0 ]  ; yellow for the sides of the road
        [ draw-line y white 0.5 ] ; dashed white between lanes
    ]
    set y y + 1 ; move up one patch
  ]
end 

to draw-line [ y line-color gap ]
  ; We use a temporary turtle to draw the line:
  ; - with a gap of zero, we get a continuous line;
  ; - with a gap greater than zero, we get a dasshed line.
  create-cars 1 [
    setxy (min-pxcor - 0.5) y
    hide-turtle
    set color line-color
    set heading 90
    repeat world-width [
      pen-up
      forward gap
      pen-down
      forward (1 - gap)
    ]
    die
  ]
end 

; --- EXECUTION ---

to go
  generate-arrivals
  ask barriers [ manage-barrier ]
  ask cars [ move-forward ]
  ask cars with [ patience <= 0 and not searching-stop?] [ choose-new-lane ]
  ask cars with [
    ycor != target-lane and
    not stopping? and
    anpr-entry-time = -1
  ] [ move-to-target-lane ]
  
  let queue-size count cars with [
    xcor < anpr-start-x and
    has-stopped? and
    speed < 0.05
  ]

  ; entry queue count
  let entry-queue-size count cars with [
    not entry-passed? and
    xcor < entry-barrier-x and
    speed < 0.05
  ]
  
  if entry-queue-size > max-entry-anpr-queue [
    set max-entry-anpr-queue entry-queue-size
  ]
  
  ; exit queue count
  let exit-queue-size count cars with [
    has-stopped? and
    not exit-passed? and
    xcor < barrier-x and
    speed < 0.05
  ]
  
  if exit-queue-size > max-exit-anpr-queue [
    set max-exit-anpr-queue exit-queue-size
  ]
  
  set sum-entry-queue sum-entry-queue + entry-queue-size
  set sum-exit-queue sum-exit-queue + exit-queue-size
  
  tick
end 

to handle-stop  ; turtle procedure
  ; after entry, cars search for a free stopping opportunity
  if entry-passed? and searching-stop? and not has-stopped? [
    let search-start xcor + 2
    let search-end min list (barrier-x - 8) (xcor + 12)

    let candidate-x nobody

    if pycor = stop-lane [
      let free-spots patches with [
        pycor = stop-lane and
        pxcor >= search-start and
        pxcor <= search-end and
        not any? cars with [
          abs (xcor - [pxcor] of myself) < 2 and
          abs (ycor - stop-lane) < 0.6 and
          (stopping? or (has-stopped? = false and target-lane = stop-lane))
        ]
      ]

      if any? free-spots [
        set candidate-x min [ pxcor ] of free-spots
      ]
    ]

    if pycor != stop-lane [
      let free-spots patches with [
        pycor = stop-lane and
        pxcor >= search-start and
        pxcor <= search-end and
        not any? cars with [
          abs (xcor - [pxcor] of myself) < 2 and
          abs (ycor - stop-lane) < 0.6 and
          (stopping? or (has-stopped? = false and target-lane = stop-lane))
        ]
      ]

      if any? free-spots [
        set candidate-x min [ pxcor ] of free-spots
        set target-lane stop-lane
        set dropoff-x candidate-x
      ]
    ]

    if pycor = stop-lane and candidate-x != nobody [
      set dropoff-x candidate-x
    ]
  ]

  ; if it already reached the stopping point
  if entry-passed? and searching-stop? and (not has-stopped?) and
     (not stopping?) and (pycor = stop-lane) and (xcor >= dropoff-x) [
    set stopping? true
    set searching-stop? false
    set xcor dropoff-x
    set residence-remaining round (random-triangular 5 residence-time 300)
    set speed 0
    stop
  ]

  ; while stopped
  if stopping? [
    set speed 0
    set xcor dropoff-x
    set residence-remaining residence-remaining - 1

    if residence-remaining <= 0 [
      set stopping? false
      set has-stopped? true
      set target-lane one-of lanes
      set exit-start-time ticks
    ]
    stop
  ]
end 

to manage-barrier  ; barrier procedure
  
  if serving-car != nobody [
    set busy-time busy-time + 1
    if remaining > 0 [
      set remaining remaining - 1
      set open? false
    ]
    
    ; when service ends, open barrier and store service time
    if remaining = 0 and not open? [
      if [anpr-entry-time] of serving-car != -1 [
        let service-time (ticks - [anpr-entry-time] of serving-car)
        
        if barrier-type = "entry" [
          set total-entry-anpr-time total-entry-anpr-time + service-time
          set cars-entered cars-entered + 1
        ]
        
        if barrier-type = "exit" [
          set total-exit-anpr-time total-exit-anpr-time + service-time
          set exit-cars-processed exit-cars-processed + 1
        ]
        
        ask serving-car [
          set anpr-entry-time -1
        ]
      ]
      
      set open? true
    ]
    
    ; release the barrier once the car has passed it
    let my-barrier-x xcor
    if open? and ([xcor] of serving-car > my-barrier-x + 0.6) [
      set serving-car nobody
      set open? false
    ]
  ]

  ifelse open? [
    set color lime - 2
    set heading 90
  ] [
    set color red
    set heading 0
  ]
end 

to move-forward ; turtle procedure
  set heading 90
  handle-stop
  
  ; --- ENTRY BARRIER CONTROL ---
  if not entry-passed? [
    let b-entry one-of barriers with [
      lane-y = [pycor] of myself and barrier-type = "entry"
    ]

    if b-entry != nobody [
      let entry-stop-x (entry-barrier-x - 0.5)

      if xcor >= (entry-stop-x - 0.2) and xcor <= (entry-barrier-x + 0.2) [
        if [serving-car] of b-entry = nobody [
          if anpr-entry-time = -1 [ set anpr-entry-time ticks]
          ask b-entry [
            set serving-car myself
            set remaining 2 + max list 1 round (random-exponential entry-ANPR-time)
            set open? false
            
          ]
        ]
        if ([serving-car] of b-entry != self) or (not [open?] of b-entry) [
          set xcor entry-stop-x
          set speed 0
          stop
        ]]]]
  
  ; --- EXIT BARRIER CONTROL ---

  speed-up-car
  if has-stopped? and not exit-passed? [
    let b one-of barriers with [ 
      lane-y = [pycor] of myself and barrier-type = "exit"]
    if b != nobody [
      let stop-x (barrier-x - 0.5)
      
      ; if the car has not passed the barrier and it is in the stop line or close
      if xcor >= (stop-x - 0.2) and xcor <= (barrier-x + 0.2) [
        
        ; if the barrier is free, the car is asigned as serving-car and the process starts
        if [serving-car] of b = nobody [
          if anpr-entry-time = -1 [
            set anpr-entry-time ticks
          ]
          ask b [
            set serving-car myself
            set remaining 2 + max list 1 round (random-exponential exit-ANPR-time) ; 2 --> temps de offset
            
            set open? false
            let read-time remaining
          ]
        ]
        
        ; if the car is not the one being served or the barrier 
        ; is not open --> it stops at stop-x
        if ([serving-car] of b != self) or (not [open?] of b) [
          if ([serving-car] of b != self) or (not [open?] of b) [
            if not reached-exit-queue? [
              set total-time-to-exit-queue total-time-to-exit-queue + (ticks - exit-start-time)
              set cars-reached-exit-queue cars-reached-exit-queue + 1
              set reached-exit-queue? true
            ]            
            set xcor stop-x
            set speed 0
            stop
          ]
          set xcor stop-x
          set speed 0
          stop
        ]
        ; if the car is the one being serves, continue as normal
      ]
    ]
  ]

  ; --- END BARRIER CONTROL ---
  
  speed-up-car

  let blocking-cars other cars in-cone (1 + speed) 180 with [ y-distance <= 1 ]
  let blocking-car min-one-of blocking-cars [ distance myself ]

  if blocking-car != nobody [
    set speed [speed] of blocking-car
    slow-down-car
  ]

  if speed < 0 [set speed 0 ]
  forward speed
  
  if xcor > entry-barrier-x + 0.6 and not entry-passed? [
    set entry-passed? true
    set searching-stop? true
    set target-lane ycor
    set entry-time ticks
  ]

  ; the car dies after leaving the system
  if xcor > (max-pxcor - 0.2) [
    let system-time (ticks - entry-time)
    set total-exit-system-time total-exit-system-time + (ticks - exit-start-time)
    set cars-exited cars-exited + 1
    set total-system-time total-system-time + (ticks - entry-time)
    set system-times lput system-time system-times

    die
  ]
end 

to slow-down-car ; turtle procedure
  set speed (speed - deceleration)
  if speed < 0 [ set speed deceleration ]
  ; every time you hit the brakes, you loose a little patience
  set patience patience - 1
end 

to speed-up-car ; turtle procedure
  set speed (speed + acceleration)
  if speed > top-speed [ set speed top-speed ]
end 

to choose-new-lane ; turtle procedure
  ; Choose a new lane among those with the minimum
  ; distance to your current lane (i.e., your ycor).
  let other-lanes remove ycor lanes
  if not empty? other-lanes [
    let min-dist min map [ y -> abs (y - ycor) ] other-lanes
    let closest-lanes filter [ y -> abs (y - ycor) = min-dist ] other-lanes
    set target-lane one-of closest-lanes
    set patience max-patience
  ]
end 

to move-to-target-lane ; turtle procedure
  if ycor = target-lane [ stop ]

  set heading ifelse-value target-lane < ycor [ 180 ] [ 0 ]

  let lateral-step 0.2
  let next-y ifelse-value target-lane < ycor [ ycor - lateral-step ] [ ycor + lateral-step ]

  let blocker one-of other cars with [
    abs (xcor - [xcor] of myself) < 0.8 and
    abs (ycor - next-y) < 0.45
  ]

  if blocker = nobody [
    set ycor next-y
    set ycor precision ycor 1
  ]
end 

; --- TO REPORTS ---

to-report x-distance
  report distancexy [ xcor ] of myself ycor
end 

to-report y-distance
  report distancexy xcor [ ycor ] of myself
end 

to-report car-color
  ; give all cars a blueish color, but still make them distinguishable
  report one-of [ blue cyan sky ] + 1.5 + random-float 1.0
end 

to-report number-of-lanes
  report num-of-lanes
end 

to-report free [ road-patches ] ; turtle procedure
  let this-car self
  report road-patches with [
    not any? cars-here with [ self != this-car ]
  ]
end 

to-report random-triangular [a b c]
  let u random-float 1
  let f ((b - a) / (c - a))

  if u < f [
    report a + sqrt (u * (c - a) * (b - a))
  ]

  report c - sqrt ((1 - u) * (c - a) * (c - b))
end 

to-report entry-channel-imbalance
  let bs barriers with [ barrier-type = "entry" ]
  if count bs = 0 or ticks = 0 [ report 0 ]

  let utils [ busy-time / ticks ] of bs
  report (max utils - min utils) * 100
end 

to-report exit-channel-imbalance
  let bs barriers with [ barrier-type = "exit" ]
  if count bs = 0 or ticks = 0 [ report 0 ]

  let utils [ busy-time / ticks ] of bs
  report (max utils - min utils) * 100
end 

to-report mean-moving-speed
  let moving-cars cars with [ not entry-passed? ]
  if count moving-cars = 0 [ report 0 ]
  report mean [ speed ] of moving-cars * 5
end 

to-report percentile [ values p ]
  if empty? values [ report 0 ]

  let sorted sort values
  let n length sorted
  let index ceiling ((p / 100) * n) - 1

  if index < 0 [ set index 0 ]
  if index >= n [ set index n - 1 ]

  report item index sorted
end 

to-report p90
  report percentile system-times 90
end 

to-report p95
  report percentile system-times 95
end 

to-report mean-time-to-exit-queue
  if cars-reached-exit-queue = 0 [ report 0 ]
  report total-time-to-exit-queue / cars-reached-exit-queue
end 

; See Info tab for full copyright and license.