DiffusionOfLanguage

breed [ nodes node ]
nodes-own
[ 
  grammar
  grammar-bias
  spoken-val
]
globals [ 
  seed 
  initial-fraction-influenced-by-minority
  ]

to setup [ rseed ]
  ca
  set seed rseed
  random-seed seed
  with-local-randomness [  ask patches [set pcolor cyan - 3 ]  ]
  setup-nodes
  ifelse network-type = "two-communities"
  [
    ; set up community 1
    let nodesetA (nodes with [ who < (number-of-nodes / 2) ])
    setup-preferential-network nodesetA average-node-degree
    ; start all nodes with grammar 0
    ask nodesetA [ set grammar 0.0 ]
    ; If comA-start = "resistant", we start by having some node strongly
    ; biased towards grammar 0, and distribute negative bias outward from that node.
    ;  - This is as if there was already a 0 cascade that succeeded.
    ; If comA-start = "ripe", we start by having some node strongly biased
    ; toward grammar 1, and distribute positive bias outward from that node.
    ;  - In this case the community is "ripe" for a 1s cascade.
    setup-biases nodesetA (one-of nodesetA) (comA-start = "resistant")
    ask nodesetA [  set xcor (xcor / 2) - (world-width / 4)  ]    
    let nodesetB (nodes with [ who >= (number-of-nodes / 2) ])
    setup-preferential-network nodesetB average-node-degree
    ; start all nodes with grammar 1
    ask nodesetB [ set grammar 1.0 ]
    ; see note above about comA-start: comB start is similar.
    setup-biases nodesetB (one-of nodesetB) (comB-start != "resistant")
    ask nodesetB [ set xcor (xcor / 2) + (world-width / 4)  ]
    
    ; sort from low bias (against grammar 1) to high bias (in favor of grammar 1)
    let nodelistA sort-by [ [grammar-bias] of ?1 < [grammar-bias] of ?2 ] nodesetA
    let nodelistB sort-by [ [grammar-bias] of ?1 < [grammar-bias] of ?2 ] nodesetB
    if (comA-bridge-bias = 1)
    [ set nodelistA reverse nodelistA ]
    if (comB-bridge-bias = 1)
    [ set nodelistB reverse nodelistB ]
    
    repeat intercommunitylinks
    [
      ask (first nodelistA) [ create-link-with (first nodelistB) ]   
      set nodelistA but-first nodelistA
      set nodelistB but-first nodelistB
    ]
    
  ]
  [  
    if (network-type = "random")
    [ setup-random-network ]
    if (network-type = "spatial")
    [  setup-spatially-clustered-network ]
    if (network-type = "preferential")
    [  setup-preferential-network nodes average-node-degree ]
    
    ifelse (start-target = "influentials")
    [
      let sortednodes sort-by [[count link-neighbors] of ?1 > [count link-neighbors] of ?2 ] nodes
      repeat start-target-rank
       [ set sortednodes but-first sortednodes ]
      ask (turtle-set sublist sortednodes 0 num-start-with-G1) [ set grammar 1 ]
    ][
      ask n-of num-start-with-G1 nodes 
      [
        set grammar 1.0
      ]
    ]
    ; if there is more than one node from which the new grammar might spread, we pick one randomly
    let start-node max-one-of nodes [ grammar ]
    setup-biases nodes start-node false
  ]  
  with-local-randomness [
    set initial-fraction-influenced-by-minority sum [ count link-neighbors ] of nodes with [ grammar > 0.5 ] / (2 * count links )
    if visuals?
    [
      ask nodes 
      [ 
        color-by-grammar 
        size-by-degree
      ]
    ]
  ]
end 

to-report uniform-symmetric-bias-list [ len ]
  let bias-list n-values floor (len / 2) [ -0.5 + random-float 1.0 ]
  set bias-list sentence bias-list (map [ 0 - ? ] bias-list )
  if (length bias-list != len)
    [ set bias-list fput 0 bias-list ]
  report bias-list
