CultranDejanet - cultural transmission on network

; CultranDejanet.nlogo
; Marshall Abrams' model based partly on the following models from the built-in NetLogo models library:
;
; Stonedahl, F. and Wilensky, U. (2008). NetLogo Virus on a Network model. http://ccl.northwestern.edu/netlogo/models/VirusonaNetwork. Center for Connected Learning and Computer-Based Modeling, Northwestern Institute on Complex Systems, Northwestern University, Evanston, IL.
; Wilensky, U. (2005). NetLogo Preferential Attachment model. http://ccl.northwestern.edu/netlogo/models/PreferentialAttachment. Center for Connected Learning and Computer-Based Modeling, Northwestern University, Evanston, IL.
; Wilensky, U. (2005). NetLogo Small Worlds model. http://ccl.northwestern.edu/netlogo/models/SmallWorlds. Center for Connected Learning and Computer-Based Modeling, Northwestern University, Evanston, IL.
; Code not directly dependent on the above is released under the GNU Public License v 3.0 by Marshall Abrams.

; Globals set by user:
;   num-nodes
;   average-node-degree  ; avg links per node
;   trust-mean           ; mean activation passed to receiver
;   trust-stdev          ; standard deviation of normal distribution around mean
;   prob-of-transmission-bias ; allows transmission to be biased so that black or white is more likely to transmit
;   subnet1, subnet2

;extensions [matrix]
  
globals
[
  max-activn       ; maximum possible node activation, i.e. degree of confidence/commitment, prob of transmission, etc.
  min-activn       ; minimum possible node activation. negative to indicate confidence/commitment in the opposite cultvar.
  stop-threshold   ; if every node's activation change from previous tick is < this, go procedure automatically stops.
  ready-to-stop    ; transmit result of activn change test before update-activns proc to after it runs.
  netlogo-person-hue ; hue of nodes for use with variation using NetLogo built-in color-mapping scheme (vs. HSB or RGB).
  node-shape       ; default node shape
  link-color       ; obvious
  inter-link-subnets-color ; links that go from one subnet to another
  inter-node-shape ; nodes that link from one subnet to another
  background-color ; obvious
  clustering-coefficient               ; the clustering coefficient of the network; this is the
                                       ; average of clustering coefficients of all persons
  average-path-length                  ; average path length of the network
  infinity                             ; a very large number.
                                       ; used to denote distance between two persons which
                                       ; don't have a connected or unconnected path between them
  nodes-showing-numbers?                      ; true when we are displaying node degrees
  subnets-matrix                       ; matrix of subnet id's showing how they're layed out in the world
  
  communities  ; list of lists of nodes representing communities we've found so far
  selected-subnet ; subnet selected by user through GUI.  Maybe merge with preceding.
  selected-subnet-color
]

breed [sides side]
breed [persons person]

persons-own
[
  activation       ; ranges from min-activn to max-activn
  next-activation  ; allows parallel updating
  node-clustering-coefficient
  distance-from-other-persons   ;; list of distances of this node from other persons
  person-subnet
  index ; temporary variable for matrix configuration
  my-community ; temporary variable for cohesion reporting and community processing
]

links-own
[
  link-subnet
]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SETUP

to setup
  clear-all
  
  set ready-to-stop false
  
  set-default-shape sides "line"
  
  set max-activn 1
  set min-activn -1
  set stop-threshold 10 ^ stop-threshold-exponent
  
  set node-shape "circle" ; "square" "target" "face happy" "x" "leaf" "star""triangle" "face sad"
  set-default-shape persons node-shape
  
  ;set background-color 73 ; a blue-green
  set background-color 17 ; peach
  ;set background-color 58
  set netlogo-person-hue 0
  set selected-subnet-color red
  set link-color 123
  set inter-link-subnets-color yellow
  set inter-node-shape "square"
  set nodes-showing-numbers? false
  set communities []
  set selected-subnet no-turtles
  ;output-print "vars defined"

  ask patches [set pcolor background-color]
  
  ;output-print "patches colored"
  ;output-print (sentence "number-of-subnets = " number-of-subnets)

  let i 1
  ;while [i <= number-of-subnets] [
    create-nodes i
    ;output-print "nodes created"
    create-network i
    ;output-print "create-network has run"
    set i i + 1
  ;]
  ;output-print "net created"

  layout-network
  ;output-print "net layed out"

  reset-ticks
  ;output-print "ticks reset"
