Party competition Ch8

;;____________________________
;
;;   SETUP AND HOUSEKEEPING
;;____________________________

breed [ parties party ]

globals [
  total-votes
  max-voteshare            ; largest vote share on any patch
  mean-voterx              ; mean voter x-coordinate
  mean-votery              ; mean voter y-coordinate
  
  cycle
  election                 ; election number

  mean-eccentricity        ; mean Euclidean distance of parties from (mean-voterx, mean-votery)
  largest-party            ; "who" of largest party
  voter-misery             ; mean quadratic Euclidean voter distance from closest party
  enp                      ; effective number of parties = 1/(sum of squared party vote shares)
  enr                      ; effective number of rules = 1/(sum of squared rule vote shares)
  
  rule-number              ; rule number
  rule-list                ; list of available decision rules
  rule-voteshare           ; list of votes shares won by the set of parties using each rule
  rule-pcount              ; number of parties using rule
  rule-eccent              ; mean eccentricity of parties using rule
  rule-fitness             ; list of updated fitnesses of the set of parties using each rule
]

parties-own [
  rule                      ; party's parameterized decision rule
  species                   ; party's decision rule species
  
                     ; decision rule parameters
  speed                     ; distance each party moves per tick
  comfort-kappa             ; comfort threshold - implement rule iff fitness below this
  neighborhood-eta          ; radius from party postion of local neighborhood
  
                     ; indicators
  mysize                    ; current party size
  old-size                  ; party's size previous tick
  old-x                     ; x-coordinate of my position at previous election
  old-y                     ; y-coordinate of my position at previous election
  age                       ; number of elections survived since birth
  fitness                   ; party's evolutionary fitness
  eccentricity              ; party's Euclidean distance from (mean-voterx, mean-votery)
  
                     ; rule-specific variables
  prey                      ; for predators:  party I am thinking of attacking
  best-x                    ; for explorers:  explored x-coordinate with highest vote share during campaign
  best-y                    ; for explorers:  explored y-coordinate with highest vote share during campaign
  best-size                 ; for explorers:  highest vote share of party during campaign
]

patches-own [
  votes                     ; number of voters on patch
  vote-share                ; proportion of total voters on patch
  closest-party             ; party with smallest Euclidean distance from patch
  misery                    ; quadratic distance from closest party, weighted by patch's vote share
]

