community-resilience

;; Monday 7th Jan 2013
;; Ball bouncing around in a box as a represtentation of a hazard
;; agents have individual resilience - time taken to recover and susceptibility
;; adaptive capacity - capablility to build barriers that can shelter from or deflect the ball
;; cooperation of community to build shared protection, recovery, hazard perception

;;extensions [profiler]
breed [balls ball]
breed [people person]
breed [barriers barrier]
people-own [ damage recovery susceptibility latest total total-here record cbas recent relocs] 
barriers-own [owner end-of-life times causals] 
balls-own [route]
globals [
  number-of-balls number-of-people 
  number-of-collisions 
  habitable outer 
  build-barriers
  relocation-rule
  barrier-lifespan
  mrad
  max-recovery
  min-recovery
  network-type
]

to setup-balls
  clear-all
  set number-of-balls 2
  set barrier-lifespan lifespan?
  if habitable? = "single" [  set habitable patches with [abs pxcor < 7 and abs pycor < 7]]
  if habitable? = "double" [  
    let lside patches with [abs pxcor < 7 and pxcor < 0 and abs pycor < 7]
    let rside patches with [abs pxcor < 7 and pxcor > 0 and abs pycor < 7] 
    set habitable (patch-set lside rside)
  ]
  if habitable? = "twin" [
    let lside patches with [abs pxcor < 9 and pxcor < 0 and abs pycor < 9 and pycor < 0]
    let rside patches with [abs pxcor < 9 and pxcor > 0 and abs pycor < 9 and pycor > 0]
    set habitable (patch-set lside rside)
  ]
   if habitable? = "four" [
    let b-l patches with [abs pxcor < 9 and pxcor < -2 and abs pycor < 9 and pycor < -2]
    let t-l patches with [abs pxcor < 9 and pxcor < -2 and abs pycor < 9 and pycor > 2]
    let t-r patches with [abs pxcor < 9 and pxcor > 2 and abs pycor < 9 and pycor > 2]
    let b-r patches with [abs pxcor < 9 and pxcor > 2 and abs pycor < 9 and pycor < -2]
    set habitable (patch-set b-l t-l t-r b-r)
  ]
  ask habitable [set pcolor 3]  ;; dark grey
  set outer patch-set filter [not member? ? habitable] sort patches
  ask outer [set pcolor black]  ;; dark grey
  print (word "set up habitable zone: " habitable?)
  ;; make green balls
  set-default-shape balls "circle"
  create-balls number-of-balls
    [ set color green
      setxy random-xcor random-ycor
      set route []
    ]
  ;; create permanent barriers - set end-of-life 0 
  set-default-shape barriers "barrier"
  create-barriers 8
  [
    set color 34 ;; use colours 34 to 39 (brown to white/black)
    move-to one-of outer with [not any? turtles-here]
    set times 0
    set causals 0
    set end-of-life 0
  ]  
  reset-ticks
end 

to setup
  setup-balls
  
  set build-barriers build-barriers?   ;; variables can be set or chosen via interface
  set relocation-rule relocation-rule?
  set network-type network-type?
  
  set number-of-people number-of-people?
  set number-of-collisions 0
  set mrad 3                           ;; farthest distance which people can "see" to monitor 
  set mrad chosen-mrad
  set max-recovery 50
  set min-recovery 10
  set max-recovery chosen-max-recovery
  set min-recovery chosen-min-recovery
  
  set-default-shape people "person"
  create-people number-of-people
    [ set color brown
      move-to one-of habitable with [not any? turtles-here]
      ;;setxy random-pxcor random-pycor                    ;; move to the centre of a random patch
      set damage 0                                         ;; damage to person increases with each incident 
      set recovery one-of (list min-recovery max-recovery) ;; time taken until recovery (with no intervention)
      set susceptibility random 2                          ;; 1 - susceptible / 0 - not susceptible
      set susceptibility 1     
      set latest 0                     ;; time of last occurance of damage
      set total 0                      ;; total damaging events
      set record []                    ;; record of the monitoring of a ball
      set cbas []                      ;; causal (links) from barriers to actors
      set total-here 0                 ;; damages received at the current location
      set relocs 0                     ;; number of times the agent has relocated
    ]
  create-network