end 

to create-nodes [subnet]
  create-persons num-nodes
  [
    ; for visual reasons, we don't put any nodes *too* close to the edges
    setxy (random-xcor * 0.95) (random-ycor * 0.95)
    set person-subnet subnet
    setup-cultvar
  ]
end 

; mostly from "Virus on a Network"--see above
; Assign a random number of links randomly between pairs of nodes, making the total number of links such
; that the average node degree per node is that specified by the user.  But try to link to physically
; near nodes.  This is therefore not an Erdos-Renyi binomial/Possion network, since pairs of
; nodes don't have equal probability of being linked: Closer nodes are overwhelmingly more likely to be linked.
; [But maybe the degree distribution is neverthless typical for an E-R net?  Don't know.]
; Algorithm:
; Keep doing the following until you've created enough links that you have average-node-degree/2 per node:
; ( /2 since each link adds a degree to two nodes)
; Choose a random person, and create a link to the physically closest person to which it's not already linked.
; Since create-nodes gave persons random locations, the link is to a random person.
; (Note that these locations will be revised by initial-layout-network.  Their only function is to group persons
; randomly--in effect to randomly order persons by closeness to any given person.)

to create-network [subnet]
  let num-links (average-node-degree * num-nodes) / 2
  while [count links with [link-subnet = subnet] < num-links ][
    ask one-of persons with [person-subnet = subnet] [
      let choice (min-one-of (other persons with [person-subnet = subnet and not link-neighbor? myself]) [distance myself])
      if choice != nobody [ create-link-with choice [set link-subnet subnet]]
    ]
  ]
  ask links[ set color link-color ]
end 

;to inter-link-subnets [subn1 subn2]
;  if (subn1 != subn2) [
;    let nodes1 persons with [person-subnet = subn1] 
;    let nodes2 persons with [person-subnet = subn2]
;    if (any? nodes1 and any? nodes2) [
;      link-close-nodes inter-num-nodes nodes1 nodes2
;    ]
;  ]
;end


; A kind of kludgey but effective way to choose near nodes to link from two subnets
; Chooses n nodes each from two sets, and then creates links from every one on each side to every one on the other.
; If you just want a set of single links, call repeatedly with n=1.
; BUG: I think that if the chosen nodes are already linked, it silently does nothing.

to link-close-nodes [n nodes1 nodes2]
  let from-nodes1 min-n-of n nodes1 [distance one-of nodes2]      ; find the nearest nodes to an arbitrary member of the second set
  let from-nodes2 min-n-of n nodes2 [distance one-of from-nodes1] ; now find the nearest nodes to one of the ones in the first set
  ask from-nodes1 [create-links-with from-nodes2 [set color inter-link-subnets-color]]
  ask from-nodes1 [set shape inter-node-shape]
  ask from-nodes2 [set shape inter-node-shape]
end 

to layout-network
  initial-layout-network persons
  ; at this point, all of the subnets are on top of each other
  ;place-subnets
end 

to initial-layout-network [nodes]
  repeat 10 [
    layout-spring nodes links 
                  0.1 (world-width / sqrt num-nodes) 1 ; 3rd arg was 0.3 originally
  ]
end 

;to place-subnets
;  let subnet-lattice-dims (near-factors number-of-subnets)
;  let subnet-lattice-dim1 item 0 subnet-lattice-dims
;  let subnet-lattice-dim2 item 1 subnet-lattice-dims
;  
;  ; subnet-lattice-dim1 is always <= subnet-lattice-dim2. 
;  ; Here we choose whether there should be more subnets in the x or y dimension,
;  ; depending on whether the world is larger in one direction or the other. 
;  let x-subnet-lattice-dim "not yet"
;  let y-subnet-lattice-dim "not yet"
;  if-else max-pxcor < max-pycor [ 
;    set x-subnet-lattice-dim subnet-lattice-dim1
;    set y-subnet-lattice-dim subnet-lattice-dim2
;  ][
;    set x-subnet-lattice-dim subnet-lattice-dim2
;    set y-subnet-lattice-dim subnet-lattice-dim1
;  ]
;  
;  ; initialize global matrix that will summarize the layout.  note which is x and y: matrix rows are y, and cols are x.
;  set subnets-matrix matrix:make-constant y-subnet-lattice-dim x-subnet-lattice-dim 0
;
;  let x-subnet-lattice-unit 1 / x-subnet-lattice-dim
;  let y-subnet-lattice-unit 1 / y-subnet-lattice-dim
; 
;  stretch-network persons (.9 * x-subnet-lattice-unit) (.9 * y-subnet-lattice-unit)  ; resize the overlaid subnets as one. we'll split them up in a moment.
;
;  let x-shift-width (x-subnet-lattice-unit * (max-pxcor - min-pxcor))
;  let y-shift-width (y-subnet-lattice-unit * (max-pycor - min-pycor))
;  let j 0
;  let k 0
;  while [j < x-subnet-lattice-dim] [
;    while [k < y-subnet-lattice-dim] [
;      let subnet (k * x-subnet-lattice-dim) + j + 1
;      let xshift min-pxcor + ((j + .5) * x-shift-width)  ; subnets are laid out from left to right
;      let yshift max-pycor - ((k + .5) * y-shift-width)  ; and from top to bottom
;      shift-network-by-patches persons with [person-subnet = subnet] xshift yshift
;      matrix:set subnets-matrix k j subnet ; store name of this subnet in matrix location corresponding to location in world
;      set k (k + 1)
;    ]
;    set k 0
;    set j (j + 1)
;  ]
;end
;
;to link-near-subnets
;  let dims matrix:dimensions subnets-matrix
;  let rows item 0 dims
;  let cols item 1 dims
;
;  ; link horizontally
;  let row-index 0
;  let col-index 0
;  while [row-index < rows] [
;    while [col-index < cols - 1] [
;      let subn1 matrix:get subnets-matrix row-index col-index
;      let subn2 matrix:get subnets-matrix row-index (col-index + 1)
;      inter-link-subnets subn1 subn2
;      set col-index col-index + 1
;    ]
;    set row-index row-index + 1
;    set col-index 0
;  ]
;
;  ; link vertically
;  set row-index 0
;  set col-index 0
;  while [col-index < cols] [
;    while [row-index < rows - 1] [
;      let subn1 matrix:get subnets-matrix row-index col-index
;      let subn2 matrix:get subnets-matrix (row-index + 1) col-index
;      inter-link-subnets subn1 subn2
;      set row-index row-index + 1
;    ]
;    set col-index col-index + 1
;    set row-index 0
;  ]
;end

; Given a set of nodes, moves them toward/away from the origin 
; by multipling coordinates by amount,
; which should be in (0,1) for shrinking, or > 1 for expansion.

to resize-network [nodes ratio]
  stretch-network nodes ratio ratio
end 

; Given a set of nodes, stretches/shrinks in x and y dimensions by xratio and yratio, respectively.

to stretch-network [nodes xratio yratio]
  ask nodes [
    set xcor (clip-to-x-extrema (xratio * xcor))   ; note inner parens are essential
    set ycor (clip-to-y-extrema (yratio * ycor))]
end 

; Given a set of nodes, moves them xratio of distance to right/left edge 
; and yratio up to the top/bottom edge (depending on whether xratio, yratio are positive or negative)
; ASSUMES that origin is in center, and that world is right-left and up/down symmetric (but not necess that height and width are same).
;to shift-network [nodes xratio yratio]
;  shift-network-by-patches nodes
;                           (xratio * max-pxcor)
;                           (yratio * max-pycor)
;end

; Given a set of nodes, moves them xincrement, yincrement patches to the right and up, respectively.

to shift-network-by-patches [nodes xincrement yincrement]
   ask nodes [set xcor (clip-to-x-extrema (xcor + xincrement))  ; note inner parens are essential
              set ycor (clip-to-y-extrema (ycor + yincrement))]
end 

to-report clip-to-x-extrema [x]
  if x > max-pxcor [report max-pxcor]
  if x < min-pxcor [report min-pxcor]
  report x
end 

to-report clip-to-y-extrema [y]
  if y > max-pycor [report max-pycor]
  if y < min-pycor [report min-pycor]
  report y
end 

; start over with the same network

to reset-cultvars
  ask persons [setup-cultvar]
  clear-all-plots
  reset-ticks
  set ready-to-stop false
end 

to setup-cultvar
  set activation ((random-float 2) - 1)
  set color (activn-to-color activation)
end 

to toggle-degree-display
  if-else nodes-showing-numbers? [
    ask persons [set label ""]
    set nodes-showing-numbers? false
  ][
    ask persons [;set label sum [count link-neighbors] of link-neighbors
                 set label count link-neighbors 
                 set label-color ifelse-value (activation < .3) [black] [white]]
    set nodes-showing-numbers? true
  ]
end 

to toggle-who-display
  if-else nodes-showing-numbers? [
    ask persons [set label ""]
    set nodes-showing-numbers? false
  ][
    ask persons [set label who 
                 set label-color ifelse-value (activation < .3) [black] [white]]
    set nodes-showing-numbers? true
  ]
end 

 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; RUN

to go
  if (ready-to-stop) [
    set ready-to-stop false ; allows trying to restart, perhaps after altering parameters or network
    stop
  ]
  set stop-threshold 10 ^ stop-threshold-exponent ; allows changing this while running
  transmit-cultvars
  if (activns-settled) [set ready-to-stop true] ; compares activation with next-activation, so must run between transmit-cultvars and update-activns
  update-activns                                ; on the other hand, we do want to complete the activation updating process even if about to stop
  tick
end 

to-report activns-settled
  let max-change (max [abs (activation - next-activation)] of persons) ; must be called between communication and updating activation
  report stop-threshold > max-change
end 

; Transmit to any neighbor if probabilistic decide to transmit along that link.
; Probability is determined by activation value.

to transmit-cultvars
  ask persons
    [let message cultvar-to-message activation
     ask link-neighbors
       [if transmit-cultvar? message 
           [receive-cultvar message]]]
end 

; Decide probabilistically whether to report your cultvar to an individual:
; Roughly, the absolute value of your activation is treated as a probability: When bias = 0,
; a random number between 0 and 1 is selected, and if your absolute activation is above that,
; you transmit to the receiver.  When bias is nonzero, the sum of activation and bias is used instead.
; i.e. for large activations, if bias has the same sign as activation, it increases the probability of
; transmission; if they have opposite signs, the probability is reduced. The result may be
; > 1, in which case the effect is the same as if it were 1.  For small absolute activations,
; adding bias to the activation may flip the sign and produce a number whose absolute value is
; larger than the absolute value of the activation. [IS THAT OK?]

to-report transmit-cultvar? [activn]
  report (abs (activn + transmission-bias-prob)) > (random-float 1)
end 

to-report cultvar-to-message [activn]
  report activn
end 

; RECEIVE-CULTVAR
; Let an incoming cultvar affect strength of receiver's cultvar.
; If incoming-activn is positive, it will move receiver's activn in that direction;
; if negative, it will push in negative direction. However, the degree of push will
; be scaled by how far the current activation is from the extremum in the direction
; of push.  If the distance is large, the incoming-activn will have a large effect.
; If the distance is small, then incoming-activn's effect will be small, so that it's
; harder to get to the extrema. The method used to do this is often used to update
; nodes in connectionist/neural networks (e.g. Holyoak & Thagard, Cognitive Science 13, 295-355 (1989), p. 313). 

to receive-cultvar [incoming-activn]
  let candidate-activn 0
  if-else (abs (activation - incoming-activn)) > confidence-bound
    [set candidate-activn activation] ; if difference exceeds confidence bound, don't change current activn
    [if-else averaging-transmission
      [set candidate-activn new-activn-averaging-tran activation incoming-activn]
      [set candidate-activn new-activn-popco-tran activation incoming-activn]]
  set next-activation max (list min-activn (min (list max-activn candidate-activn))) ; failsafe: cap at extrema. need list op, not [] here
end 

to-report new-activn-averaging-tran [activn incoming-activn]
  report (incoming-activn * sender-activn-weight) + (activn * (1 - sender-activn-weight))
end 

to-report new-activn-popco-tran [activn incoming-activn]
  let effective-in-activn (sign-of incoming-activn) * (random-normal trust-mean trust-stdev)
  report (activn + (effective-in-activn * (dist-from-extremum effective-in-activn activn))) ; sign will come from incoming-activn; scaling factors are positive
end 

to-report dist-from-extremum [incoming-activn current-activn]
  let dist ifelse-value (incoming-activn <= 0)
                        [activation - min-activn]  ; if incoming-activn is pushes in negative direction, get current distance from the min
                        [max-activn - activation] ; if incoming activen pushes in positive direction, get distance from max
  report max (list 1 dist)
end 

to update-activns
  ask persons
    [set activation next-activation
     set color (activn-to-color activation)
     if nodes-showing-numbers? [
       set label-color ifelse-value (activation < .3) [black] [white]]]
end 

to make-activns-extreme
  ask persons
    [if-else activation >= 0
       [set activation 1
        set next-activation 1]
       [set activation -1
        set next-activation -1]
     set color (activn-to-color activation)]
end 

to reset-colors
  ask persons
    [set color (activn-to-color activation)
     set label ""]
end 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; USER SELECTION OF SUBNETS

to select-indivs
  let something-changed false

  if mouse-down? [
    let this-person min-one-of turtles [distancexy mouse-xcor mouse-ycor]
    if [distancexy mouse-xcor mouse-ycor] of this-person < 2 [
      if-else member? this-person selected-subnet [
        ask this-person [set selected-subnet other selected-subnet]
      ][
        set selected-subnet (turtle-set this-person selected-subnet)
      ]
      set something-changed true
    ]
  ]

  if something-changed [
    set communities (list [self] of selected-subnet) ; communities is supposed to be a list of lists of persons
    reset-subnet-colors
    ;output-subnet-properties selected-subnet
    set something-changed false
  ]
end 

to select-region
  let something-changed false
  
  if mouse-down? [
    handle-select
    set something-changed true
  ]
 
  if something-changed [
    set communities (list [self] of selected-subnet) ; communities is supposed to be a list of lists of persons
    reset-subnet-colors
    ;output-subnet-properties selected-subnet
    set something-changed false
  ]
 
  ask sides [die]
  display
end 

to reset-subnet-colors
  ask selected-subnet [set color selected-subnet-color]
  ask persons with [not member? self selected-subnet]
    [set color (activn-to-color activation)
     set label ""]
  display
end 

to handle-select
  ;; remember where the mouse pointer was located when
  ;; the user pressed the mouse button
  let old-x mouse-xcor
  let old-y mouse-ycor
  while [mouse-down?] [
    select old-x old-y mouse-xcor mouse-ycor            ; this is the line that should the nodes into selected-subnet
    ;; update the view, otherwise the user can't see
    ;; what's going on
    display
  ]
  ;; if no turtles are selected, kill off
  ;; the selection rectangle and start over
  ;if not any? selected-subnet [ deselect ]
end 

to deselect
  ask sides [ die ]
  set selected-subnet no-turtles
  reset-subnet-colors
  ;output-subnet-properties selected-subnet
end 

to select [x1 y1 x2 y2]   ;; x1 y1 is initial corner and x2 y2 is current corner
  ;deselect  ;; kill old selection rectangle
  make-side x1 y1 x2 y1
  make-side x1 y1 x1 y2
  make-side x1 y2 x2 y2
  make-side x2 y1 x2 y2
  set selected-subnet (turtle-set (persons with [selected? xcor ycor]) selected-subnet)
  ask selected-subnet [ set color red ]
end 

to make-side [x1 y1 x2 y2]
  ;; for each side, one thin line shape is created at the mid point of each segment
  ;; of the bounding box and scaled to the proper length
  create-sides 1 [
    set color black
    setxy (x1 + x2) / 2
          (y1 + y2) / 2
    facexy x1 y1
    set size 2 * distancexy x1 y1
  ]
end 

;; helper procedure that determines whether a point is
;; inside the selection rectangle

to-report selected? [x y]
  if not any? sides [ report false ]
  let y-max max [ycor] of sides   ;; largest ycor is where the top is
  let y-min min [ycor] of sides   ;; smallest ycor is where the bottom is
  let x-max max [xcor] of sides   ;; largest xcor is where the right side is
  let x-min min [xcor] of sides   ;; smallest xcor is where the left side is
  ;; report whether the input coordinates are within the rectangle
  report x >= x-min and x <= x-max and
         y >= y-min and y <= y-max
end 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; COMMUNITY MARKING AND COHESION CALCULATION

;to output-subnet-properties [community]
;  clear-output
;  output-type "cohesion: "
;  output-print community-cohesion community
;end

to-report node-cohesion [node community]
  let num-neighbs 0
  let num-community-neighbs 0
  ask node
    [set num-neighbs count link-neighbors
     set num-community-neighbs num-neighbors-in-community community]
  report num-community-neighbs / num-neighbs
end 

to-report num-neighbors-in-community [community]
  report count link-neighbors with [member? self community]
end 

to-report community-cohesion [community]
  report min [node-cohesion self community] of community
end 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; UTILITY PROCEDURES



; Finds middle-factors of n if there are factors > 1; otherwise returns middle-factors of n + 1.

to-report near-factors [n]
  if n = 1 [report [1 1]]  ; special case
  if n = 2 [report [2 1]]  ; special case
  let facs middle-factors n
  if-else (first facs) = 1 
    [report middle-factors (n + 1)]
    [report facs]
end 

; Finds the pair of factors of n whose product is n and whose values are closest in value to each other.

to-report middle-factors [n]
  report middle-factors-helper n (floor (sqrt n))
end 

to-report middle-factors-helper [n fac]
  ; if fac < 0, there's a bug, so let it error out in a stack overflow
  if fac = 0 [report (list 0 0)]
  if fac = 1 [report (list 1 n)]
  if (n mod fac) = 0 [report (list fac (n / fac))]
  report middle-factors-helper n (fac - 1)
end 

to-report activn-to-color [activn]
  let zero-one-activn (activn + 1) / 2
  let zero-ten-activn round (10 * zero-one-activn)
  let almost-color netlogo-person-hue + 10 - zero-ten-activn   ; change "+ 10 -" to "+" to map colors in NetLogo order, not reverse
  report ifelse-value (almost-color = 10) [9.9] [almost-color]
end 

to-report sign-of [x]
  report ifelse-value (x >= 0) [1] [-1]
end 

; NetLogo's standard-deviation and variance are sample functions, i.e. dividing 
; by n-1 rather than n.
; These functions undo the sample correction to give a proper population variance and 

to-report var [lis]
  let n length lis
  report (variance lis) * (n - 1) / n
end 

to-report stdev [lis]
  report sqrt (var lis)
end 

to yo
  let counts [] 
  foreach (sort turtles) [
    set counts lput ([count link-neighbors] of ?) counts
  ]
  show counts
end