end 

to-report random-normal-cutoff [ avg stdev xmin xmax ]
  let x random-normal avg stdev
  while [ x < xmin or x > xmax ] 
  [ set x random-normal avg stdev ]
  report x
end 

to-report normal-symmetric-bias-list [ len ]
  let stdev 10 ^ bias-stdev-log10
  let bias-list n-values floor (len / 2) [ random-normal-cutoff 0 stdev -0.5 0.5 ]
  set bias-list sentence bias-list (map [ 0 - ? ] bias-list )
  if (length bias-list != len)
    [ set bias-list fput 0 bias-list ]
  report bias-list
end 

to setup-nodes
  set-default-shape nodes "circle"
    
  create-nodes number-of-nodes
  [
    ; for visual reasons, we don't put any nodes *too* close to the edges
    setxy random-xcor * .95 random-ycor * .95
    set grammar 0.0
  ]
end 

to setup-biases [ thenodes start-node reverse-order? ]
  let bias-list false ; this will cause an error if bias-dist wasn't a valid choice.
  if (bias-dist = "flat")
  [ set bias-list n-values (count thenodes) [ global-bias ]  ]
  if (bias-dist = "uniform-symmetric")
  [ set bias-list uniform-symmetric-bias-list (count thenodes) ]
  if (bias-dist = "normal-symmetric")
  [ set bias-list normal-symmetric-bias-list (count thenodes) ]
  let nodelist [self] of thenodes
  if (bias-target = "influentials")
  [
    set bias-list sort bias-list
    set nodelist sort-by [[count link-neighbors] of ?1 < [count link-neighbors] of ?2 ] thenodes
  ]
  if (bias-target = "nearby")
  [
    set bias-list sort bias-list
    set nodelist sort-by [[__network-distance start-node links] of ?1 > [__network-distance start-node links] of ?2 ] thenodes
  ]
  if (reverse-order?) 
    [ set bias-list reverse bias-list ]
  foreach nodelist
  [
    ask ?
    [
      set grammar-bias first bias-list
      set bias-list but-first bias-list
    ]
  ]
end 

to setup-random-network
  ask nodes [ 
    ask nodes with [who > [who] of myself ]
    [
      if (random-float 1.0 < (average-node-degree / (number-of-nodes - 1) ))
      [ create-link-with myself ]
    ]
  ]
  if visuals?
  [
     repeat 40 [ do-network-layout nodes ]  
     rescale-network-to-world
  ]
end 

to setup-spatially-clustered-network
  let num-links (average-node-degree * number-of-nodes) / 2
  while [count links < num-links ]
  [
    ask one-of nodes
    [
      let choice (min-one-of ((other turtles) with [ not link-neighbor? myself ]) [ distance myself ])
      if (choice != nobody)
        [ create-link-with choice ]
    ]
  ]
  ; make the network look a little prettier
  if visuals?
  [
     repeat 10 [ do-network-layout nodes ]  
     rescale-network-to-world
  ]
end 

to setup-preferential-network [ thenodes avg-node-deg ]
  link-preferentially thenodes (avg-node-deg / 2)
  
  ; make the network look a little prettier
  if visuals?
  [
     with-local-randomness [
       layout-radial thenodes links (max-one-of thenodes [ count link-neighbors ] )
     ]
     repeat 10 [ do-network-layout thenodes ]  
     rescale-network-to-world
  ]
end 
; The parameter k is the number of edges to add at each step (e.g. k=1 builds a tree)
;  (if k has a fractional part, then we probabilistically add either floork aor floork + 1 edges)
;  k MUST be 2 or greater, otherwise there are errors!

