Extinction and Evolution

globals[extinction-event-date global-organisms-list]

breed[organisms organism]

organisms-own[evolvability]

patches-own[saturated? blocked? survivor? painted? organisms-list mean-evolvability-here]

to setup
  ca
  set global-organisms-list []
  ask patches [set saturated? false set blocked? false set survivor? false set painted? false set organisms-list [] set mean-evolvability-here 0]
  put-organisms
  update-heat-map
  if programmed-extinction-events = "random uniform between X and Y" [set extinction-event-date ( X + random ( Y - X ))]
  reset-ticks
end 

to put-organisms
  create-organisms init-n-of-organisms [ht set evolvability init-evolvability]
end 

to go
  ask organisms [shift-niche]
  ask organisms [mutate]
  ask organisms [new-generation]
  if ticks mod ticks-to-update-heat-map = 0 [update-heat-map]
  optimize
  tick
  if programmed-extinction-events = "regular intervals X generations" [if ticks mod X = 0 [extinction-event]]
  if programmed-extinction-events = "random uniform between X and Y" [if ticks = extinction-event-date [extinction-event set extinction-event-date ( ticks + X + random ( Y - X )) ]]
  if ticks = n-generations-to-stop [stop]
end 

to optimize
  ; to save computational resources blocked  organisms (surrounded by saturated niches) are killed and their
  ; evolvabilities saved in a list (per patch) so they can be recovered after an extinction event
  ask organisms with [not blocked? and (count neighbors with [saturated?]) = 8] [
    set blocked? true
    set organisms-list fput evolvability organisms-list
    set global-organisms-list (sentence global-organisms-list organisms-list)
    die
  ]
end 

to extinction-event
  set global-organisms-list []
  ask organisms [
    set organisms-list fput evolvability organisms-list
    die
  ]
  ask n-of n-surviving-niches (patches with [pcolor != black]) [
    set survivor? true
    foreach organisms-list [ ?1 -> sprout-organisms 1 [ht set evolvability ?1] ]
  ]
  ask patches with [not survivor?] [set pcolor black]
  ask patches [set organisms-list [] set saturated? false set survivor? false set blocked? false set painted? false set mean-evolvability-here 0]
  ask organisms [
    set global-organisms-list (sentence global-organisms-list organisms-list)
  ]
end 

to update-heat-map
  ask patches with [any? organisms-here][set mean-evolvability-here (mean [evolvability] of organisms-here * 100)]
  ask patches with [not empty? organisms-list and not painted?][set mean-evolvability-here (mean organisms-list * 100) set painted? true]
  ask patches with [mean-evolvability-here > 0 ][set pcolor scale-color black mean-evolvability-here 0 9.9]
end 

to shift-niche
  let candidates neighbors with [not saturated?]
  if random-float 1 < evolvability and any? candidates [
    set saturated? false
    move-to one-of candidates
  ]
end 

to mutate
  if random-float 1 < prob-of-evolvability-mutation [set evolvability (evolvability + ((2 * random-float magnitude-of-evolvability-mutation) - magnitude-of-evolvability-mutation))]
end 

to new-generation
  repeat n-of-offspring [ifelse (count organisms-here) <= max-n-organisms-per-niche
    [hatch 1]
    [set saturated? true die]]
end