Moral Markets

;; This version current draft as of June 12, 2014
;;
;;

breed [agents agent]
undirected-link-breed [trades trade]

;; economic variables borrowed from "SugarScape"
agents-own [
  profession       ;; 1 = sugar grower and 0 = spice grower
  sugar 
  spice 
  sugarMetabolism 
  spiceMetabolism 
  MRS
  foresight 
  welfare
  
  display-strength
  status
  initial-color
  impartial-spectator
  self-command
  tolerance
  friend  ;; "friend" controls the "clustering" variable
  age
   ]

trades-own [sugarAmount spiceAmount price]

patches-own [ countdown harvest-ready ]

globals [
  showLinks? 
  grass-regrowth-time ;; rather than use a slider bar, I just set this to 50. If set much lower, the grass grows back quickly and the populations get so big the simulation slows down; mucher higher, all the turtles die.
  total-sugar-production
  total-spice-production
  total-production
  ]

to setup
  ca
  set grass-regrowth-time 50
  set showLinks? true
  ask patches [  
    set harvest-ready true
    set countdown random grass-regrowth-time
    set pcolor random 140
    ]
  create-agents 200 [
    setxy random-xcor random-ycor
    set profession one-of [1 0]
    set color random 140
    set initial-color color
    set impartial-spectator random 140
    set age random 100
    set self-command random-normal initial-self-command 10
    set tolerance random-normal initial-tolerance 3
    set sugar 100
    set spice 100
    set sugarMetabolism 1 + random 2
    set spiceMetabolism 1 + random 2
    set foresight random 4
    set MRS 1
    if not trading? [ set status one-of [ 1 1 1 1 1 2 2 2 2 3 3 3 4 4 5 ] ]
    set friend one-of turtles
    ]
    reset-ticks
end 

to go
  ask agents [ move ]
  if trading? [
    ask agents [
      set-welfareMRS 
      eat 
      farm 
      ifelse discriminating? 
      [ ifelse exceptions? 
        [ trade-with-prejudice-with-exceptions ]
        [ trade-with-prejudice ] 
        ] 
      [ trade-without-prejudice ]
      reproduce ]
    ask patches [ grow ]
  ] 
    
  if moralizing? [
    ask agents [
      update-impartial-spectator
      present-color
      make-friends ]
    ask patches [ display-social-norm ]
  ]

  if count agents < 2 [ stop ]
 ; if ticks = 3500 [ stop ]
    
  update-globals
  diffuse pcolor 1
  tick
end 

to move
  if trading? [ carefully [ set heading [heading] of turtles-here ] []  ]
  if clustering? [ carefully [ set heading [heading] of friend ] [] ]
  rt random 20 lt random 20
  fd 1
  set age age + 1
end 

;; MORALIZING PROCEDURES

;; when a group of turtles meets, they change the color of the patch 

to display-social-norm
  let community turtles in-radius norm-radius
  if any? community [
  set pcolor ( sum [display-strength] of community / sum [status] of community ) ]
end 

;; 

to update-impartial-spectator
    set impartial-spectator ( [pcolor] of patch-here + (impartial-spectator * age) ) / ( age + 1 )
    set age age + 1
    if trading? [ set-status ]
    set display-strength color * status
end 

to present-color
  ifelse abs (pcolor - initial-color) > self-command [set color initial-color ] [ set color impartial-spectator ] 
end 

to make-friends
  let same-neighbors nobody
  set same-neighbors other turtles-here with [ abs (color - [color] of myself) < tolerance ]
  if any? same-neighbors [ set friend one-of same-neighbors ]
end 
;; TRADING PROCEDURES
;;
;; turtles eat. if they run out of food they die.

to eat
  set sugar sugar - sugarMetabolism
  set spice spice - spiceMetabolism
  if sugar <= 0 [ die ] 
  if spice <= 0 [ die ] 
end 


;; if a patch is ready for harvest, all turtles on it will reap equally according to their profession

to farm
  if [harvest-ready] of patch-here = true [
    if [profession] of self = 1 [ 
      set sugar sugar + sugar-reap-rate * ( 1 + ( (70 - color) / 140 * specialization ) )
      set total-sugar-production total-sugar-production + sugar-reap-rate ]
    if [profession] of self = 0 [ 
      set spice spice + spice-reap-rate * ( 1 + ( (color - 70) / 140 * specialization ) )
      set total-spice-production total-spice-production + spice-reap-rate ]
    ask patch-here [ 
      set harvest-ready false 
      set countdown grass-regrowth-time] 
    ]