to setup
  clear-all
  file-close  
    
  if (endogenous-birth = false) [set misery-alpha 0 set misery-beta 0]  
  
  if (birth-death-file = true) [
    if (file-exists? bd-file-name) [file-delete bd-file-name]
    file-open bd-file-name
  ]

  set rule-list (list 
      "S00000000a" "S00000000h" "S00000000o" "S00000000v" "S00000000ac"
      "S00000000b" "S00000000i" "S00000000p" "S00000000w" "S00000000ad"
      "S00000000c" "S00000000j" "S00000000q" "S00000000x" "S00000000ae"
      "S00000000d" "S00000000k" "S00000000r" "S00000000y" "S00000000af"
      "S00000000e" "S00000000l" "S00000000s" "S00000000z" "S00000000ag"
      "S00000000f" "S00000000m" "S00000000t" "S00000000aa" "S00000000ah"
      "S00000000g" "S00000000n" "S00000000u" "S00000000ab" "S00000000ai"
                  
      "A02500000a" "A05000000a" "A10000000a" "A20000000a" "A40000000a"
      "A02500000b" "A05000000b" "A10000000b" "A20000000b" "A40000000b"
      "A02500000c" "A05000000c" "A10000000c" "A20000000c" "A40000000c"
      "A02500000d" "A05000000d" "A10000000d" "A20000000d" "A40000000d"
      "A02500000e" "A05000000e" "A10000000e" "A20000000e" "A40000000e"
      "A02500000f" "A05000000f" "A10000000f" "A20000000f" "A40000000f"
      "A02500000g" "A05000000g" "A10000000g" "A20000000g" "A40000000g"
      
      "H02500600" "H05000600" "H10000600" "H20000600" "H40000600"
      "H02501100" "H05001100" "H10001100" "H20001100" "H40001100"
      "H02501600" "H05001600" "H10001600" "H20001600" "H40001600"
      "H02502100" "H05002100" "H10002100" "H20002100" "H40002100"
      "H02502600" "H05002600" "H10002600" "H20002600" "H40002600"
      "H02503100" "H05003100" "H10003100" "H20003100" "H40003100"
      "H02510000" "H05010000" "H10010000" "H20010000" "H40010000"
      
      "P02500600" "P05000600" "P10000600" "P20000600" "P40000600"
      "P02501100" "P05001100" "P10001100" "P20001100" "P40001100"
      "P02501600" "P05001600" "P10001600" "P20001600" "P40001600"
      "P02502100" "P05002100" "P10002100" "P20002100" "P40002100"
      "P02502600" "P05002600" "P10002600" "P20002600" "P40002600"
      "P02503100" "P05003100" "P10003100" "P20003100" "P40003100"
      "P02510000" "P05010000" "P10010000" "P20010000" "P40010000"
    
      "E00000602" "E00000604" "E00000606" "E00000608" "E00000610"
      "E00001102" "E00001104" "E00001106" "E00001108" "E00001110"
      "E00001602" "E00001604" "E00001606" "E00001608" "E00001610"
      "E00002102" "E00002104" "E00002106" "E00002108" "E00002110"
      "E00002602" "E00002604" "E00002606" "E00002608" "E00002610"
      "E00003102" "E00003104" "E00003106" "E00003108" "E00003110"
      "E00010002" "E00010004" "E00010006" "E00010008" "E00010010"
  )    
      ;; the 10-character rule names store the parameterization (genetic code) of each rule, as follows:
      ;; character 1 = rule species; chars 2-4 = speed (step size); chars 5-7 = comfort kappa; chars 8-10 = neighborhood eta
      ;; for example, H025012000 is a Hunter with speed = 0.25, kappa  = 0.12 and eta = 0.00  
      ;; (though eta is redundant for Hunters)
      ;; and E000100050 is an Explorer with speed = 0.00, kappa  = 1.00 and eta = 0.50 
      ;; (though speed is redundant for Explorers)
    
  set rule-number n-values length(rule-list) [?]
  set rule-voteshare n-values length(rule-list) [0]
  set rule-pcount n-values length(rule-list) [0]
  set rule-eccent n-values length(rule-list) [-1]
  set rule-fitness n-values length(rule-list) [1 / length(rule-list)]
    
  create-parties 1
  ask parties [set fitness 1 set heading random-float 360 jump random-float 30 set old-x xcor set old-y ycor  
               set age 0 set size 2 random-pick load-rule-parameters color-myself ]          
               ;; every run starts with a single party, which has a random position and rule picked from the rule list
          
  ask patches [ 
      let x1 (pxcor - x-mean1) / sd-1
      let y1 (pycor - y-mean1) / sd-1      
      set votes votes1 * exp (-0.5 * ( x1 ^ 2 + y1 ^ 2)) / (2 * pi * sd-1 ^ 2)
        ;; votes1, x_mean1, y_mean1, sd_1 = votes, mean and standard deviation of subpopulation 1, read from interface
        ;; each patch's votes arising from subpopulation 1 =  votes1 * bivariate normal density with mean1, sd_1, rho = 0
      
      if (votes2 > 0)[  
      let x2 (pxcor - x-mean2) / sd-2
      let y2 (pycor - y-mean2) / sd-2      
      set votes votes + votes2 * exp (-0.5 * ( x2 ^ 2 + y2 ^ 2)) / (2 * pi * sd-2 ^ 2)]
        ;; add votes to each patch from subpopulation 2, calculated as above
      
      if (votes3 > 0)[    
      let x3 (pxcor - x-mean3) / sd-3
      let y3 (pycor - y-mean3) / sd-3      
      set votes votes + votes3 * exp (-0.5 * ( x3 ^ 2 + y3 ^ 2)) / (2 * pi * sd-3 ^ 2)]
        ;; add votes to each patch from subpopulation 3, calculated as above
      ]
      
  set total-votes sum [ votes ] of patches
  type "Total votes at all locations = " type round(total-votes)     
        ;; add total of votes on all patches and output this to the command window
  
  ask patches [set vote-share votes / total-votes]      
      ;calculate each patch's vote share
  
  set mean-voterx sum [ pxcor * vote-share ] of patches
  set mean-votery sum [ pycor * vote-share ] of patches      
  type "   Mean voter x = " type round(mean-voterx) 
  type "   Mean voter y = " print round(mean-votery)
      ;; calculate center (mean) of voter distribution on each dimension as sum of (patch positions weighted by vote share)
      ;; output this to the command window 
  
  set max-voteshare max [ vote-share ] of patches
  ask patches [set pcolor scale-color gray vote-share 0 max-voteshare ] 
      ;; color patches red with density proportional to vote shares
  
  update-support
      ;; ask voters to choose closest party and calculate relative success of different rules
            
  update-rule-measures
