aaa---sotl.nlogo

NETLOGO

    ][
      ask Ngates[
        if ((random (1 + number)) > count turtles) [
          sprout 1 []
        ]
      ]    
    ]
  ][
    ifelse (((random 100) < %eastbound) or (not four-dirs?)) [
      ask Egates[
        if ((random (1 + number)) > count turtles) [
          sprout 1 []
        ]
      ]
    ][
      ask Wgates[
        if ((random (1 + number)) > count turtles) [
          sprout 1 []
        ]
      ]    
    ]
  ]
  ask turtles-on gates[
    setup-cars false ;; false for sprouting setups
    set-car-color
    set-car-speed
  ]
end

;; reports the amount of seconds by which to slow the model down
to-report delay
  ifelse simulation-speed <= 0
  [ report ln (10 / 0.001) ]
  [ report ln (10 / simulation-speed) ]
end

;; have the traffic lights change color if phase equals each intersections' q
to set-signals
  locals [ intersections-to-change intersections-to-yellow]

  if (control = "sotl-request") 
  [ ;;do self-org traffic lights (crappy version)
    ask intersections [
      self-org-request
    ]

    set intersections-to-yellow intersections with
      [((q = (clock mod pg1)) and (green-light-v?))
       or 
       ((q = (pg1 + (clock mod pg2))) and (not green-light-v?))]
    set intersections-to-change intersections with
      [((q = ((clock - 1) mod pg1)) and (green-light-v?))
       or 
       ((q = (pg1 + ((clock - 1) mod pg2))) and (not green-light-v?))]
  ]


  if (control = "sotl-phase") 
  [ ;;do self-org traffic lights
    ask intersections [
      self-org-phase
    ]

    set intersections-to-change intersections with
      [(((q + pg2 + 1) mod p = phase) and (green-light-v?))
       or 
       (((q + 1) mod p = phase) and (not  green-light-v?))]
    set intersections-to-yellow intersections with
      [(((q + pg2) mod p = phase) and (green-light-v?))
       or 
       (((q) mod p = phase) and (not green-light-v?))]

  ]

  if (control = "sotl-platoon") 
  [ ;;do self-org traffic lights
    ask intersections [
      self-org-platoon
    ]

    set intersections-to-change intersections with
      [(((q + pg2 + 1) mod p = phase) and (green-light-v?))
       or 
       (((q + 1) mod p = phase) and (not  green-light-v?))
       ;and (faulty? = false))
       ;or ((phase = no-corr-p) and (faulty? = true))
       ]
    set intersections-to-yellow intersections with
      [(((q + pg2) mod p = phase) and (green-light-v?))
       or 
       (((q) mod p = phase) and (not green-light-v?))
       ;and (faulty? = false))
       ;or ((phase = no-corr-p - 1) and (faulty? = true))
       ]
  ]
  
  if (control = "marching")
  [;; marching control
    set intersections-to-change intersections with
      [(phase = 0)
        ;or ((phase = no-corr-p) and (faulty? = true))
      ]
    set intersections-to-yellow intersections with
      [(phase = p - 1)
        ;or ((phase = no-corr-p - 1) and (faulty? = true))
      ]
  ]

  if (control = "optim");; optimized for south+eastbounds
  [;; "green-wave" control
    set p (screen-edge-x + 3) ;NOTE:!!! screen-edge-x = screen-edge-y
    set intersections-to-change intersections with
      ;[phase = round (((screen-edge-x + pxcor)) / 2)] ;;; works for horizontal cars... the tricky bit comes when there are also vertical... cannot synch torus...
      [(phase = round (((screen-edge-x + pxcor) + (screen-edge-y - pycor)) / 4))
       ;or ((phase = no-corr-p) and (faulty? = true))
      ]
    set intersections-to-yellow intersections with
      [(phase = round (((screen-edge-x + pxcor) + (screen-edge-y - pycor)) / 4) - 1)
       ;or ((phase = no-corr-p - 1) and (faulty? = true))
      ]
  ]

  if (control = "no-corr")
  [;; no correlation in phases
    set p (screen-edge-x + 3) ;NOTE:!!! screen-edge-x = screen-edge-y
    set intersections-to-change intersections with
      [phase = no-corr-p]
    set intersections-to-yellow intersections with
      [phase = no-corr-p - 1]
  ]

  if (control = "cut-off")
  [;; turn green when WAITING queue reaches queue-cut
    ask intersections [
      cut-off-count
    ]
    set intersections-to-change intersections with
      [(q = 1)
       ;or ((phase = no-corr-p) and (faulty? = true))
      ]
    set intersections-to-yellow intersections with
      [(q = 0)
       ;or ((phase = no-corr-p - 1) and (faulty? = true))
      ]
  ]



  ask intersections-to-change
  [
    set green-light-v? (not green-light-v?)
    set-signal-colors
  ]
  if (yellow?)
  [
    ask intersections-to-yellow
    [
      set-signal-yellow
    ]
  ]
