Segregation

breed [ soldiers soldier ]
directed-link-breed [ commands command ]

soldiers-own [
  level ; level = 0: leaf, level = number-of-levels : root
  ethnic
  is-corrupt?
  is-happy?
  separation-energy ; based on ethnic differences
  sum-of-subordinates ; all levels down
  pay  ; normed to full pay of one unit per tick
]

globals [
  network-leavings
  network-changes
  ethnic-segregation-energy
  provided-pay-transfer
]

to setup-globals
  ;;ask patches [ set pcolor white ]
  set network-leavings 0
  set network-changes 0
  set ethnic-segregation-energy 0
  set provided-pay-transfer 0
end 

to startup
  if number-of-levels < 6 and number-of-leaf-soldiers < 2501 [ setup ]
end 

to setup
  clear-all
  setup-globals
  setup-world
  setup-soldiers
  reset-ticks
end 

to go
  go-soldiers
  tick
  if is-ready-to-stop? [ stop ]
end 

to-report is-ready-to-stop?
  report ( not any? soldiers with [ not is-happy?] )
end 

to setup-world
  ask patches [ set pcolor white ]
end 

to setup-soldiers
  let local-level 0
  let local-number 1
  while [ local-level < number-of-levels] [
    create-soldiers local-number [
      set level number-of-levels - local-level
      if local-level > 0
      [
        create-command-to one-of soldiers with [ is-next-higher-level? ]
      ]
    ]
  set local-number multiplicity-of-levels * local-number
  set local-level local-level + 1
  ]
  create-soldiers number-of-leaf-soldiers [
    set level 0
    create-command-to one-of soldiers with [ is-next-higher-level? ]
  ]
  ask soldiers [ setup-soldier ]
  update-network
end 

to setup-soldier
  set shape "person"
  setxy random-xcor random-ycor
  set ethnic random number-of-ethnics
  set is-corrupt? random-float 1.0 < fraction-of-corruption
  set is-happy? true
  update-soldier
end 

to update-soldier
  set size 1.5 * sqrt (level + 1)
  set color ethnic * 10 + 5
  ifelse is-officer?
  [ ifelse is-corrupt? [ set label (word level "*") ] [ set label (word level) ] ]
  [ if is-corrupt? [ set label "*" ]  ]
end 

to-report is-officer?  report level > 0 end

to-report is-head-officer? report level >= (number-of-levels - 1) end

to-report is-leaf? report level = 0 end

to-report is-root? report level = number-of-levels end

to-report is-in-structure? report any? my-out-commands end

to-report is-free? report not any? my-out-commands end

to-report is-next-higher-level? report level = [level] of myself + 1 end

to-report is-different-ethnic-in-command? report [ethnic] of end1 != [ethnic] of end2 end

to-report is-boss-corrupt? report [is-corrupt?] of end2 end

to update-network
  ask soldiers [
    set sum-of-subordinates 0
  ]
  ask soldiers with [ is-root? ] [
    walk-soldier-network
  ]
  update-separation-energy
  if optimize-layout [ layout-soldiers-network ]
end 

to update-separation-energy
  ask soldiers [
    let local-energy 0
    ask my-out-commands [
      ifelse is-different-ethnic-in-command?
      [ set local-energy local-energy + 1 ]
      [ set local-energy local-energy - 1 ]
    ]
    ask my-in-commands [
      ifelse is-different-ethnic-in-command?
      [ set local-energy local-energy + 1 ]
      [ set local-energy local-energy - 1 ]
    ]
    set separation-energy local-energy
  ]
  set ethnic-segregation-energy sum [separation-energy] of soldiers
end 

to walk-soldier-network
  let local-subordinates 0
  ask my-in-commands [
    ask end1 [ walk-soldier-network ]
    set local-subordinates local-subordinates + 1 + [sum-of-subordinates] of end1
  ]
  set sum-of-subordinates local-subordinates
end 

to go-soldiers
  ask soldiers with [ is-root? ] [
    set provided-pay-transfer (sum-of-subordinates + 1) * fraction-total-pay
    transfer-pay-soldier-network provided-pay-transfer
  ]
  set network-leavings 0
  set network-changes 0
  ask soldiers [
    ifelse is-free?
    [ if not is-root? [ move-free-soldier ] ]
    [
      ifelse is-leaf? and not is-happy?
      [ leave-the-network-soldier ]
      [ if not is-head-officer? and not is-happy? [ change-in-network-soldier ] ]
    ]
  ]
  update-network