end 

;; local network shows links with nearest neighbours (which need to be reset if relocate strategy is used)
;; random network can include many connections to distant agents

to create-network
  ifelse network-type = "Off" 
  [ print (word "No network created ")]
  [ print (word "created " network-type " network")]
  if network-type = "local" [
    ;; The agentset is built by finding all the agents with the highest value of reporter,
    ask people [create-links-with min-n-of 2 other people [distance myself]]
  ]
  if network-type = "random" [
    ask people [ create-links-with n-of 2 other people ]
  ]
end 

;; perturbation coming from outer edge heading towards habitable
;; does not destroy original barriers but will destroy constructed ones

to perturbate
  let chosen-ball one-of balls 
  print (word "peturbation will be caused by " chosen-ball)
  ask chosen-ball [
    let target one-of habitable
    let rnos (list random 2 random 2)
    ifelse item 0 rnos = 0 [
      set xcor [pxcor] of target 
      ifelse item 1 rnos = 1 [set ycor max-pycor ][set ycor min-pycor]
    ]
    [
      set ycor [pycor] of target
      ifelse item 1 rnos = 1 [set xcor max-pxcor ][set xcor min-pxcor]
    ]
    set heading towards target
    set size (size + 1)  
  ]
  ;; repeat for sufficient ticks to reach other edge of world
  repeat (2 * max-pxcor) [go]
  ask chosen-ball [
    move-to one-of outer
    set size (size - 1) 
    set heading random 360
  ] 
end 

;; if the ball is stuck start it again from outside of habitable

to dislodge
  ;; if the route caused a lot of collsions or TODO if there is a repeating pattern??
  ask balls [
    if length route > 10 [
      move-to one-of outer
      print word "dislodged " self
      set route []
    ]
    set route []  ;; reset for all cases   
  ]  
end 

;; clear barriers causing damages above a tolerance level, plus any on neighbours4 patches with same heading

to clear-barriers
  ;; check all barriers, obtain subset of damaging ones
  let adbs filter [[causals]  of ? > 0] sort barriers
  foreach adbs [
    if ? != nobody [
      if [causals] of ? > (tolerance * [times] of ?) 
      [
        let this-heading [heading] of ?
        ;; remove barriers on n4 patches with same heading 
        ask (barriers-on [neighbors4] of ?) with [heading = this-heading] [die]
        ;; then remove this barrier
        ask ? [die]  
      ] 
    ]
  ]
  ;; also, periodically, remove barriers in habitable at end-of-life
  ask barriers with [end-of-life < ticks and end-of-life > 0] [die]
end 

to go
  ;; periodic clean up, followed by mitigation build stage and relocate stage
  if ticks mod 50 = 0 [
    clear-barriers
    dislodge
    ask people [ if damage = 0 [ mitigate ]]
  ]
  ask people [
    ;; mitigation and recovery as two distinct processes
    if damage > 0 [ recover ]
  ]
  ask balls [
    bounce
    collide
    shield
    event 
    ;; ball reports status by setting own label
    ifelse length ball-report > 0 [set label ball-report] [set label ""]
    ;; add any barriers to the route
    if label != "" [
      set route sentence route filter is-barrier? label
    ]
  ]
  ;; monitor status of the ball by checking value of its label
  ask people [
    monitor
  ]
  ;; move ball on
  ask balls [
    fd 1 
  ]
  repaint
  tick 
end 