to link-preferentially [ nodeset k ]
  let floork (floor k)
  let fractionk (k - floork)
  let nodelist sort nodeset
  let neighborchoicelist sublist nodelist 0 floork
  
  ask item floork nodelist
  [ 
    create-links-with turtle-set neighborchoicelist 
    set neighborchoicelist sentence (n-values floork [ self ] ) neighborchoicelist
  ]
  
  foreach sublist nodelist (floork + 1) (length nodelist)
  [
    ask ?
    [
      let tempneighborlist neighborchoicelist
      let mydegree floork + ifelse-value ((who > floork + 1) and (random-float 1.0 < fractionk)) [ 1 ] [ 0 ]
      repeat mydegree
      [
        let neighbor one-of tempneighborlist
        set tempneighborlist remove neighbor tempneighborlist 
        set neighborchoicelist fput neighbor neighborchoicelist
        create-link-with neighbor
      ]
      set neighborchoicelist sentence (n-values mydegree [ self ] ) neighborchoicelist
    ]
  ]
end 

to do-network-layout [ thenodes ]
   with-local-randomness [
     layout-spring thenodes links 0.3 0.8 * (world-width / (sqrt number-of-nodes)) 0.5
   ]
end 

to rescale-network-to-world
    with-local-randomness [
      let minx (min [ xcor ] of nodes)
      let miny (min [ ycor ] of nodes)
      let cw (max [ xcor ] of nodes) - minx
      let ch (max [ ycor ] of nodes) - miny
      ask nodes [ 
        set xcor (xcor - minx) / cw * (world-width - 1) + min-pxcor
        set ycor (ycor - miny) / ch * (world-height - 1) + min-pycor
      ]
    ]
end 

to go
  ask nodes [ speak ]
  ask nodes [ learn ]
;; this would be a different type of scheduling, where high degree nodes
;; are 'learning' much more quickly than the rest of the agents.
;; if we delete this stuff, also delete "learn-from" procedure down below!
;  ask links [
;    ask both-ends [
;      speak
;      learn-from other-end
;    ]
;  ]
  
  if visuals?
  [
    with-local-randomness [
      ask nodes [ color-by-grammar ]
    ]
    update-plot
  ]
  tick
end 

to size-by-degree
  set size 0.3 * sqrt (count link-neighbors + 1)
end 

to color-by-grammar
  set color scale-color yellow grammar 0 1.000000001
end 

to color-by-grammar-bias
  set color scale-color red grammar-bias -0.50000001 .500000001
end 

to-report sigmoid-func [ x nonlinearity repel-offset ]
  ; this is a sigmoid-type function [0,1] --> [0,1] with parameters:
  ;    x: input
  ;    nonlinearity: degree of nonlinearity (0 = linear, 100 = step function)
  ;    repel-offset: determines (repelling) fixed point: x' = 0.5 + repel-offset
  if nonlinearity = 100 [report ifelse-value (x < (0.5 + repel-offset)) [0.0] [1.0]]
  if nonlinearity = 0 [report x] ; linear!
  if (repel-offset < -0.5) [ set repel-offset -0.5 ]
  if (repel-offset > 0.5) [ set repel-offset 0.5 ]
  let a (nonlinearity / (100.0 - nonlinearity))
  let left-term (x * exp(a * (x - repel-offset)))
  let right-term ((1.0 - x) * exp(a * (1.0 - x + repel-offset)))
  report (left-term / (left-term + right-term))
end 

to speak
  let prob (sigmoid-func grammar categoricalness (0.0 - (global-bias + grammar-bias)))
  ifelse (probabilistic-speech?)
  [   set spoken-val ifelse-value (random-float 1.0 < prob) [ 1 ] [ 0 ]   ]
  [   set spoken-val prob   ]
end 

to learn
  if (not any? link-neighbors)
    [ stop ]
  let new-gram (learning-rate * mean [ spoken-val ] of link-neighbors) + (1 - learning-rate) * grammar 
  ifelse (new-gram > 1) 
    [ set new-gram 1 ]
    [ if (new-gram < 0) [ set new-gram 0 ] ]
  set grammar new-gram
