Humans Turn Up and Go at a Train Station

; Copyright 2018 Mathew Hounsell, Institute of Sustainable Futures, University of Technology Sydney
; CC BY-NC-SA 3.0
; This work is licensed under the Creative Commons Attribution-NonCommercial-ShareAlike 3.0 License.
; To view a copy of this license, visit https://creativecommons.org/licenses/by-nc-sa/3.0/ or send a letter to Creative Commons, 559 Nathan Abbott Way, Stanford, California 94305, USA.

; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Definitions
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Maximum Train/Platform Length 12
globals [
  last_new_human_tick
  last_new_engine_tick
  last_move_tick
  next_carriage_delay
  dwelling_max
]

breed [ engines engine ]
breed [ carriages carriage ]
breed [ humans human ]
breed [ flora florum ]

engines-own [
  dwell
]
carriages-own [
  load
]

; ~~~~~~~~~~~~~~~~~~~~
; Reporting
; ~~~~~~~~~~~~~~~~~~~~

to-report ticks-of-next-new-engine
  report last_new_engine_tick + engine-interval
end 

to-report is-time-to-make-new-engine
  report ticks >= ticks-of-next-new-engine
end 

to-report is-time-to-make-new-human
  let t ( human-interval )
  report ticks >= last_new_human_tick + t
end 

to-report is-time-to-move
  report ticks >= last_move_tick + 2
end 

to-report get-load-on-carriages
  if count engines < 1 [
    report 0
  ]
  let c 0
  ask carriages [ set c ( c + load ) ]
  report c
end 

to-report can-platform-be-at-coord [ x ]
  report x > -13 and x < 0
end 

to-report can-engine-be-at-coord [ x ]
  report x > (0 - carriage-length - 1) and x < 0
end 

to-report can-next-stopping-engine-be-at-coord [ x ]
  let active-engine false
  ; no engine
  if count engines > 1 [
    ask engines [
      ; past station
      if xcor <= 0 and xcor > (min-pxcor + carriage-length + 1) [
        set active-engine true
      ]
    ]
  ]
  if not active-engine [ report can-engine-be-at-coord x ]
  report x > (0 - (count carriages) - 1) and x < 0
end 

to-report coord-to-location [ x y ]
  if y = 0 [ report "dirt" ]
  if y = -1 [ report "railway" ]
  if y = -2 and not can-platform-be-at-coord x [ report "dirt" ]
  if ( y = -2 or y = -3 ) and can-platform-be-at-coord x [ report "platform" ]
  if y < 0 and can-platform-be-at-coord x [ report "path" ]
  report "grass"
end 

to-report tree-color [ v ]
  if v < 1.0 [ report red - 2 ]
  if v < 2.0 [ report orange - 1 ]
  if v < 3.0 [ report yellow - 1 ]
  report green - 3
end 

to-report dwell-countdown
  let dwelling "-"
  if (count engines-on patch 0 -1) = 1 [
    ask engines [
      set dwelling dwell
    ]
  ]
  report dwelling
end 

to-report engine-countdown
  if count engines < 1 [
    let t ( ticks-of-next-new-engine - ticks )
    if t < 0 [ report 0 ]
    report t
  ]
  report "-"
end 

; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Setup
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

to startup
  setup
end 

to setup
  clear-all
  reset-ticks
  set last_new_human_tick 0
  set last_new_engine_tick 0
  set last_move_tick 0
  set dwelling_max 20

  set-default-shape engines "train passenger engine"
  set-default-shape carriages "train passenger car"
  set-default-shape humans "person"
  set-default-shape flora "tree"

  setup-patches
end 

to setup-patches
  ask patches [
    let loc ( coord-to-location pxcor pycor )
    let grass ( green - 0.25 + random-float 1.5 )
    set pcolor ( ifelse-value (loc = "railway") [black] [ifelse-value (loc = "platform") [grey] [ifelse-value (loc = "dirt") [brown] [ifelse-value (loc = "path") [green] [grass]]]] )
  ]

  let c 0
  while [ c < 40 ] [
    let x random-pxcor
    let y random-pycor
    let loc ( coord-to-location  x y )
    if loc = "grass" and not any? flora-on patch x y [
      create-flora 1 [
        setxy x y
        set color tree-color random-float 5.0
      ]
      set c ( c + 1 )
    ]
  ]
end 

; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Running
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

to go
  every 0.1 / simulation-speed [
    ; let us set the tick rate at 10 fps
    ; then we shall assume that every tick is equivilant to 1 sec
    ; the fps is 24 so that it is a multiple of 8
    go-single
    tick
  ]
end 