to-report aggregate-causals 
  let a-c n-values count barriers [0]
  let aggregate []
  let firsts []
  foreach sort people [set aggregate sentence aggregate [cbas] of ?] ;; with sentence, items are included in the result directly
  ;; not sure how this works (use of fput [] seems essential, and switching ?2 and ?1)
  set firsts reduce [fput (item 0 ?2) ?1] (fput [] aggregate)
  ;; occurences of each barrier
  let b-list sort-on [who] barriers
  let index 0
  foreach b-list [
    let occ occurrences ? firsts
    set a-c replace-item index a-c occ
    ask ? [set causals occ]    ;; update the barriers record of causals
    set index index + 1  
  ] 
  report a-c
end 

;; monitor a ball in the vicinity and record objects (barriers and people) it comes into contact with 

to monitor
  ifelse any? balls in-radius mrad 
  [
    if show-labels [set label "!!"]     ;; display exclamation mark
    ifelse record = []
    [
      ;; start a new record
      let ballfollowed one-of balls in-radius mrad
      set record (list ballfollowed)
      ;; use sentence in order to include elements directly
      if [label] of ballfollowed != "" [set record sentence record [label] of ballfollowed]
    ]
    [
       ;; check ball id, check label and add new item to record 
       let ballfollowed item 0 record
       if [label] of ballfollowed != "" 
       [
         set record sentence record [label] of ballfollowed
       ]
    ]
  ] 
  [
    ;; when there are no balls in sight check record and reset it
    if record != [] [
      query-record
      set record []
      set label "" 
    ]
  ] 
end 

;; detect if any barrier was struck followed by a person

to query-record
  ;; ignore dead barriers - when a turtle dies it turns into nobody -  filter these out
  let xcc map [? = nobody] record
  if (member? true xcc) = true [set record filter [? != nobody] record] 
  ;; if last item is barrier, ignore it. sublist args: first position (inclusive) and the second position (exclusive)
  if is-barrier? last record [set record sublist record 0 (length record - 1)]   
  ;; create logical map of barrier and find list item numbers
  let bmap map [is-barrier? ?] record    ;; map of barriers
  let bps positions-where-equal true bmap
  let recbar filter [[breed] of ? = barriers] record
  if length recbar > 0 [ 
    let lastp 0   ;; ball is included - first item of first seg
    foreach bps [
      let seg sublist record lastp ?
      set lastp ?
      ;; if the first item is a barrier then add causal
      if is-barrier? item 0 seg [
        foreach sublist seg 1 length seg [
          ;; print (word "causal link between " item 0 seg " and " ?)
          set cbas sentence cbas (list list item 0 seg ?)
        ]
      ]
    ]
    ;;last seg same code as above
    let fseg sublist record lastp length record
    ;; if the first item is a barrier then add causal
    if is-barrier? item 0 fseg [
        foreach sublist fseg 1 length fseg [
          ;; print (word "causal link between " item 0 fseg " and " ?)
          set cbas sentence cbas (list list item 0 fseg ?)
        ]
    ]
  ]
end 

;; how to retrieve one-of position in a list

to-report positions-where-equal [x xs]
  let indices n-values length xs [?]
  report filter [x = item ? xs] indices
end  

;; count the number of occurrences of an item in a list

to-report occurrences [x the-list]
  report reduce
    [ifelse-value (?2 = x) [?1 + 1] [?1]] (fput 0 the-list)
end 

to recover
  if damage > 0 and ticks - latest > recovery [ set damage damage - 1 ]
end 

;; mitigate is done only when damage is zero. 