end   

; ******* parameter setup buttons

to random-pop
   set sd-1 5 set sd-2 5 set y-mean1 0 set y-mean2 0
   set x-mean2 precision (random-float 15)  2    set x-mean1 0 - x-mean2              
   set votes1 500000 + random 166667  set votes2 1000000 - votes1
end 


;;____________________________
;
;;   PARTY DYNAMICS
;;____________________________

to stick
      ;; do nothing
end  

to aggregate
   if (mysize > 0) 
  [
     let xbar (sum [votes * pxcor] of patches with [closest-party = myself] / mysize)
     let ybar (sum [votes * pycor] of patches with [closest-party = myself] / mysize)
     let dist distancexy xbar ybar
     facexy xbar ybar
     ifelse (dist >= speed) [jump speed] [setxy xbar ybar]                            
   ]
      ;; identify xbar, ybar, the mean x, y positions of current party members
      ;; if you will not overshoot (xbar, ybar) face this and jump distance "speed" towards (xbar, ybar) 
      ;; maintain current position if zero supporters
end   

to hunt
  ifelse (mysize > old-size) [jump speed] [set heading heading + 90 + random-float 180  jump speed]
      ;; hunter makes a move of size speed in same direction as previous move if this increased party support
      ;; else reverses direction and makes a move of size speed in on a heading chosen from the 180 degree arc now faced 
  set old-size mysize 
      ;; remember party size for next cycle
end 

to sat-hunt
   ifelse (mysize / total-votes < comfort-kappa) [hunt] [stick]
end 
      ;; hunt if vote share is below comfort-kappa, else stand still

to predate
   let me mysize
   set prey min-one-of other parties with [mysize > me] [distance myself]
       ;; find the closest larger party
   if prey != nobody [
      let xdest [xcor] of prey
      let ydest [ycor] of prey                                                
      facexy xdest ydest
      let dist distancexy xdest ydest
      ifelse (dist >= speed) [jump speed] [setxy xdest ydest]
         ;; if you will not overshoot (xdest, ydest), jump "speed" towards this          
   ]
end 

to sat-predate
  ifelse (mysize / total-votes < comfort-kappa) [predate] [stick]
end 
      ;; predate if vote share is below comfort-kappa, else stand still

to explore
  if (mysize > best-size) [set best-x xcor set best-y ycor set best-size mysize]
      ;; NB voter support is updated AFTER all party adaptation is finished 
      ;; so the effect on party support of a move made the previous tick is assessed BEFORE adaptation this tick
      ;; if you found a position with more support than your previous best-size, update your best position
  ifelse (remainder cycle campaign-ticks != 0)           
     [setxy old-x old-y set heading random-float 360 jump random-float neighborhood-eta]
         ;; if there is no election, test a random position within eta of your position at the last election
     [if (best-size > old-size) [setxy best-x best-y]    
         ;; if there is an election, go to a better postion iff you have found one
          set best-size 0]  
              ;;after the election zero best-size, which stores the best size found in inter-electoral exploration
              ;;NB in update-party-measures, all parties update old-x, old-y and old-size after each election  