end

;; This procedure counts waiting cars in redlight, q=0 if >=queue-cut... (for yellow)
to cut-off-count  ;; intersection (patch) procedure
 locals [ cars i]
ifelse (q != 0)[
 set cars 0
 set q -1
 set i 0
 ifelse (not green-light-v?)
 [
  while [i <= queue-cut]
  [
    ;intersection-dirs 0=SE , 1= SW, 2= NW, 3= NE
    ifelse southbound?
      [set cars (cars + count (turtles-at 0 i))]
      [set cars (cars + count (turtles-at 0 (- i)))]
    set i (i + 1)
  ]
 ]
 [
  while [i <= queue-cut]
  [
    ifelse eastbound?
      [set cars (cars + count (turtles-at (- i) 0))]
      [set cars (cars + count (turtles-at i 0))]
    set i (i + 1)
  ]
 ]
 if (cars >= queue-cut) and (greensteps > mingreen)[
   set q 0
 ]
]
[
 set q 1
]
end

;; This procedure self-organizes the pg's and q's of intersections to optimize traffic flow...
to self-org-request  ;; intersection (patch) procedure
  locals [ cars1 cars2 x y i]
 ifelse (not green-light-v?)
 [
  set i 0
  set cars1 0
  while [i < grid-y-inc]
  [
    ;intersection-dirs 0=SE , 1= SW, 2= NW, 3= NE
    ifelse southbound?
      [set cars1 (cars1 + count (turtles-at 0 i))]
      [set cars1 (cars1 + count (turtles-at 0 (- i)))]
    set i (i + 1)
  ]
  set kappa1 (kappa1 + cars1)
  if (kappa1 > tolerance) [
    set q (pg1 + (clock mod pg2))
    set kappa1 0
  ] 
]
[
  set i 0
  set cars2 0
  while [i < grid-x-inc]
  [
    ifelse eastbound?
      [set cars2 (cars2 + count (turtles-at (- i) 0))]
      [set cars2 (cars2 + count (turtles-at i 0))]
    set i (i + 1)
  ]
  set kappa2 (kappa2 + cars2)
  if (kappa2 > tolerance) [
    set q (clock mod pg1)
    set kappa2 0
  ] 
 ]
  
end