to mitigate
  let print-on true
  ;; relocate - move to a less dangerous place - if own history shows more damage on that patch than that of neighbours - and if one available
  if relocation-rule != "Off" and random-float 1 < random-relocate [
    if total-here > 2 + (max [total-here] of link-neighbors) [ 
    ;; if total-here > 1.2 * (max [total-here] of link-neighbors) [ 
      let ev-plots 0
      ;; move a neighboring patch, i.e. move a distance one unit 
      if relocation-rule = "patch-neighbour" [set ev-plots patch-set filter [member? ? habitable] sort neighbors with [not any? turtles-here]] 
      ;; move to patch next to one of link-neighbours
      if relocation-rule = "link-neighbour" [set ev-plots patch-set filter [member? ? habitable] sort (patch-set [neighbors] of link-neighbors) with [not any? turtles-here] ]
      ;; move to random patch
      if relocation-rule = "random" [set ev-plots habitable with [not any? turtles-here]]
      if count ev-plots > 0
      [
        move-to one-of ev-plots   ;; move to one of available patches, leaving any barriers behind ..
        if print-on [print (word "Person-" who " moved, total-here: " total-here)]
        set total-here 0
        set relocs relocs + 1
      ] 
    ]  
  ]
  ;; build a barrier with a small probability
  if build-barriers = true and random-float 1 < random-build [
    let ba-plots patch-set sort neighbors with [not any? turtles-here]  ;; allow outside of habitable
    ;; let ba-plots patch-set filter [member? ? habitable] sort neighbors with [not any? turtles-here]
    if count ba-plots > 0
    [
      ;; careful with hatch (heading and label) - each new turtle inherits of all its variables from its parent. 
      hatch-barriers 1 [           ;; hatch because turtle context
        set color 34 ;
        move-to one-of ba-plots 
        set owner myself           ;; myself refers to a person
        if print-on [print (word "Person-" [who] of myself " built barrier")]
        set end-of-life ticks + barrier-lifespan
        set times 0
        set causals 0
        set label ""
        ;; check if neighbouring barrier, set same orientation
        ifelse any? barriers-on neighbors4
        [ set heading [heading] of one-of barriers-on neighbors4]
        [set heading random 360]
      ]
    ]
  ] 
end 

to collide
  ;; collide with another ball
  if any? other balls-here [
    set heading random 360 
  ]
end 

;; potentially damaging event can occur if the ball evades any shield  
;; TODO non-susceptibles may be susceptible to peturbations

to event
  ;; setting the radius to half the size of ball - makes a big difference in calculating contact with person or barrier 
  let bradius size / 2
  ask people in-radius bradius [
  ;; ask people in-radius size [
    if susceptibility = 1 [
      set damage damage + 1
      set latest ticks
      set total total + 1
      set total-here total-here + 1
      set number-of-collisions number-of-collisions + 1
    ]
    
  ]
end 

;; barriers can protect an area behind it from possible impact - can deflect or divert the ball 
;; TODO peturbation might have a percentage chance of destroying a barrier

to shield
  
  ;; setting the radius to half the size of ball - makes a big difference in calculating contact with person or barrier 
  ;;let bradius size / 2 
  ;;if any? barriers in-radius bradius [
  if any? barriers in-radius size [
    ifelse size = 2 [  ask barriers with [end-of-life > 0] in-radius size [die]] ;; peturbation causes (non-initial) barriers destruction
    [
      let b min-one-of barriers in-radius size [distance myself]
      ;;let b min-one-of barriers in-radius bradius [distance myself]
      ask b [set times times + 1]
      if barrier-action = "deflect"
      [
        ;; ball takes the heading of the barrier - with random adjustment
        set heading [heading] of b - 3 + random 7      
      ]
      if barrier-action = "deflect deterministic"
      [
        ;; ball takes the precise heading of the barrier
        set heading [heading] of b    
      ]
      if barrier-action = "deflect random"
      [ set heading random 360 ] ;; ball takes totally random deflection
    ]
  ]
end   

to bounce  ;; balls procedure
  ;; bounce off left and right walls
  if abs pxcor = max-pxcor
    [ set heading (- heading) fd 1]
  ;; bounce off top and bottom walls
  if abs pycor = max-pycor
    [ set heading (180 - heading) fd 1 ]
end 

to repaint
  ask people [
    set color 34 + damage
  ]
  ifelse show-links?
  [ask links [show-link]]
  [ask links [hide-link]]
end 

;; report any person (or barrier) the ball is in contact with

to-report ball-report
  let val []
  set val sort people in-radius size with [susceptibility = 1]
  if any? barriers-here [set val lput one-of barriers-here val]
  report val
end