Ethnocentrism Model - BehaviorSearch

;; agents have a probablity to reproduce and a strategy
turtles-own [ PTR cooperate-with-same? cooperate-with-different? ]

globals [
  ;; the remaining variables support the replication of published experiments
  meet                  ;; how many interactions occurred this turn
  meet-agg              ;; how many interactions occurred through the run
  last100meet           ;; meet for the last 100 ticks
  meetown               ;; what number of individuals met someone of their own color this turn
  meetown-agg           ;; what number of individuals met someone of their own color throughout the run
  last100meetown        ;; meetown for the last 100 ticks
  meetother             ;; what number of individuals met someone of a different color this turn
  meetother-agg         ;; what number of individuals met someone of a different color throughout the run
  last100meetother      ;; meetother for the last 100 ticks
  coopown               ;; how many interactions this turn were cooperating with the same color
  coopown-agg           ;; how many interactions throughout the run were cooperating with the same color
  last100coopown        ;; coopown for the last 100 ticks
  coopother             ;; how many interactions this turn were cooperating with a different color
  coopother-agg         ;; how many interactions throughout the run were cooperating with a different color
  defother              ;; how many interactions this turn were defecting with a different color
  defother-agg          ;; how many interactions throughout the run were defecting with a different color
  last100defother       ;; defother for the last 100 ticks
  last100cc             ;; how many cooperate-cooperate genotypes have there been in the last 100 ticks
  last100cd             ;; how many cooperate-defect genotypes have there been in the last 100 ticks
  last100dc             ;; how many defect-cooperate genotypes have there been in the last 100 ticks
  last100dd             ;; how many defect-defect genotypes have there been in the last 100 ticks
  last100consist-ethno  ;; how many interactions consistent with ethnocentrism in the last 100 ticks
  last100coop           ;; how many interactions have been cooperation in the last 100 ticks
]

to-report current-altruist-fraction
  ifelse (not any? turtles)
    [ report 0 ]
    [ report (count turtles with [cooperate-with-same? and cooperate-with-different?]) / (count turtles) ]
end 

to setup-empty
  clear-all
  ;; initialize all the variables
  set meetown 0
  set meetown-agg 0
  set meet 0
  set meet-agg 0
  set coopown 0
  set coopown-agg 0
  set defother 0
  set defother-agg 0
  set meetother 0
  set meetother-agg 0
  set coopother 0
  set coopother-agg 0
  set last100dd []
  set last100cd []
  set last100cc []
  set last100dc []
  set last100coopown []
  set last100defother []
  set last100consist-ethno []
  set last100meetown []
  set last100meetother []
  set last100meet []
  set last100coop []
  reset-ticks
end 


;; creates a world with an agent on each patch

to setup-full
  setup-empty
  ask patches [ create-turtle ]
end 

;; creates a new agent in the world

to create-turtle  ;; patch procedure
  sprout 1 [
    set color random-color
    ;; determine the strategy for interacting with someone of the same color
    set cooperate-with-same? (random-float 1.0 < immigrant-chance-cooperate-with-same)
    ;; determine the strategy for interacting with someone of a different color
    set cooperate-with-different? (random-float 1.0 < immigrant-chance-cooperate-with-different)
    ;; change the shape of the agent on the basis of the strategy
    update-shape
  ]
end 

to-report random-color
  report one-of [red blue yellow green]
end 

;; this is used to clear stats that change between each tick

to clear-stats
  set meetown 0
  set meet 0
  set coopown 0
  set defother 0
  set meetother 0
  set coopother 0
end 

;; the main routine

to go
  clear-stats     ;; clear the turn based stats
  immigrate       ;; new agents immigrate into the world

  ;; reset the probability to reproduce
  ask turtles [ set PTR initial-PTR ]

  ;; have all of the agents interact with other agents if they can
  ask turtles [ interact ]
  ;; now they reproduce
  ask turtles [ reproduce ]
  death           ;; kill some of the agents
  if visuals? [
    update-stats    ;; update the stats for the aggregate and last 100 ticks
  ]
  tick
end 

;; random individuals enter the world on empty cells

to immigrate
  let empty-patches patches with [not any? turtles-here]
  ;; we can't have more immigrants than there are empty patches
  let how-many min list immigrants-per-day (count empty-patches)
  ask n-of how-many empty-patches [ create-turtle ]
end 

to interact  ;; turtle procedure

  ;; interact with Von Neumann neighborhood
  ask turtles-on neighbors4 [
    ;; the commands inside the ASK are written from the point of view
    ;; of the agent being interacted with.  To refer back to the agent
    ;; that initiated the interaction, we use the MYSELF primitive.
    set meet meet + 1
    set meet-agg meet-agg + 1
    ;; do one thing if the individual interacting is the same color as me
    if color = [color] of myself [
      ;; record the fact the agent met someone of the own color
      set meetown meetown + 1
      set meetown-agg meetown-agg + 1
      ;; if I cooperate then I reduce my PTR and increase my neighbors
      if [cooperate-with-same?] of myself [
        set coopown coopown + 1
        set coopown-agg coopown-agg + 1
        ask myself [ set PTR PTR - cost-of-giving ]
        set PTR PTR + gain-of-receiving
      ]
    ]
    ;; if we are different colors we take a different strategy
    if color != [color] of myself [
      ;; record stats on encounters
      set meetother meetother + 1
      set meetother-agg meetother-agg + 1
      ;; if we cooperate with different colors then reduce our PTR and increase our neighbors
      ifelse [cooperate-with-different?] of myself [
        set coopother coopother + 1
        set coopother-agg coopother-agg + 1
        ask myself [ set PTR PTR - cost-of-giving ]
        set PTR PTR + gain-of-receiving
      ]
      [
        set defother defother + 1
        set defother-agg defother-agg + 1
      ]
    ]
  ]
