Package Dispatch Service

; POST OFFICE / STORAGE HOUSE — Multi-Agent MAS (NetLogo 6.4.0)

breed [packages package]
breed [carriers carrier]
breed [sorters sorter]
breed [dispatchers dispatcher]
breed [customers customer]
undirected-link-breed [s-links s-link]

globals [
  station-x station-y
  n-sorters n-dispatchers n-customers-per-dispatcher
  arrival-per-tick carrier-count
  belt-speed carrier-speed delivery-speed
  sorter-service-rate sorter-link-radius alpha
  delivered-count avg-delay last-delay package-seq
]

packages-own [ dest-id addr-agent content stage target-agent current-node created-tick arrival-order route ]
carriers-own  [ payload target-sorter state ]
sorters-own   [ s-neighbors q-to-disp processed-this-tick ]
dispatchers-own [ did home-x home-y busy? delivering-package returning? ]
customers-own [ cid belongs-to-disp ]

to-report dist-pts [x1 y1 x2 y2]
  report sqrt ((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
end 

to setup
  clear-all
  set n-sorters 14
  set n-dispatchers 4
  set n-customers-per-dispatcher 20
  set arrival-per-tick 1.6
  set carrier-count 6
  set belt-speed 0.7
  set carrier-speed 1.1
  set delivery-speed 1.3
  set sorter-service-rate 1.0
  set sorter-link-radius 8
  set alpha 0.25
  set station-x 0
  set station-y 0
  set delivered-count 0
  set avg-delay 0
  set last-delay 0
  set package-seq 0
  setup-world
  setup-dispatchers
  setup-customers
  setup-sorters
  setup-carriers
  reset-ticks
end 

to setup-world
  resize-world -25 25 -25 25
  set-patch-size 11
  ask patches [ set pcolor 24 ]
  ask patch station-x station-y [
    set pcolor 63
    set plabel "Main Station"
    set plabel-color white
  ]
end 

to setup-dispatchers
  let radius (min (list (max-pxcor - 2) (max-pycor - 2)))
  let angles n-values n-dispatchers [ i -> 360 * (i / n-dispatchers) ]
  let idx 0
  foreach angles [ a ->
    let x station-x + radius * cos a
    let y station-y + radius * sin a
    create-dispatchers 1 [
      setxy x y
      set size 2
      set shape "truck"
      set color blue
      set did idx
      set home-x x
      set home-y y
      set busy? false
      set returning? false
      set delivering-package nobody
      set label (word "D" did)
      set label-color blue + 2
    ]
    set idx idx + 1
  ]
end 

; OBSERVER creates customers near each dispatcher (not inside ask dispatchers)

to setup-customers
  let ringInner 5
  let ringOuter 10
  foreach sort dispatchers [ d ->
    let hx [home-x] of d
    let hy [home-y] of d
    let didx [did] of d
    repeat n-customers-per-dispatcher [
      let r ringInner + random-float (ringOuter - ringInner)
      let t random-float 360
      create-customers 1 [
        setxy (hx + r * cos t) (hy + r * sin t)
        set shape "house"
        set size 1.2
        set color 15
        set cid who
        set belongs-to-disp didx
      ]
    ]
  ]
end 

to setup-sorters
  let inner 3
  let outer 12
  create-sorters n-sorters [
    let r inner + random-float (outer - inner)
    let t random-float 360
    setxy (station-x + r * cos t) (station-y + r * sin t)
    set shape "circle"
    set color red
    set size 1.6
    set label "S"
    set label-color red + 2
    set processed-this-tick 0
    set q-to-disp n-values n-dispatchers [ _ -> 999999 ]
  ]
  ask sorters [
    let nbrs other sorters in-radius sorter-link-radius
    ask nbrs [ create-s-link-with myself ]
  ]
  ask sorters [ set s-neighbors link-neighbors ]
  ask sorters [
    let sx xcor
    let sy ycor
    let tmp q-to-disp
    let k 0
    while [k < n-dispatchers] [
      let d one-of dispatchers with [did = k]
      let val 999999
      if d != nobody [
        let destX [xcor] of d
        let destY [ycor] of d
        set val (dist-pts sx sy destX destY) / belt-speed
      ]
      set tmp replace-item k tmp val
      set k k + 1
    ]
    set q-to-disp tmp
  ]
end 

to setup-carriers
  create-carriers carrier-count [
    setxy station-x station-y
    set shape "person"
    set color 55
    set size 1.5
    set payload nobody
    set target-sorter nobody
    set state "idle"
  ]
end 

to go
  spawn-packages
  carriers-act
  sorters-act
  packages-move
  dispatchers-act
  update-sorter-values
  tick
end 

to spawn-packages
  let n floor arrival-per-tick
  let f arrival-per-tick - n
  if random-float 1 < f [ set n n + 1 ]
  if n <= 0 [ stop ]
  repeat n [
    set package-seq package-seq + 1
    let path random n-dispatchers
    let cust one-of customers with [belongs-to-disp = path]
    if cust = nobody [ stop ]
    create-packages 1 [
      setxy station-x station-y
      set shape "box"
      set color 106
      set size 1.0
      set dest-id path
      set addr-agent cust
      set content (word "SKU-" (100000 + random 899999))
      set stage "at-station"
      set target-agent nobody
      set current-node nobody
      set created-tick ticks
      set arrival-order package-seq
      set route []
    ]
  ]
end 

to carriers-act
  ask carriers [
    if state = "idle" [
      let p min-one-of (packages with [stage = "at-station"]) [arrival-order]
      if p != nobody [
        let s best-initial-sorter
        if s != nobody [
          set payload p
          set target-sorter s
          set state "to-sorter"
          ask p [
            set stage "with-carrier"
            set current-node nobody
            set target-agent [target-sorter] of myself
            face [target-sorter] of myself
          ]
        ]
      ]
    ]
    if state = "to-sorter" [
      if target-sorter = nobody [ set state "returning" ]
      face target-sorter
      fd carrier-speed
      if target-sorter != nobody and distance target-sorter < 1 [
        if payload != nobody [
          ask payload [
            setxy [xcor] of [target-sorter] of myself [ycor] of [target-sorter] of myself
            set stage "at-sorter"
            set current-node [target-sorter] of myself
            set arrival-order ticks
            set route lput [who] of [target-sorter] of myself route
            set target-agent nobody
          ]
        ]
        set payload nobody
        set target-sorter nobody
        set state "returning"
      ]
    ]
    if state = "returning" [
      facexy station-x station-y
      fd carrier-speed
      if distancexy station-x station-y < 1 [ set state "idle" ]
    ]
  ]
end 

to-report best-initial-sorter
  let sx station-x
  let sy station-y
  if any? sorters [
    report min-one-of sorters [
      0.7 * (dist-pts sx sy xcor ycor) + 0.3 * queue-size-of self
    ]
  ]
  report nobody
end 

to sorters-act
  ask sorters [
    set processed-this-tick 0
    let capacity sorter-service-rate
    while [capacity > 0] [
      let p next-from-queue self
      if p = nobody [ set capacity 0 stop ]
      let k [dest-id] of p
      let next choose-next-hop self k
      if next = nobody [ set next one-of dispatchers with [did = k] ]
      if next != nobody [
        ask p [
          set stage "in-transit"
          set current-node nobody
          set target-agent next
          face next
          set route lput [who] of myself route
        ]
        set processed-this-tick processed-this-tick + 1
      ]
      set capacity capacity - 1
    ]
  ]
end 

to-report next-from-queue [srt]
  report min-one-of (packages with [stage = "at-sorter" and current-node = srt]) [arrival-order]
end 

to-report queue-size-of [srt]
  report count packages with [stage = "at-sorter" and current-node = srt]
end 

to-report choose-next-hop [srt k]
  let sx [xcor] of srt
  let sy [ycor] of srt
  let d one-of dispatchers with [did = k]
  if d = nobody [ report nobody ]
  let destX [xcor] of d
  let destY [ycor] of d
  let best-agent d
  let best-cost (dist-pts sx sy destX destY) / belt-speed
  let nbrs [s-neighbors] of srt
  if any? nbrs [
    let cs min-one-of nbrs [
      (dist-pts sx sy xcor ycor) / belt-speed + (item k q-to-disp)
    ]
    if cs != nobody [
      let nbrX [xcor] of cs
      let nbrY [ycor] of cs
      let cst (dist-pts sx sy nbrX nbrY) / belt-speed + (item k [q-to-disp] of cs)
      if cst < best-cost [
        set best-cost cst
        set best-agent cs
      ]
    ]
  ]
  report best-agent
end 

to packages-move
  ask packages with [stage = "in-transit" and target-agent != nobody] [
    face target-agent
    fd belt-speed
    if distance target-agent < 1 [
      if [breed] of target-agent = sorters [
        set stage "at-sorter"
        set current-node target-agent
        set arrival-order ticks
      ]
      if [breed] of target-agent = dispatchers [
        set stage "with-dispatcher"
        set current-node target-agent
      ]
      set target-agent nobody
    ]
  ]
end 

to dispatchers-act
  ask dispatchers [
    if not busy? [
      let p min-one-of (packages with [stage = "with-dispatcher" and current-node = myself]) [arrival-order]
      if p != nobody [
        set delivering-package p
        set busy? true
        set returning? false
      ]
    ]
    if busy? and not returning? [
      let addr [addr-agent] of delivering-package
      face addr
      fd delivery-speed
      if distance addr < 1 [
        let p delivering-package
        ask p [
          set stage "delivered"
          set color green
        ]
        set delivered-count delivered-count + 1
        set last-delay (ticks - [created-tick] of p)
        set avg-delay avg-delay + (last-delay - avg-delay) / delivered-count
        ask p [ die ]
        set returning? true
      ]
    ]
    if returning? [
      facexy home-x home-y
      fd delivery-speed
      if distancexy home-x home-y < 1 [
        set busy? false
        set returning? false
        set delivering-package nobody
      ]
    ]
  ]
end 

to update-sorter-values
  ask sorters [
    let sx xcor
    let sy ycor
    let qnew q-to-disp
    let local-delay (queue-size-of self) / max (list 0.0001 sorter-service-rate)
    let k 0
    while [k < n-dispatchers] [
      let d one-of dispatchers with [did = k]
      let best 999999
      if d != nobody [
        let destX [xcor] of d
        let destY [ycor] of d
        set best (dist-pts sx sy destX destY) / belt-speed
      ]
      if any? s-neighbors [
        let cs min-one-of s-neighbors [
          (dist-pts sx sy xcor ycor) / belt-speed + (item k q-to-disp)
        ]
        if cs != nobody [
          let nbrX [xcor] of cs
          let nbrY [ycor] of cs
          let cst (dist-pts sx sy nbrX nbrY) / belt-speed + (item k [q-to-disp] of cs)
          if cst < best [ set best cst ]
        ]
      ]
      let old (item k q-to-disp)
      let upd ((1 - alpha) * old) + (alpha * (local-delay + best))
      set qnew replace-item k qnew upd
      set k k + 1
    ]
    set q-to-disp qnew
  ]
end 

to-report in-system               report count packages end

to-report at-station             report count packages with [stage = "at-station"] end

to-report in-transit             report count packages with [stage = "in-transit" or stage = "with-carrier"] end

to-report at-sorters             report count packages with [stage = "at-sorter"] end

to-report waiting-at-dispatchers report count packages with [stage = "with-dispatcher"] end