Desire Paths

globals [
  map-canvas
  turf-colors
  map-valids
  map-openings
  turf-color
  path-color
  opening-color
  obstacle-color
  has-setup?
]
patches-own [
  turf-health
  patch-type
  visited?
  active?
  path-cost
  next-path-cell
]
turtles-own [
  destination
  pavement-preference
  grass-aversion
  upcoming-path
]

to setup-map
  clear-all
  set has-setup? true
  set-default-shape turtles "person"
  set turf-colors (list 37 56 56 54 53)

  let t 0
  let p 1
  let x 2
  let o 3

  ;; setup an initial map canvas
  set map-canvas (list
   ( list o p p p p p p p p p o )
   ( list p t t t t p t t t t t )
   ( list p t t t t p t t t t t )
   ( list p t t t t p t t t t t )
   ( list p t t t p p p t t t t )
   ( list p t t t p x p t t t t )
   ( list p t t t p p p t t t t )
   ( list p t t t t t t t t t t )
   ( list p t t t t t t t t t t )
   ( list p t t t t t t t t t t )
   ( list o p p p p p p p p p o )
  )

  resize-world 0 (length (item 1 map-canvas) - 1) 0 (length map-canvas - 1)
  ask patches [ set patch-type (item pxcor (item pycor map-canvas)) ]

  restart
end 

to new-canvas
  clear-patches
  let #width-ratio (world-width - 1) / custom-world-width
  let #height-ratio (world-height - 1) / custom-world-height
  set-patch-size floor (patch-size * min (list #width-ratio #height-ratio))
  resize-world 0 custom-world-width 0 custom-world-height
  ask patches [ set patch-type 0 ]
  update-map-data
end 

to-report patch-name-to-type [ #name ]
  if #name = "turf" [ report 0 ]
  if #name = "pavement" [ report 1 ]
  if #name = "obstacle" [ report 2 ]
  if #name = "opening" [ report 3 ]
end 

to patch-draw
  if mouse-down? [
    ask patch mouse-xcor mouse-ycor [
      set patch-type patch-name-to-type draw-patch-type
    ]
    update-map-data
    ask patch mouse-xcor mouse-ycor [ display ]
  ]
end 

to update-map-data
  ; Store a list of valid patches to traverse (non-obstacles)
  set map-valids ( patches with [ patch-type != 2 ] )
  set map-openings ( patches with [ patch-type = 3 ] )

  ask patches with [ patch-type = 0 ] [
    set pcolor last turf-colors
    set turf-health 1.0
  ]
  ask patches with [ patch-type = 1 ] [ set pcolor 8 ]
  ask patches with [ patch-type = 2 ] [ set pcolor black ]
  ask patches with [ patch-type = 3 ] [ set pcolor red ]
end 

to restart
  if (has-setup? != true) [
    setup-map
    stop
  ]

  ask patches [ set plabel "" ]
  clear-turtles
  reset-ticks
  clear-all-plots
  update-map-data
  create-turtles population [
    ;; randomly assign agent prefs using bounded normal distribution
    set pavement-preference max (list 0.1 (random-normal avg-pavement-preference (avg-pavement-preference * relative-standard-deviation / 100)))
    set grass-aversion max (list 0 (random-normal avg-grass-aversion (avg-grass-aversion * relative-standard-deviation / 100)))
    move-to one-of map-openings
    pick-destination
  ]
end 

to pick-destination
  ;; pick an opening that isn't the one here
  set destination ( one-of map-openings with [ self != [patch-here] of myself ] )
  set upcoming-path path-to-goal destination
end 

to go
  if has-setup? != true [ setup-map ]
  ask turtles [ turtle-go ]
  ask patches with [ patch-type = 0 ] [ turf-go ]
  tick
end 

to turtle-go
  ;; update destination if necessary
  if length upcoming-path = 0 [
    ;; set a new destination
    pick-destination
  ]
  ;; move one cell down path to destination
  move-to item 0 upcoming-path
  set upcoming-path remove-item 0 upcoming-path
end 

to turf-go
  set turf-health  min list (turf-health + (growth-rate / 100)) 1
  set turf-health max list 0 (turf-health - (turf-fragility / 100 * (count turtles-here)))
  set pcolor item (round (turf-health * 4)) turf-colors
end 

to-report cell-cost [ #traveler ]
  if (patch-type = 0) [ report 1 + ([grass-aversion] of #traveler * turf-health) ]
  if (patch-type = 1 or patch-type = 3) [ report 1 / [pavement-preference] of #traveler ]
  report 1
end 

to-report list-path [ #path-so-far ]
  let #next-patch ([next-path-cell] of (last #path-so-far))

  if ([path-cost] of (last #path-so-far)) = 0 [
    report #path-so-far
  ]

  report list-path lput #next-patch #path-so-far
end 

to-report path-to-goal [ #Goal ]
  let #Start patch-here
  let #traveler self

  ; clear all the information in the patches, and reset them
  ask map-valids [
    set next-path-cell nobody
    set path-cost (2 ^ 20)
    set visited? false
    set active? false
  ]

  ask #Start [
    set next-path-cell nobody
    set visited? false
  ]
  ask #Goal [
    set path-cost 0
    set visited? true
    set active? true
  ]

  while [not [visited?] of #Start] [
    let #options map-valids with [active?]

    ifelse any? #options [
      ask min-one-of #options [path-cost] [
        let #path-cost-father path-cost
        set active? false
        let #valid-neighbors neighbors with [member? self map-valids]
        ask #valid-neighbors [
          ;; get potential path cost, multiply cell cost by distance to account for diagonals
          let #new-path-cost #path-cost-father + (distance myself * cell-cost #traveler)
          if #new-path-cost < path-cost [
            set next-path-cell myself
            set visited? true
            set active? true
            set path-cost #new-path-cost
          ]
        ]
      ]
    ] [
      ;; We've run out of options before finding the Start
      show "No path available"
    ]
  ]

  let #future-path list-path (list #Start)

  report #future-path
end