;; This procedure self-organizes the pg's and q's of intersections to optimize traffic flow...
to self-org-phase  ;; intersection (patch) procedure
  locals [ cars1 cars2 i]
 ifelse (not green-light-v?)
 [;;red light from north
  set i 1
  set cars1 0
  while [i < grid-y-inc - 1]
  [
    ifelse southbound?
      [set cars1 (cars1 + count (turtles-at 0 i))]
      [set cars1 (cars1 + count (turtles-at 0 (- i)))]
    set i (i + 1)
  ]
  set kappa1 (kappa1 + cars1)
  if (kappa1 > tolerance) and (not yellow-light?) and (greensteps > mingreen)[
    set q phase
    adj-q
    set kappa1 0
    set lambda1 (lambda1 + 1)
    if (metatolerance > 0) and (lambda1 >= metatolerance) ;; adjust pg's
    [ 
      if (pg2 > 1) [ ;;  should change if more than two pg's
        set pg2 (pg2 - 1)
        set pg1 (pg1 + 1)
      ]
      set lambda1 0
    ]
  ] 
]
[;;red light from west
  set i 1
  set cars2 0
  while [i < grid-x-inc - 1]
  [
    ifelse eastbound?
      [set cars2 (cars2 + count (turtles-at (- i) 0))]
      [set cars2 (cars2 + count (turtles-at i 0))]
    set i (i + 1)
  ]
  set kappa2 (kappa2 + cars2)
  if (kappa2 > tolerance) and (not yellow-light?) and (greensteps > mingreen)[
    set q (phase - pg2)
    adj-q
    set kappa2 0
    set lambda2 (lambda2 + 1)
    if (metatolerance > 0) and (lambda2 >= metatolerance) ;; adjust pg's
    [ 
      if (pg1 > 1) [ ;;  should change if more than two pg's
        set pg1 (pg1 - 1)
        set pg2 (pg2 + 1)
      ]
      set lambda2 0
    ]
  ] 
 ]
end

;; This procedure self-organizes the pg's and q's of intersections to optimize traffic flow...
to self-org-platoon  ;; intersection (patch) procedure
  locals [ cars i]
 ifelse (not green-light-v?)
 [;;red light from north
  set i 1
  set cars 0
  while [i < grid-y-inc - 1]
  [
    ifelse southbound?
      [set cars (cars + count (turtles-at 0 i))]
      [set cars (cars + count (turtles-at 0 (- i)))]
    set i (i + 1)
  ]
  set kappa1 (kappa1 + cars)

  set i 1
  set cars 0
  while [i < keep-platoon]
  [
    ifelse eastbound?
      [set cars (cars + count (turtles-at (- i) 0))]
      [set cars (cars + count (turtles-at i 0))]
    set i (i + 1)
  ]

  if (kappa1 > tolerance) and (not yellow-light?) and (greensteps > mingreen) and ((0 = cars) or ((cars >= cut-platoon) and (cars < (keep-platoon - 1))))[
    set q phase
    adj-q
    set kappa1 0
    set lambda1 (lambda1 + 1)
    if (metatolerance > 0) and (lambda1 >= metatolerance) ;; adjust pg's
    [ 
      if (pg2 > 1) [ ;;  should change if more than two pg's
        set pg2 (pg2 - 1)
        set pg1 (pg1 + 1)
      ]
      set lambda1 0
    ]
  ] 
]
[;;red light from west
  set i 1
  set cars 0
  while [i < grid-x-inc - 1]
  [
    ifelse eastbound?
      [set cars (cars + count (turtles-at (- i) 0))]
      [set cars (cars + count (turtles-at i 0))]
    set i (i + 1)
  ]
  set kappa2 (kappa2 + cars)

  set i 1
  set cars 0
  while [i < keep-platoon]
  [
    ifelse southbound?
      [set cars (cars + count (turtles-at 0 i))]
      [set cars (cars + count (turtles-at 0 (- i)))]
    set i (i + 1)
  ]

  if (kappa2 > tolerance) and (not yellow-light?) and (greensteps > mingreen) and ((0 = cars) or ((cars >= cut-platoon) and (cars < (keep-platoon - 1))))[
    set q (phase - pg2)
    adj-q
    set kappa2 0
    set lambda2 (lambda2 + 1)
    if (metatolerance > 0) and (lambda2 >= metatolerance) ;; adjust pg's
    [ 
      if (pg1 > 1) [ ;;  should change if more than two pg's
        set pg1 (pg1 - 1)
        set pg2 (pg2 + 1)
      ]
      set lambda2 0
    ]
  ] 
 ]