end 

;; use PTR to determine if the agent gets to reproduce

to reproduce  ;; turtle procedure
  ;; if a random variable is less than the PTR the agent can reproduce
  if random-float 1.0 < PTR [
    ;; find an empty location to reproduce into
    let destination one-of neighbors4 with [not any? turtles-here]
    if destination != nobody [
      ;; if the location exists hatch a copy of the current turtle in the new location
      ;;  but mutate the child
      hatch 1 [
        move-to destination
        mutate
      ]
    ]
  ]
end 

;; modify the children of agents according to the mutation rate

to mutate  ;; turtle procedure
  ;; mutate the color
  if random-float 1.0 < mutation-rate [
    let old-color color
    while [color = old-color]
      [ set color random-color ]
  ]
  ;; mutate the strategy flags;
  ;; use NOT to toggle the flag
  if random-float 1.0 < mutation-rate [
    set cooperate-with-same? not cooperate-with-same?
  ]
  if random-float 1.0 < mutation-rate [
    set cooperate-with-different? not cooperate-with-different?
  ]
  ;; make sure the shape of the agent reflects its strategy
  update-shape
end 

to death
  ;; check to see if a random variable is less than the death rate for each agent
  ask turtles [
    if random-float 1.0 < death-rate [ die ]
  ]
end 

;; make sure the shape matches the strategy

to update-shape
  ;; if the agent cooperates with same they are a circle
  ifelse cooperate-with-same? [
    ifelse cooperate-with-different?
      [ set shape "circle" ]    ;; filled in circle (altruist)
      [ set shape "circle 2" ]  ;; empty circle (ethnocentric)
  ]
  ;; if the agent doesn't cooperate with same they are a square
  [
    ifelse cooperate-with-different?
      [ set shape "square" ]    ;; filled in square (cosmopolitan)
      [ set shape "square 2" ]  ;; empty square (egoist)
  ]
end 

;; this routine calculates a moving average of some stats over the last 100 ticks

to update-stats
  set last100dd        shorten lput (count turtles with [shape = "square 2"]) last100dd
  set last100cc        shorten lput (count turtles with [shape = "circle"]) last100cc
  set last100cd        shorten lput (count turtles with [shape = "circle 2"]) last100cd
  set last100dc        shorten lput (count turtles with [shape = "square"]) last100dc
  set last100coopown   shorten lput coopown last100coopown
  set last100defother  shorten lput defother last100defother
  set last100meetown   shorten lput meetown last100meetown
  set last100coop      shorten lput (coopown + coopother) last100coop
  set last100meet      shorten lput meet last100meet
  set last100meetother shorten lput meetother last100meetother
end 

;; this is used to keep all of the last100 lists the right length

to-report shorten [the-list]
  ifelse length the-list > 100
    [ report butfirst the-list ]
    [ report the-list ]
end 

;; these are used in the BehaviorSpace experiments

to-report meetown-percent
  report meetown / max list 1 meet
end 

to-report meetown-agg-percent
  report meetown-agg / max list 1 meet-agg
end 

to-report coopown-percent
  report coopown / max list 1 meetown
end 

to-report coopown-agg-percent
  report coopown-agg / max list 1 meetown-agg
end 

to-report defother-percent
  report defother / max list 1 meetother
end 

to-report defother-agg-percent
  report defother-agg / max list 1 meetother-agg
end 

to-report consist-ethno-percent
  report (defother + coopown) / (max list 1 meet )
end 

to-report consist-ethno-agg-percent
  report (defother-agg + coopown-agg) / (max list 1 meet-agg )
end 

to-report coop-percent
  report (coopown + coopother) / (max list 1 meet )
end 

to-report coop-agg-percent
  report (coopown-agg + coopother-agg) / (max list 1 meet-agg)
end 

to-report cc-count
  report sum last100cc / max list 1 length last100cc
end 

to-report cd-count
  report sum last100cd / max list 1 length last100cd
end 

to-report dc-count
  report sum last100dc / max list 1 length last100dc
end 

to-report dd-count
  report sum last100dd / max list 1 length last100dd
end 

to-report cc-percent
  report cc-count / (max list 1 (cc-count + cd-count + dc-count + dd-count))
end 

to-report cd-percent
  report cd-count / (max list 1 (cc-count + cd-count + dc-count + dd-count))
end 

to-report dc-percent
  report dc-count / (max list 1 (cc-count + cd-count + dc-count + dd-count))
end 

to-report dd-percent
  report dd-count / (max list 1 (cc-count + cd-count + dc-count + dd-count))
end 

to-report last100coopown-percent
  report sum last100coopown / max list 1 sum last100meetown
end 

to-report last100defother-percent
  report sum last100defother / max list 1 sum last100meetother
end 

to-report last100consist-ethno-percent
  report (sum last100defother + sum last100coopown) / max list 1 sum last100meet
end 

to-report last100meetown-percent
  report sum last100meetown / max list 1 sum last100meet
end 

to-report last100coop-percent
  report sum last100coop / max list 1 sum last100meet
end 



; Copyright 2003 Uri Wilensky.
; See Info tab for full copyright and license.