to go-single
  ;; not available in the web -> no-display ;; to keep the carriages moving as one
  ifelse count engines > 0 or count carriages > 0 [
    move-engines
  ] [
    make-new-engine
  ]
  make-new-carriage ; use the fact that the last carriage may have moved into the second square to test
  ;; not available in the web -> display

  move-humans
  make-new-human
end 

; ~~~~~~~~~~~~~~~~~~~~
; Control
; ~~~~~~~~~~~~~~~~~~~~

to delay-next-engine [ duration ]
  set last_new_engine_tick ( last_new_engine_tick + duration )
end 

; ~~~~~~~~~~~~~~~~~~~~
; Movement
; ~~~~~~~~~~~~~~~~~~~~

to move-engines
  let dwelling 0
  ask engines [
    ifelse not can-move? 1 [
      die
    ][
      set dwelling dwell
      ifelse dwell > 0 [
        set dwell dwell - 1
      ][
        fd 1
        if xcor = 0 [
          set dwell dwelling_max + 1
        ]
      ]
    ]
  ]
  foreach sort-on [ xcor ] carriages [ the-carriage -> ask the-carriage [
    ifelse not can-move? 1 [
      die
    ][
      if dwelling = 0 [
        fd 1
      ]
    ]
  ] ]
  ifelse dwelling > 1 [
    ask engines [ set color magenta ]
    ask carriages [ set color magenta ]
  ][
    ask engines [ set color white ]
    ask carriages [ set color white ]
  ]
end 

to move-a-human [ dwelling ]
  if dwelling > 1 and dwelling < dwelling_max and ycor = -2 [
    let hxcor xcor
    if any? carriages-on patch hxcor -1 [
      ask carriages with [ xcor = hxcor and ycor = -1 ] [ set load load + 1 ]
      die
    ]
  ]
  if ycor < -2 [
    let newy ( ycor + 1 )
    if heading = 180 [ set newy ( ycor - 1 ) ]
    ; go forward
    if can-next-stopping-engine-be-at-coord (xcor) and not any? turtles-on patch xcor newy [
      setxy xcor newy
      stop
    ]
    ; prefer to move up and right
    if can-next-stopping-engine-be-at-coord (xcor + 1) and not any? turtles-on patch (xcor + 1) newy [
      setxy xcor + 1 newy
      stop
    ]
    ; then to move up and left
    if can-next-stopping-engine-be-at-coord (xcor - 1) and not any? turtles-on patch (xcor - 1) newy [
      setxy xcor - 1 newy
      stop
    ]
  ]
  ; try moving right
  if not can-next-stopping-engine-be-at-coord (xcor) and (xcor + 1 < 0) and not any? turtles-on patch (xcor + 1) ycor [
    setxy (xcor + 1) ycor
  ]
end 

to move-humans
  if is-time-to-move
  [
    let dwelling 0
    ask engines with [ xcor = 0 ] [
      set dwelling dwell
    ]

    ; remember it is [start..stop) by step
    foreach (range -2 (min-pycor - 1) -1) [ y ->
      foreach (range -1 -14 -1) [ x ->
        ask humans with [ xcor = x and ycor = y ] [
          move-a-human dwelling
        ]
      ]
    ]
    set last_move_tick ticks
  ]
end 

; ~~~~~~~~~~~~~~~~~~~~
; Creation
; ~~~~~~~~~~~~~~~~~~~~

to make-new-human
  if is-time-to-make-new-human [
    set last_new_human_tick ticks
    let dir 0 ; ( floor ( random-float 1.9 ) ) * 180
    let x ( -1 - floor ( random-float carriage-length ) )
    let y min-pycor
    if dir = 180 [ set y max-pycor ]
    if (random-float 100 < human-frequency) and not any? turtles-on patch x y [
      create-humans 1 [
        setxy x y
        set heading dir
        set color cyan ; one-of [ yellow red blue orange cyan ]
        set shape one-of [ "person business" "person construction" "person doctor" "person service" "person lumberjack" "person student" ]
      ]
    ]
  ]
end 

to make-new-carriage
  if count carriages < carriage-length [
    if any? turtles-on patch (min-pxcor + 1) -1 [
      create-carriages 1 [
        setxy min-pxcor -1
        set heading 90
        set color white
        set load 0
      ]
    ]
  ]
end 

to make-new-engine
  if count engines > 0 [ error "Asked to make a engine when one already exists." ]

  if is-time-to-make-new-engine [
    set last_new_engine_tick ticks

    create-engines 1 [
      setxy min-pxcor -1
      set heading 90
      set color white ; one-of [ yellow red blue orange cyan ]
      set dwell 0
    ]
  ]
end