end 

to move-free-soldier
  set heading random 360
  if can-move? 1 [ forward 1 ]
  if joining-probability > random-float 1.0 [ create-command-to one-of soldiers with [ is-next-higher-level? ] ]
end 

to leave-the-network-soldier
  set network-leavings network-leavings + 1
  ask my-out-commands [ die ]
end 

to change-in-network-soldier
  set network-changes network-changes + 1
  ask my-out-commands [die ]
  let new-command-soldier one-of soldiers with [ is-next-higher-level? ]
  if is-soldier? new-command-soldier  [ create-command-to new-command-soldier ]
end 

to layout-soldiers-network
  ask soldiers with [ is-root? ] [ layout-radial soldiers commands self ]
end 

to transfer-pay-soldier-network [ pay-transfer ]
  set pay pay - 1
  if is-corrupt? [ set pay pay - corruption-costs ]
  ifelse is-leaf?
  [ set pay pay + pay-transfer ]
  [
    ifelse is-corrupt?
    [ distribute-pay-corrupted pay-transfer ]
    [ distribute-pay-honestly pay-transfer ]
  ]
  set is-happy? not (pay < 0)
  if pay < 0 [ set pay 0 ]
end 

to distribute-pay-corrupted [pay-transfer]
  set pay pay + corruption-costs
  let local-pay-sum pay-transfer - corruption-costs
  ask my-in-commands [
    if not is-different-ethnic-in-command? [
      ask end1 [
        if is-corrupt? [
          let local-pay (sum-of-subordinates + 1) * (1 + corruption-costs)
          if local-pay > local-pay-sum [ set local-pay local-pay-sum ]
          set local-pay-sum local-pay-sum - local-pay
          transfer-pay-soldier-network local-pay
        ]
      ]
    ]
  ]
  ask my-in-commands [
    if not is-different-ethnic-in-command? [
      ask end1 [
        if not is-corrupt? [
          let local-pay (sum-of-subordinates + 1)
          if local-pay > local-pay-sum [ set local-pay local-pay-sum ]
          set local-pay-sum local-pay-sum - local-pay
          transfer-pay-soldier-network local-pay
        ]
      ]
    ]
  ]
  ask my-in-commands [
    if is-different-ethnic-in-command? [
      ask end1 [
        let local-pay (sum-of-subordinates + 1) * (1 - corruption-costs)
        if local-pay > local-pay-sum [ set local-pay local-pay-sum ]
        set local-pay-sum local-pay-sum - local-pay
        transfer-pay-soldier-network local-pay
      ]
    ]
  ]
  if local-pay-sum > 0 [ set pay pay + local-pay-sum ]
end 

to distribute-pay-honestly [pay-transfer]
  set pay pay + pay-transfer
  let local-payings 0
  let local-factor (pay-transfer / (sum-of-subordinates + 1))
  ask my-in-commands [
    ask end1 [
      let local-pay precision ((sum-of-subordinates + 1) * local-factor) 8
      set local-payings local-payings + local-pay
      transfer-pay-soldier-network local-pay
    ]
  ]
  set pay pay - local-payings
end 

to-report logarithmic-pays
  let local-list map ln filter [ [?1] -> ?1 > 0 ] ([pay] of soldiers)
  if empty? local-list [ set local-list (list -1 )]
  report local-list
end 

to-report satisfaction
  report 100 * count soldiers with [is-happy?] / count soldiers
end 

;;; ============ mouse procedures ======================================

to change-soldier-ethnic
  if mouse-inside? and mouse-down? [
    ask patch mouse-xcor mouse-ycor [
      ask soldiers in-radius 2 [
        ask min-one-of soldiers [distancexy mouse-xcor mouse-ycor] [
          show ethnic
          set ethnic (ethnic + 1) mod number-of-ethnics
          update-soldier
        ]
      ]
    ]
    display
    wait 1
  ]
end 

to change-soldier-corruption
  if mouse-inside? and mouse-down? [
    ask patch mouse-xcor mouse-ycor [
      ask soldiers in-radius 2 [
        ask min-one-of soldiers [distancexy mouse-xcor mouse-ycor] [
          set is-corrupt? not is-corrupt?
          update-soldier
        ]
      ]
    ]
    display
    wait 1
  ]
end