# CultranDejanet - cultural transmission on network

Model was written in NetLogo 5.1.0
•
Viewed 1346 times
•
Downloaded 152 times
•
Run 0 times

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

There are 12 versions of this model.

## Attached files

File | Type | Description | Last updated | |
---|---|---|---|---|

CultranDejanet - cultural transmission on network.png | preview | Preview for 'CultranDejanet - cultural transmission on network' | almost 11 years ago, by Marshall Abrams | Download |

This model does not have any ancestors.

This model does not have any descendants.