fitness landscape

; ============================================================
; 3D DYNAMIC FITNESS LANDSCAPE MODEL
; NetLogo 3D  (.nlogo3d)
;
; FIX: "agents" is a reserved NetLogo primitive (it reports all
; turtles), so the breed has been renamed to "walkers / walker"
; throughout the entire file.
;
; WORLD SETTINGS (set in NetLogo 3D Model Settings):
;   min-pxcor: -15   max-pxcor: 15
;   min-pycor: -15   max-pycor: 15
;   min-pzcor:  0    max-pzcor: 20
;
; REQUIRED INTERFACE ELEMENTS:
;   Buttons:   setup  |  go (forever)
;   Sliders:
;     num-peaks            min=1  max=8   default=3  step=1
;     initial-population   min=10 max=200 default=60 step=5
;     max-population       min=50 max=500 default=200 step=10
;     mutation-rate        min=0  max=0.5 default=0.08 step=0.01
;     reproduction-threshold min=0.3 max=0.95 default=0.65 step=0.05
;     death-threshold      min=0  max=0.3 default=0.05 step=0.01
;     lifespan             min=50 max=500 default=200 step=10
;     peak-speed           min=0  max=0.4 default=0.08 step=0.01
;   Switches:  dynamic?  (default On)
;   Monitors:  count walkers  |  precision mean-fit 3
;   Plot: "Population & Fitness Over Time"
;     pen "Mean Fitness"  -> plot mean-fit
;     pen "Pop (scaled)"  -> plot count walkers / max-population
; ============================================================

breed [ surface-nodes surface-node ]
breed [ walkers walker ]
;; "agents" is a built-in NetLogo primitive reporter, so we use "walkers"

globals [
  peak-list
  max-fit
  mean-fit
]

patches-own [
  fit
  my-node
]

surface-nodes-own [
  home-x
  home-y
]

walkers-own [
  my-fit
  my-age
]


; ==============================================================
; SETUP
; ==============================================================

to setup
  clear-all
  initialize-peaks
  update-fitness-landscape
  build-surface-mesh
  seed-population
  set mean-fit 0
  reset-ticks
end 

to initialize-peaks
  set peak-list []
  let margin 3
  repeat num-peaks [
    let px random-float (world-width  - margin * 2) + min-pxcor + margin
    let py random-float (world-height - margin * 2) + min-pycor + margin
    let ph 0.55 + random-float 0.45
    let ps 12   + random-float 20
    let vx (random-float (peak-speed * 2)) - peak-speed
    let vy (random-float (peak-speed * 2)) - peak-speed
    set peak-list lput (list px py ph ps vx vy) peak-list
  ]
end 

to update-fitness-landscape
  ask patches with [pzcor = 0] [ set fit 0 ]
  foreach peak-list [ pk ->
    let px item 0 pk
    let py item 1 pk
    let ph item 2 pk
    let ps item 3 pk
    ask patches with [pzcor = 0] [
      let d2 ((pxcor - px) ^ 2 + (pycor - py) ^ 2)
      set fit fit + ph * exp(-1 * d2 / ps)
    ]
  ]
  set max-fit max [fit] of patches with [pzcor = 0]
  if max-fit > 0 [
    ask patches with [pzcor = 0] [
      set fit fit / max-fit
      set pcolor elevation-color fit
    ]
  ]
end 

to-report elevation-color [ val ]
  if val < 0.20 [ report scale-color blue   val -0.10 0.40 ]
  if val < 0.45 [ report scale-color cyan   val  0.10 0.70 ]
  if val < 0.65 [ report scale-color green  val  0.20 0.90 ]
  if val < 0.82 [ report scale-color yellow val  0.40 1.10 ]
  report         scale-color red    val  0.60 1.20
end 

to build-surface-mesh
  ask surface-nodes [ die ]
  ask links         [ die ]
  ask patches with [pzcor = 0] [ set my-node nobody ]

  ask patches with [pzcor = 0] [
    let p self
    sprout-surface-nodes 1 [
      set home-x [pxcor] of p
      set home-y [pycor] of p
      set zcor   [fit]   of p * (max-pzcor - 1)
      set color  [pcolor] of p
      set shape "circle"
      set size 0.2
      ask p [ set my-node myself ]
    ]
  ]

  ask patches with [pzcor = 0] [
    if my-node != nobody [
      let me my-node

      ;; RIGHT neighbor  (was "rp" -- clashes with random-pzcor primitive)
      let right-p patch (pxcor + 1) pycor 0
      if right-p != nobody and [my-node] of right-p != nobody [
        ask me [
          create-link-with [my-node] of right-p [
            set color [color] of end1
            set thickness 0.05
          ]
        ]
      ]

      ;; UPPER neighbor  (was "up" -- clashes with pitch-up primitive)
      let upper-p patch pxcor (pycor + 1) 0
      if upper-p != nobody and [my-node] of upper-p != nobody [
        ask me [
          create-link-with [my-node] of upper-p [
            set color [color] of end1
            set thickness 0.05
          ]
        ]
      ]
    ]
  ]