end 

;; turtles split themselves in half

to reproduce
  if random-float 100 < 2 [
    set sugar ( sugar / 2 )
    set spice ( spice / 2 )
    hatch 1 [
      set age 0
      ifelse education? 
      [ set tolerance [tolerance] of myself + random 2 - random 2
        set self-command [self-command] of myself + random 2 - random 2
        set initial-color [initial-color] of myself + random 20 - random 20 ]
      [ set profession one-of [ 0 1 ]
        set color random 140
        set initial-color color
        set impartial-spectator random 140
        set self-command random-normal initial-self-command 10
        set tolerance random-normal initial-tolerance 3 ]
      rt random 360 fd 1 ]
  ]
end 

;; turtles divide themselves by caste (inheritable)

to set-status
  if welfare > mean [ welfare ] of turtles [ set status 3 ]
  if welfare > mean [ welfare ] of turtles * 2 [ set status 4 ]
  if welfare > mean [ welfare ] of turtles * 5 [ set status 5 ]
  if welfare <= mean [ welfare ] of turtles [ set status 2 ]
  if welfare <= mean [ welfare ] of turtles / 2 [ set status 1 ]
end 
  
;; trade rule  

to trade-with-prejudice-with-exceptions
  let p 0
  let a self
  let as []
  let tSugar 0
  let tSpice 0
  let tsSugar 0
  let tsSpice 0
  let tWelfare 0
  let tsWelfare 0
  let x 0
  let y 0
  let traded? true
  ask neighbors4
    [
    ask agents-here [set as fput self as]
    ]
  if empty? as [stop]
  while [traded? = true]
    [
    set traded? false
    set as sort-by [random 2 = 0] as
    foreach as
      [
      if [MRS] of ? != [MRS] of a and ( abs ( [color] of ? - [impartial-spectator] of a ) < tolerance or abs ([status] of ? - [status] of a) >= policing-level or [profession] of ? = [profession] of a ) ; Check only agents with unequal MRS, similar color or unequal status
        [
        set x ([MRS] of a < [MRS] of ?) ; Record which MRS is initially higher
        set p sqrt([MRS] of a * [MRS] of ?) ; Set a price
        ifelse p >= 1
          [
          ifelse [MRS] of a < [MRS] of ?
            [
            set tSugar [sugar] of a - 1 set tSpice [spice] of a + p
            set tsSugar [sugar] of ? + 1 set tsSpice [spice] of ? - p
            ]
            [
            set tSugar [sugar] of a + 1 set tSpice [spice] of a - p
            set tsSugar [sugar] of ? - 1 set tsSpice [spice] of ? + p
            ]
          ]
          [
          ifelse [MRS] of a < [MRS] of ?
            [
            set tSugar [sugar] of a - (1 / p) set tSpice [spice] of a + 1
            set tsSugar [sugar] of ? + (1 / p) set tsSpice [spice] of ? - 1
            ]
            [
            set tSugar [sugar] of a + (1 / p) set tSpice [spice] of a - 1
            set tsSugar [sugar] of ? - (1 / p) set tsSpice [spice] of ? + 1
            ]
          ]
        if tSugar > 0 and tSpice > 0 and tsSugar > 0 and tsSpice > 0
          [
          set y (find-MRS tSugar [sugarMetabolism] of a tSpice [spiceMetabolism] of a [foresight] of a) < (find-MRS tsSugar [sugarMetabolism] of ? tsSpice [spiceMetabolism] of ? [foresight] of ?) ; Record which MRS is now higher
          set tWelfare find-welfare tSugar [sugarMetabolism] of a tSpice [spiceMetabolism] of a [foresight] of a
          set tsWelfare find-welfare tsSugar [sugarMetabolism] of ? tsSpice [spiceMetabolism] of ? [foresight] of ?
          if x = y and tWelfare > [welfare] of a and tsWelfare > [welfare] of ? ; If the trade does not corss the MRS over and benefits the welfare of both...
            [
            ask a [ set sugar tSugar ]
            ask a [ set spice tSpice ]
            ask ? [ set sugar tsSugar ]
            ask ? [ set spice tsSpice ]
            ask a [set-welfareMRS]
            ask ? [set-welfareMRS]
            create-trade-with ?
              [
              set price p ifelse p >= 1
                [
                set sugarAmount 1
                set spiceAmount p
                ]
                [
                set sugarAmount 1 / p
                set spiceAmount 1
                ]
              ifelse showLinks? = true [set hidden? false] [set hidden? true] set color [color] of ?
              ]
            set traded? true ; Loop continutes until no viable trades can be made
            ]
          ]
        ]
      ]
    ]