end  
      ;; Each NON-ELECTION tick, explorer tests random positions "close" to its position at the last election.
      ;; "Close" is defined by neighborhood-eta, the maximum number of patches a party can move between elections.
      ;; During exploration, Explorer updates best-x, best-y, best-size iff tested co-ordinates 
      ;; generate more support than the previous best-xy co-ordinates
      ;; Each ELECTION tick, explorer sets its position as the best location found in inter-electoral exploration,
      ;; Provided this yields more support than the previous electoral position

to sat-explore
  ifelse (mysize / total-votes < comfort-kappa) [explore] [stick]
end 
      ;; explore if vote share is below its comfort-kappa, else stand still
     

;;____________________________
;;
;;   MAIN CONTROL SUBROUTINES
;;____________________________

to update-support
  ask patches [set closest-party min-one-of parties [distance myself]]
      ;; patches find their closest party
  ask parties [set mysize sum [votes] of patches with [closest-party = myself]] 
      ;; each party sums the votes on patches for which it is the closest party
end 

to calculate-election-results
  set election election + 1
  update-party-measures
  update-rule-measures
  measure-enp
  measure-enr
  measure-eccentricity
  measure-misery
  party-death
  party-birth
end 

to update-party-measures                                   
  ask parties [
      set fitness fitness-alpha * fitness + (1 - fitness-alpha) * mysize / total-votes
                 ;; parties recursively update their fitness as: (alpha)*(previous fitness) + (1-alpha)*(current vote share) 
      set age age + 1 set old-x xcor set old-y ycor
  ]
end 

to update-rule-measures
   (foreach rule-number rule-list [ 
      set rule-voteshare replace-item ?1 rule-voteshare sum [mysize / total-votes] of parties with [rule = ?2]
          ;; calculate the current support level of all parties using each rule
        
      set rule-pcount replace-item ?1 rule-pcount count parties with [rule = ?2]
          ;; count the number of parties using each rule

      ifelse (sum [mysize] of parties with [rule = ?2] > 0) 
        [
        set rule-eccent replace-item ?1 rule-eccent mean [eccentricity] of parties with [rule = ?2] 
        ]
          ;;calculate the mean of eccentricity, policy loss and policy shift of all parties using each rule
          
        [ 
        set rule-eccent replace-item ?1 rule-eccent -1 
        ]
          ;;these measures have no meaning when no party uses a rule

        set rule-fitness replace-item ?1 rule-fitness ((rule-fitness-alpha * item ?1 rule-fitness) 
          + (1 - rule-fitness-alpha) * (item ?1 rule-voteshare) )
          ;; rule fitness is updated every election, as: (alpha)*previous-fitness + (1-alpha)*total-current-voteshare-of-parties-using-rule
          ;; NB rule rule-fitness-alpha may be quite different from the fitness-alpha that affects a single party
    ])  
end 

to measure-enp
  set enp (total-votes ^ 2) / (sum [mysize ^ 2] of parties)
     ;; calculate the enp of the system
end 