end

;; bounds q
to adj-q  ;; intersection (patch) procedure
  if (q < 0)  
  [ set q (q + p) ]
  if (q > p)
  [ set q (p mod q)]
end

;; This procedure checks the variable green-light-v? at each intersection and sets the
;; traffic lights to have the green light up or the green light to the left.
to set-signal-colors  ;; intersection (patch) procedure
  ifelse power?
  [
    set yellow-light? false
    set greensteps 0
    ;intersection-dirs 0=SE , 1= SW, 2= NW, 3= NE
    if (intersection-dirs = 0)[;SE
      ifelse green-light-v?[ 
        set (pcolor-of patch-at -1 0) red
        set (pcolor-of patch-at 0 1) green
      ][
        set (pcolor-of patch-at -1 0) green
        set (pcolor-of patch-at 0 1) red
      ]
    ]
    if (intersection-dirs = 1)[;SW
      ifelse green-light-v?[ 
        set (pcolor-of patch-at 1 0) red
        set (pcolor-of patch-at 0 1) green
      ][
        set (pcolor-of patch-at 1 0) green
        set (pcolor-of patch-at 0 1) red
      ]
    ]
    if (intersection-dirs = 2)[;NW
      ifelse green-light-v?[ 
        set (pcolor-of patch-at 1 0) red
        set (pcolor-of patch-at 0 -1) green
      ][
        set (pcolor-of patch-at 1 0) green
        set (pcolor-of patch-at 0 -1) red
      ]
    ]
    if (intersection-dirs = 3)[;NE
      ifelse green-light-v?[ 
        set (pcolor-of patch-at -1 0) red
        set (pcolor-of patch-at 0 -1) green
      ][
        set (pcolor-of patch-at -1 0) green
        set (pcolor-of patch-at 0 -1) red
      ]
    ]
  ]
  [
    set (pcolor-of patch-at -1 0) white
    set (pcolor-of patch-at 0 1) white
    set (pcolor-of patch-at 1 0) white
    set (pcolor-of patch-at 0 -1) white
  ]
end

;; to set-yellow-lights
to set-signal-yellow  ;; intersection (patch) procedure
  ifelse power?
  [
    set yellow-light? true
    ;intersection-dirs 0=SE , 1= SW, 2= NW, 3= NE
    if (intersection-dirs = 0)[;SE
      ifelse green-light-v?[ 
        set (pcolor-of patch-at -1 0) red
        set (pcolor-of patch-at 0 1) yellow
      ][
        set (pcolor-of patch-at -1 0) yellow
        set (pcolor-of patch-at 0 1) red
      ]
    ]
    if (intersection-dirs = 1)[;SW
      ifelse green-light-v?[ 
        set (pcolor-of patch-at 1 0) red
        set (pcolor-of patch-at 0 1) yellow
      ][
        set (pcolor-of patch-at 1 0) yellow
        set (pcolor-of patch-at 0 1) red
      ]
    ]
    if (intersection-dirs = 2)[;NW
      ifelse green-light-v?[ 
        set (pcolor-of patch-at 1 0) red
        set (pcolor-of patch-at 0 -1) yellow
      ][
        set (pcolor-of patch-at 1 0) yellow
        set (pcolor-of patch-at 0 -1) red
      ]
    ]
    if (intersection-dirs = 3)[;NE
      ifelse green-light-v?[ 
        set (pcolor-of patch-at -1 0) red
        set (pcolor-of patch-at 0 -1) yellow
      ][
        set (pcolor-of patch-at -1 0) yellow
        set (pcolor-of patch-at 0 -1) red
      ]
    ]
  ]
  [
    set (pcolor-of patch-at -1 0) white
    set (pcolor-of patch-at 0 1) white
    set (pcolor-of patch-at 1 0) white
    set (pcolor-of patch-at 0 -1) white
  ]
end

;; set any intersection's color that had an accident back to white and make accident? false