end 

;; trade rule  

to trade-with-prejudice
  let p 0
  let a self
  let as []
  let tSugar 0
  let tSpice 0
  let tsSugar 0
  let tsSpice 0
  let tWelfare 0
  let tsWelfare 0
  let x 0
  let y 0
  let traded? true
  ask neighbors4
    [
    ask agents-here [set as fput self as]
    ]
  if empty? as [stop]
  while [traded? = true]
    [
    set traded? false
    set as sort-by [random 2 = 0] as
    foreach as
      [
      if [MRS] of ? != [MRS] of a and abs ( [color] of ? - [impartial-spectator] of a ) < tolerance ; or abs ([status] of ? - [status] of a) >= policing-level or [profession] of ? = [profession] of a ) ; Check only agents with unequal MRS, similar color or unequal status
        [
        set x ([MRS] of a < [MRS] of ?) ; Record which MRS is initially higher
        set p sqrt([MRS] of a * [MRS] of ?) ; Set a price
        ifelse p >= 1
          [
          ifelse [MRS] of a < [MRS] of ?
            [
            set tSugar [sugar] of a - 1 set tSpice [spice] of a + p
            set tsSugar [sugar] of ? + 1 set tsSpice [spice] of ? - p
            ]
            [
            set tSugar [sugar] of a + 1 set tSpice [spice] of a - p
            set tsSugar [sugar] of ? - 1 set tsSpice [spice] of ? + p
            ]
          ]
          [
          ifelse [MRS] of a < [MRS] of ?
            [
            set tSugar [sugar] of a - (1 / p) set tSpice [spice] of a + 1
            set tsSugar [sugar] of ? + (1 / p) set tsSpice [spice] of ? - 1
            ]
            [
            set tSugar [sugar] of a + (1 / p) set tSpice [spice] of a - 1
            set tsSugar [sugar] of ? - (1 / p) set tsSpice [spice] of ? + 1
            ]
          ]
        if tSugar > 0 and tSpice > 0 and tsSugar > 0 and tsSpice > 0
          [
          set y (find-MRS tSugar [sugarMetabolism] of a tSpice [spiceMetabolism] of a [foresight] of a) < (find-MRS tsSugar [sugarMetabolism] of ? tsSpice [spiceMetabolism] of ? [foresight] of ?) ; Record which MRS is now higher
          set tWelfare find-welfare tSugar [sugarMetabolism] of a tSpice [spiceMetabolism] of a [foresight] of a
          set tsWelfare find-welfare tsSugar [sugarMetabolism] of ? tsSpice [spiceMetabolism] of ? [foresight] of ?
          if x = y and tWelfare > [welfare] of a and tsWelfare > [welfare] of ? ; If the trade does not corss the MRS over and benefits the welfare of both...
            [
            ask a [ set sugar tSugar ]
            ask a [ set spice tSpice ]
            ask ? [ set sugar tsSugar ]
            ask ? [ set spice tsSpice ]
            ask a [set-welfareMRS]
            ask ? [set-welfareMRS]
            create-trade-with ?
              [
              set price p ifelse p >= 1
                [
                set sugarAmount 1
                set spiceAmount p
                ]
                [
                set sugarAmount 1 / p
                set spiceAmount 1
                ]
              ifelse showLinks? = true [set hidden? false] [set hidden? true] set color [color] of ?
              ]
            set traded? true ; Loop continutes until no viable trades can be made
            ]
          ]
        ]
      ]
    ]
end 

;; trade without prejudice rule  