to measure-enr
  let stick-var ( sum(sublist rule-voteshare 0 35) ) ^ 2
  let agg1-var ( sum(sublist rule-voteshare 35 36)  +  sum(sublist rule-voteshare 40 41)  + sum(sublist rule-voteshare 45 46)  + 
   sum(sublist rule-voteshare 50 51)  +  sum(sublist rule-voteshare 55 56)  +  sum(sublist rule-voteshare 60 61)  + sum(sublist rule-voteshare 65 66) ) ^ 2
  
  let agg2-var ( sum(sublist rule-voteshare 36 37)  +  sum(sublist rule-voteshare 41 42)  + sum(sublist rule-voteshare 46 47)  + 
   sum(sublist rule-voteshare 51 52)  +  sum(sublist rule-voteshare 56 57)  +  sum(sublist rule-voteshare 61 62)  + sum(sublist rule-voteshare 66 67) ) ^ 2
  
  let agg3-var ( sum(sublist rule-voteshare 37 38)  +  sum(sublist rule-voteshare 42 43)  + sum(sublist rule-voteshare 47 48)  + 
   sum(sublist rule-voteshare 52 53)  +  sum(sublist rule-voteshare 57 58)  +  sum(sublist rule-voteshare 62 63)  + sum(sublist rule-voteshare 67 68) ) ^ 2
  
  let agg4-var ( sum(sublist rule-voteshare 38 39)  +  sum(sublist rule-voteshare 43 44)  + sum(sublist rule-voteshare 48 49)  + 
   sum(sublist rule-voteshare 53 54)  +  sum(sublist rule-voteshare 58 59)  +  sum(sublist rule-voteshare 63 64)  + sum(sublist rule-voteshare 68 69) ) ^ 2
  
  let agg5-var ( sum(sublist rule-voteshare 39 40)  +  sum(sublist rule-voteshare 44 45)  + sum(sublist rule-voteshare 49 50)  + 
   sum(sublist rule-voteshare 54 55)  +  sum(sublist rule-voteshare 59 60)  +  sum(sublist rule-voteshare 64 65)  + sum(sublist rule-voteshare 69 70) ) ^ 2
  
  let den stick-var + agg1-var + agg2-var + agg3-var + agg4-var + agg5-var 
  let other-rules sublist rule-voteshare 70 175
  
  foreach other-rules [ set den den + (? * ?) ]
  ifelse (den <= 0) [ set enr 0 ] [set enr 1 / den ]
     ;; calculate the effective-number-of-rules of the system     
end 

to measure-eccentricity
  ask parties [set eccentricity sqrt ((xcor - mean-voterx) ^ 2 + (ycor - mean-votery) ^ 2) / 10] 
     ;; calculate each party's eccentricity, its Euclidean distance from the center of the voter distribution
  set mean-eccentricity mean [eccentricity] of parties
     ;; calculate the mean eccentricity of all parties in the system
end 

to measure-misery
   ask patches [set misery misery-alpha * misery + (1 - misery-alpha) * ((distance closest-party ^ 2) / 100) * vote-share]
   set voter-misery sum [misery] of patches
      ;; patch misery is misery at t-1, updated by mean quadratic Euclidean distance of patch from closest party, 
      ;; weighted by patch vote share
      ;; mean voter "misery" is thus updated mean quadratic Euclidean distance of each voter from his/her closest party
end 

to party-death
   ask parties [if (fitness < survival-threshold and count parties > 2) 
       [
          if (birth-death-file = true) [
              file-write votes1 file-write x-mean1 file-write votes2 file-write x-mean2 file-write fitness-alpha file-write survival-threshold
              file-write campaign-ticks file-write misery-alpha file-write misery-beta
              file-write replicator-start file-write rule-fitness-alpha file-write invasion-prob 
              file-write election file-write "death" file-write rule file-write who 
              file-write precision xcor 4 file-write precision ycor 4 file-write "age" file-write age file-print ""
          ] 
          die 
          ask patches [set closest-party min-one-of parties [distance myself]]
       ]]   
                 ;; parties whose updated fitness falls below the survival threshold write out their data and die
                 ;; as long as there are at least two parties
end 

to party-birth
  ifelse (endogenous-birth = true)
    [ ask one-of patches with [distancexy 0 0 < 30]
      [ if (random-float 1 < (misery-beta * misery * 1000)) [sprout-parties 1 [initialize-party] ]]]
        ;; pick a random patch within three standard deviations of the origin.
        ;; the probability this patch sprouts a new party is proportional to (misery-beta)*(patch misery)
        ;; the greater patch misery, the higher the probability the patch sprouts a new party.
        ;; NB patch misery is scaled, in measure-misery above, to the share of all voters on the patch, 
        ;; this share maxes at 0.00159 for the (0,0) patch in a unimodal (0,10) distribution and is 0.0002 at patch (20,0) in this distibution
        ;; this explains the scaling up of the patch misery score by 1000 and the units of beta are thus sui generis to the simulation
        ;; the greater beta, however, the more sensitive are voters on a patch to a given level of misery.
        ;; new-born parties intially locate at the position of the "sprouting" patch.
    
    [ create-parties 1 [set heading random-float 360 jump random-float 30 initialize-party] ]
        ;; non-endogenous initial party locations take a random walk within 30 from the origin