end 

to seed-population
  create-walkers initial-population [
    setxy random-xcor random-ycor
    place-on-surface
    set my-age 0
    set shape "default"
    set size 2.0
  ]
end 


; ==============================================================
; GO
; ==============================================================

to go
  if dynamic? [
    move-peaks
    update-fitness-landscape
    refresh-surface-heights
  ]

  ask walkers [
    set my-age my-age + 1
    ifelse random-float 1 < mutation-rate
      [ explore-randomly       ]
      [ climb-fitness-gradient ]
    place-on-surface
    if my-fit > reproduction-threshold
       and count walkers < max-population
       and random-float 1 < 0.07 [
      hatch 1 [
        set my-age 0
        set xcor xcor + (random-float 2.5 - 1.25)
        set ycor ycor + (random-float 2.5 - 1.25)
        clamp-position
        place-on-surface
      ]
    ]
    if my-age > lifespan [ die ]
    if my-fit < death-threshold and random-float 1 < 0.12 [ die ]
  ]

  if count walkers < 5 [
    create-walkers 10 [
      setxy random-xcor random-ycor
      place-on-surface
      set my-age 0
      set shape "default"
      set size 2.0
    ]
  ]

  set mean-fit ifelse-value any? walkers
    [ mean [my-fit] of walkers ]
    [ 0 ]

  tick
end 


; ==============================================================
; WALKER PROCEDURES
; ==============================================================

to climb-fitness-gradient
  let best-x xcor
  let best-y ycor
  let best-val my-fit
  foreach [ [ 1  0] [-1  0] [ 0  1] [ 0 -1]
            [ 1  1] [ 1 -1] [-1  1] [-1 -1] ] [ offset ->
    let nx xcor + item 0 offset
    let ny ycor + item 1 offset
    if nx >= min-pxcor and nx <= max-pxcor and
       ny >= min-pycor and ny <= max-pycor [
      let gp patch (round nx) (round ny) 0
      if gp != nobody [
        let gf [fit] of gp
        if gf > best-val [
          set best-val gf
          set best-x nx
          set best-y ny
        ]
      ]
    ]
  ]
  set xcor best-x
  set ycor best-y
end 

to explore-randomly
  let step 1.5 + random-float 2.5
  set xcor xcor + (random-float (step * 2) - step)
  set ycor ycor + (random-float (step * 2) - step)
  clamp-position
end 

to place-on-surface
  clamp-position
  let gp patch (round xcor) (round ycor) 0
  set my-fit ifelse-value (gp != nobody) [ [fit] of gp ] [ 0 ]
  set zcor my-fit * (max-pzcor - 1) + 0.6
  set color scale-color red my-fit -0.3 1.1
end 

to clamp-position
  set xcor max (list min-pxcor (min (list max-pxcor xcor)))
  set ycor max (list min-pycor (min (list max-pycor ycor)))
end 


; ==============================================================
; LANDSCAPE PROCEDURES
; ==============================================================

to move-peaks
  let new-list []
  foreach peak-list [ pk ->
    let px item 0 pk
    let py item 1 pk
    let ph item 2 pk
    let ps item 3 pk
    let vx item 4 pk
    let vy item 5 pk
    set px px + vx
    set py py + vy
    let wx (max-pxcor - 3)
    let wy (max-pycor - 3)
    if px >  wx [ set px  wx  set vx (- vx) ]
    if px < (- wx) [ set px (- wx) set vx (- vx) ]
    if py >  wy [ set py  wy  set vy (- vy) ]
    if py < (- wy) [ set py (- wy) set vy (- vy) ]
    set new-list lput (list px py ph ps vx vy) new-list
  ]
  set peak-list new-list
end 

to refresh-surface-heights
  ask patches with [pzcor = 0] [
    if my-node != nobody [
      ask my-node [
        let gp patch home-x home-y 0
        if gp != nobody [
          set zcor  [fit]    of gp * (max-pzcor - 1)
          set color [pcolor] of gp
        ]
      ]
    ]
  ]
  ask links [ set color [color] of end1 ]
end