to trade-without-prejudice
  let p 0
  let a self
  let as []
  let tSugar 0
  let tSpice 0
  let tsSugar 0
  let tsSpice 0
  let tWelfare 0
  let tsWelfare 0
  let x 0
  let y 0
  let traded? true
  ask neighbors4
    [
    ask agents-here [set as fput self as]
    ]
  if empty? as [stop]
  while [traded? = true]
    [
    set traded? false
    set as sort-by [random 2 = 0] as
    foreach as
      [
      if [MRS] of ? != [MRS] of a ; Check only agents with unequal MRS
        [
        set x ([MRS] of a < [MRS] of ?) ; Record which MRS is initially higher
        set p sqrt([MRS] of a * [MRS] of ?) ; Set a price
        ifelse p >= 1
          [
          ifelse [MRS] of a < [MRS] of ?
            [
            set tSugar [sugar] of a - 1 set tSpice [spice] of a + p
            set tsSugar [sugar] of ? + 1 set tsSpice [spice] of ? - p
            ]
            [
            set tSugar [sugar] of a + 1 set tSpice [spice] of a - p
            set tsSugar [sugar] of ? - 1 set tsSpice [spice] of ? + p
            ]
          ]
          [
          ifelse [MRS] of a < [MRS] of ?
            [
            set tSugar [sugar] of a - (1 / p) set tSpice [spice] of a + 1
            set tsSugar [sugar] of ? + (1 / p) set tsSpice [spice] of ? - 1
            ]
            [
            set tSugar [sugar] of a + (1 / p) set tSpice [spice] of a - 1
            set tsSugar [sugar] of ? - (1 / p) set tsSpice [spice] of ? + 1
            ]
          ]
        if tSugar > 0 and tSpice > 0 and tsSugar > 0 and tsSpice > 0
          [
          set y (find-MRS tSugar [sugarMetabolism] of a tSpice [spiceMetabolism] of a [foresight] of a) < (find-MRS tsSugar [sugarMetabolism] of ? tsSpice [spiceMetabolism] of ? [foresight] of ?) ; Record which MRS is now higher
          set tWelfare find-welfare tSugar [sugarMetabolism] of a tSpice [spiceMetabolism] of a [foresight] of a
          set tsWelfare find-welfare tsSugar [sugarMetabolism] of ? tsSpice [spiceMetabolism] of ? [foresight] of ?
          if x = y and tWelfare > [welfare] of a and tsWelfare > [welfare] of ? ; If the trade does not corss the MRS over and benefits the welfare of both...
            [
            ask a [ set sugar tSugar ]
            ask a [ set spice tSpice ]
            ask ? [ set sugar tsSugar ]
            ask ? [ set spice tsSpice ]
            ask a [set-welfareMRS]
            ask ? [set-welfareMRS]
            create-trade-with ?
              [
              set price p ifelse p >= 1
                [
                set sugarAmount 1
                set spiceAmount p
                ]
                [
                set sugarAmount 1 / p
                set spiceAmount 1
                ]
              ifelse showLinks? = true [set hidden? false] [set hidden? true] set color [color] of ?
              ]
            set traded? true ; Loop continutes until no viable trades can be made
            ]
          ]
        ]
      ]
    ]
end 

to set-welfareMRS ; Utility to update agent welfare and MRS
  set welfare find-welfare sugar sugarMetabolism spice spiceMetabolism foresight
  set MRS find-MRS sugar sugarMetabolism spice spiceMetabolism foresight
end 

to grow
  if harvest-ready = false [
    set countdown countdown - 1
    if countdown <= 0
    [ set harvest-ready true ]
  ]
end 

to update-globals 
  set total-production total-production + total-sugar-production + total-spice-production
end 

to-report agent-volatility
  report standard-deviation [color] of turtles
end 

to-report ideal-volatility
  report standard-deviation [impartial-spectator] of turtles
end 

to-report norm-volatility 
  report standard-deviation [pcolor] of patches
end 

to-report trade-norm-volatility
  ifelse count trades > 1 
  [ report standard-deviation [color] of trades ]
  [ report count trades ]
end 

to-report total-wealth
  report sum [sugar] of turtles + sum [spice] of turtles
end 

to-report report-total-production
  report total-production
end 

to-report liquidity
  let available-supply 1
  let quantity-traded 0
  set available-supply ( sum [sugar] of turtles + sum [spice] of turtles ) - (sum [sugarMetabolism] of turtles + sum [spiceMetabolism] of turtles)
  set quantity-traded ( sum [sugarAmount] of trades + sum [spiceAmount] of trades )
  report ( quantity-traded / available-supply )
end 

to-report find-welfare [sug sugm spi spim for] ; Utility to find new welfare after a potential move;
  let m1 sugm
  let m2 spim
  let mt (sugm + spim)
  let w1 max list 0 (sug - (for) * sugm)
  let w2 max list 0 (spi - (for) * spim)
  report (w1 ^ (m1 / mt)) * (w2 ^ (m2 / mt))
end 

to-report find-MRS [sug sugm spi spim for] ; Utility to find new MRS after a potential trade 
  report (spi / spim) / (sug / sugm)
end