CultranDejanet - cultural transmission on network

CultranDejanet - cultural transmission on network preview image

1 collaborator

Default-person Marshall Abrams (Author)



Tagged by Marshall Abrams over 5 years ago


Tagged by Marshall Abrams over 5 years ago


Tagged by Marshall Abrams over 5 years ago

Visible to everyone | Changeable by the author
Model was written in NetLogo 5.1.0 • Viewed 922 times • Downloaded 72 times • Run 0 times
Download the 'CultranDejanet - cultural transmission on network' modelDownload this modelEmbed this model

Do you have questions or comments about this model? Ask them here! (You'll first need to log in.)

Info tab cannot be displayed because of an encoding error

Comments and Questions

Please start the discussion about this model! (You'll first need to log in.)

Click to Run Model

; 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. Center for Connected Learning and Computer-Based Modeling, Northwestern Institute on Complex Systems, Northwestern University, Evanston, IL.
; Wilensky, U. (2005). NetLogo Preferential Attachment model. Center for Connected Learning and Computer-Based Modeling, Northwestern University, Evanston, IL.
; Wilensky, U. (2005). NetLogo Small Worlds model. 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]
  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.

breed [sides side]
breed [persons person]

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



to setup
  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"

  ;output-print "net layed out"

  ;output-print "ticks reset"

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

; 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 ]

;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
;    ]
;  ]

; 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]

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

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

;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)
;  ]
;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
;  ]

; 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

; 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))]

; 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)

; 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))]

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

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

; start over with the same network

to reset-cultvars
  ask persons [setup-cultvar]
  set ready-to-stop false

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

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

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

;;; RUN

to go
  if (ready-to-stop) [
    set ready-to-stop false ; allows trying to restart, perhaps after altering parameters or network
  set stop-threshold 10 ^ stop-threshold-exponent ; allows changing this while running
  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

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

; 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]]]

; 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)

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

; 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

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

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

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)

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]]]

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)]

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


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
    ;output-subnet-properties selected-subnet
    set something-changed false

to select-region
  let something-changed false
  if mouse-down? [
    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
    ;output-subnet-properties selected-subnet
    set something-changed false
  ask sides [die]

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 ""]

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
  ;; if no turtles are selected, kill off
  ;; the selection rectangle and start over
  ;if not any? selected-subnet [ deselect ]

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

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 ]

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

;; 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


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

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

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

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


; 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]

; 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))

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)

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]

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

; 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

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

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

There are 12 versions of this model.

Uploaded by When Description Download
Marshall Abrams about 4 years ago Trivial--renamed variable for clarity Download this version
Marshall Abrams over 5 years ago Updated Info tab. Download this version
Marshall Abrams over 5 years ago Added Morris (2000) cohesion/cohesiveness calculation. Updated Info tab. Download this version
Marshall Abrams over 5 years ago minor changes to Info tab and Interface Download this version
Marshall Abrams over 5 years ago Added bounded confidence functionality. Added to Info tab. Download this version
Marshall Abrams over 5 years ago Clarified, added to Info tab. Added new transmission method averaging-transmission. Download this version
Marshall Abrams over 5 years ago Trivial change in layout of GUI elements. Download this version
Marshall Abrams over 5 years ago Made world smaller--still doesn't fit applet. Download this version
Marshall Abrams over 5 years ago Shrunk world further. Still didn't fit last time. Download this version
Marshall Abrams over 5 years ago Shrunk world to fit in app window. Download this version
Marshall Abrams over 5 years ago Edited comments to reflect this new, simplified version (I deleted the previous version so I could get a new image file associated with the new version.) Download this version
Marshall Abrams over 5 years ago Initial upload Download this version

Attached files

File Type Description Last updated
CultranDejanet - cultural transmission on network.png preview Preview for 'CultranDejanet - cultural transmission on network' over 5 years ago, by Marshall Abrams Download

This model does not have any ancestors.

This model does not have any descendants.