end 

to initialize-party
  ifelse (count parties = 0) [set fitness 1] [set fitness 1 / count parties] 
  set heading random-float 360 set old-x xcor set old-y ycor set age 0 set size 1.5                                                               
  
  choose-rule                      
  load-rule-parameters
  color-myself
  
  if (birth-death-file = true) [
    file-write votes1 file-write x-mean1 file-write votes2 file-write x-mean2 file-write fitness-alpha file-write survival-threshold
    file-write campaign-ticks file-write misery-alpha file-write misery-beta
    file-write replicator-start file-write rule-fitness-alpha file-write invasion-prob 
    file-write election file-write "birth" file-write rule file-write who 
    file-write precision xcor 4 file-write precision ycor 4  file-print ""
  ]
     ;;Write out your starting data before handing control back to the observer
end 

to choose-rule                             ; this is the core imitator-mutator system 
  ifelse (election <= replicator-start)           
    [random-pick]                          ; use random pick until the election number > replicator start
    [                                      ; else use the replicator-mutator system
    let dice1 random-float 1
    ifelse (dice1 < invasion-prob)         ; with probability invasion-prob there is a random pick from the rule list
      [random-pick]                        ; thus setting invasion-prob = 1 there is always a random pick (tounament mode)
      [                                    ; else pick a rule from the list with a probability equal to each rule's updated fitness
        let rule-pick -1                   ; initialize the rule-pick variable to -1
        let dice2 random-float 1           ; let dice2 be a random real number between 0 and 1
        
        ; Increment the rule-pick variable by 1 while the combined fitness of all of the rules from the first rule (rule-number = 0)
        ; to the rule immediately proceeding the current rule (rule-number = ?) is less than dice2.  Once this conditions is no longer
        ; satisfied, i.e the combined fitness is equal to or greater than dice2, rule-pick is no longer incremented.
        foreach rule-number [
          if sum sublist rule-fitness 0 ? < dice2 [set rule-pick rule-pick + 1] 
        ]
        ; select the rule from the rule-list with rule-number = rule-pick 
        set rule item rule-pick rule-list                               
      ]
    ]
end 

to random-pick
    set rule one-of rule-list
    ;; randomly pick a rule from the rule list
end 

to load-rule-parameters                    ; set parameters of your decision rule by reading the relevant parts of your rule name
  set species first rule
  set speed (read-from-string substring rule 1 4) / 100
  set comfort-kappa (read-from-string substring rule 4 7) / 100
  set neighborhood-eta (read-from-string substring rule 7 9)  
end 

to color-myself
  if (species = "S") [set color yellow]
  if (species = "A") [set color lime]
  if (species = "H") [set color violet]
  if (species = "P") [set color red]
  if (species = "E") [set color blue]
end 

to adapt
  if (species = "S") [stick]
  if (species = "A") [aggregate]
  if (species = "H") [sat-hunt]
  if (species = "P") [sat-predate]
  if (species = "E") [sat-explore]
end 

to-report winning-rule
    report item (position (max rule-voteshare) rule-voteshare) rule-list
end 

to-report winning-rule-nbr
    report item (position (max rule-voteshare) rule-voteshare) rule-number
end 


;;____________________________
;
;;   MAIN CONTROL ROUTINE
;;____________________________

to go
  repeat campaign-ticks
  [
    set cycle cycle + 1
    ask parties [adapt]
    update-support
    if (remainder cycle campaign-ticks = 0 and cycle != 0) [calculate-election-results]
  ]
end