end 
;; This procedure would be useful, if we decided to use the different update scheduling mentioned in
;; the GO procedure, wherein high degree nodes do a lot more speaking *AND* learning than other nodes.
;to learn-from [ othernode ]
;  let new-gram (learning-rate * [ spoken-val ] of othernode) + (1 - learning-rate) * grammar 
;  ifelse (new-gram > 1) 
;    [ set new-gram 1 ]
;    [ if (new-gram < 0) [ set new-gram 0 ] ]
;  set grammar new-gram
;end

to update-plot
  with-local-randomness [
    set-current-plot "Grammar State"
    set-current-plot-pen "state"
    plot mean [ grammar ] of nodes
    set-current-plot-pen "spoken"
    plot mean [ spoken-val ] of nodes
  ]
end 

to-report converged?
  ; if the chance of the out-lier node producing a minority-grammar
  ;    token in the next 10,000 time steps is safely less than 0.01%, then stop.
    if not any? nodes [ report false ]
    report ((min [ grammar ] of nodes) > (1 - 1E-8) or (max [ grammar ] of nodes) < 1E-8)
end 
;; The following several procedures are not necessary for the running of the model, but may be
;; useful for measuring the model, BehaviorSpace experiments, etc.

to-report cascaded?
  ifelse (converged? and mean [grammar] of nodes > 0.5) 
    [ report 1 ] 
    [ report 0 ]
end 

to-report cascaded90?
  ifelse (mean [grammar] of nodes > 0.9)
  [ report 1 ] 
  [ report 0 ]
end 

to-report communityA
  report nodes with [ who < (count nodes / 2) ]
end 

to-report communityB
  report nodes with [ who >= (count nodes / 2) ]
end 
;; The following procedures are not at all crucial to the model
;; I just used them to be able to repeat some interesting setups,
;; do some quick testing, etc.  
;; They should probably all be deleted at some point. ~Forrest 7/22/2008

to demo-setup
  clear-all
set number-of-nodes 100
set average-node-degree 3
set bias-dist "normal-symmetric"
set bias-stdev-log10 1
set probabilistic-speech? true
set network-type "preferential"
set categoricalness 50
set global-bias 0
set num-start-with-G1 25
set learning-rate 0.05
set visuals? true
setup 367808704
end 

to demo-setup2
; if we use robert's type of node interactions in each time step:
; seed that cascades, but only for high learning rate
setup 762758417 
set learning-rate 0.6 
end 
;to setup-one [theseed]
;clear-all
;setup theseed
;ask nodes [ set grammar 0 ]
;;ask max-n-of (new-grammar-fraction * number-of-nodes) nodes  [ count link-neighbors ] [ set grammar 1 ]
;ask max-n-of 1 nodes  [ count link-neighbors ] [ set grammar 1 ]
;;print mean [ count link-neighbors ] of nodes with [ grammar > 0.5 ]
;ask nodes [ color-by-grammar ]
;end

to demo-setup-one
set learning-rate 0.13
set visuals? true
set average-node-degree 3
set probabilistic-speech? true
set categoricalness 50
set bias-target "influentials"
set bias-dist "uniform-symmetric"
set number-of-nodes 200
set network-type "preferential"
set bias-stdev-log10 1
set global-bias 0
set num-start-with-G1 2
set start-target "influentials"
set start-target-rank 0
  setup 1324523410
;  for N=300, out of 1000 runs, these 3 seeds cascaded upwards:  
;  SEED: 6410918, 1256638123,  685548220
end 

to-report quicktest
  setup new-seed 
  repeat 1000 [ 
    go 
    if converged? [ report mean [grammar] of nodes]
  ]
  report mean [ grammar ] of nodes
end 

to demo-surprising-case
  set bias-stdev-log10 1
  set number-of-nodes 300
  set start-target "none"
  set network-type "preferential"
  set learning-rate 0.05
  set bias-target "nearby"
  set categoricalness 50
  set global-bias 0
  set bias-dist "normal-symmetric"
  set visuals? true
  set average-node-degree 4
  set num-start-with-G1 3
  set probabilistic-speech? true
  set start-target-rank 0
  setup 3543911878112519 
end