Modelling
Belief
Change in a Population using Explanatory Coherence
powered by NetLogo
view/download model file: ACS model -v2.2.nlogo
This is a model of mutual social influence of beliefs based upon Thagard's theory of explanatory coherence.
In this model there are a fixed number of represented beliefs, each of which are either held or not by each agent. These are conceived of existing against a background of a large set of (unrepresented) shared beliefs. These beliefs are to different extents coherent with each other – this is modelled using a coherence function from possible sets of core beliefs to [-1,1]. The social influence is achieved through gaining of a belief across a social link. Beliefs can be lost by being dropped from an agent's store. Both of these processes happen with a probability related to the change in coherence that would result in an agent's belief store. A resulting measured “opinion†can be retrieved in a number of ways, here as a weighted sum of a pattern of the core beliefs – opinion is thus an outcome and not directly processed by agents.
This model suggests hypotheses about group opinion dynamics that differ from that of many established models.
A fixed network of agents is formed, based on the number of agents, number of arcs per agent and the topology selected. The network is fixed.
Agents are assigned one (or one of two) coherency functions, from the setting.
Agents are randomly assigned each of the atomic set of beliefs (as determined by the parameter number of beliefs) with the probability set.
Each simulation tick:
for each node:
Pick a current belief,
caluculate the change in coherency if this belief was
forgotten,
the probability of this happening is linearly related to this.
for each link:
Pick one end of the link,
pick a belief from that nodes, belief,
caluculate the change in coherency if this belief was copied
to the other node
(from the point of view of the receiving node),
the probability of this happening is linearly related to this.
The world shows the nodes and thier links. The colour is an indication of the atomic beliefs held (only up to the first three).
Prevalence of Beliefs shows the number of occurences of the atomic beliefs in the population each one as a different colour (the first three being yelow, blue red, so as to be consistent with the world view.
The “Hamming distance” is the number of atomic beliefs on which two nodes differ, there are a number of histograms and charts show statistics on this.
The “opinions” are generated from the set of basic beliefs that nodes hold, give by the function specified in “Opinion-Fn-name”. The opinions do not play a part in the dynamics but are an epiphenomena of the belief dynamics.
There has been a stream of opinion-dynamics models in socio-physics and social simulation, going back to [5]. Early models were based on the standard Ising model with each node having a binary vector or opinion [6], [15]. Later [3] and [14] introduced a model with a continuous opinion, based upon the principle that nodes with similar opinions will become more similar if they interact. These models were based upon the random interaction of its components. [4] summarises some of the many results in this field and also looks at the different behaviour that comes from interaction within a regular lattice. The model presented here attempts to make a step towards a more psychologically plausible model where there is a belief structure, that is where the beliefs a node has determines their susceptibility to suggestions of new beliefs, following [12]. Thus it differs from existing binary vector opinion dynamic models (such as in [3]) where influence is determined by the similarity of the belief set and which has no structure between beliefs.
The work here follows [13] in focussing upon structured beliefs and could be seen as fitting into the general framework proposed in [1], except for the fact that there are no goals in this model. [15] reports upon a system which attempts to use agents to iteratively achieve consensus by using a voting mechanism using variations of syntactic similarity matching. The coherency function here could be compared to their measure of syntactic similarity, but this was a global measure, based upon a voting model.
The model could be seen as a social version of models of bit-string optimisation, such as in Genetic Algorithms [7] or studies of the NK-model of gene interaction [8]. If there was no interaction between individual atomic beliefs this would correspond to the case of no epistasis in biology (the k=0 case of the NK model), where there is some structure (as explored here) this corresponds to where epistasis holds (k>0 in the NK model). However the operators of acquisition and loss are very different, being social here. In the biological case (including GAs) random mutation and sexual recombination are used, here we have social suggestion and the dropping of beliefs due to individual belief revision. One example of such optimisation techniques is that of Particle Swarm [9], where each agent has a momentum in terms of belief change plus an attraction to the collective average belief value. There is nothing like momentum here and also no central coordination or attraction of beliefs to a centroid.
[1] Amgoud, L., Belabbes, S. & Prade, H. (2005) Towards a
formal framework for the search of a consensus between autonomous
agents. Proc. of the 4th Int. Joint Conf. on Autonomous agents and
multiagent systems, ACM Press, New York, USA, 537-543
[3] Deffuant, G., Neau D., Amblard F., and Weisbuch, G. (2000)
Mixing beliefs among interacting agents. Advances in Complex
Systems 3. pp. 98.
[4] Deffuant, G. (2006) Comparing Extremism Propagation Patterns
in Continuous Opinion Models, Journal of Artificial Societies and
Social Simulation vol. 9, no. 3 http://jasss.soc.surrey.ac.uk/9/3/8.html
[5] French, J. R. P. (1956) A formal theory of social power.
Psychological Review 63: 181-194.
[6] Galam, S. & Moscovici, S. (1991) Towards a theory of
collective phenomena: consensus and attitude changes in groups.
European Journal of Social Psychology. 21 49-74.
[8] Kauffman, S. A. & Levin, S. (1987). Towards a general
theory of adaptive walks on rugged landscapes. Journal of
Theoretical Biology 128: 11-45.
[9] Kennedy, J. (1997) Minds and Cultures: Particle Swarm
Implications. AAAI Fall Symposium on Socially Intelligent Agents.
Technical Report FS-97-02, AAAI Press.
[12] Thagard, P. (1989) Explanatory Coherence. Behavioural and
Brain Sciences, 12: 435-502.
[13] Urbig, D. & Malitz, R. (2005): Dynamics of structured
attitudes and opinions. Troitzsch, K.G. (ed.): Representing Social
Reality. Pre-Proceedings of the Third Conference of the European
Social Simulation Association (ESSA), September 5-9, Koblenz,
Germany, 2005, pp. 206-212.
[14] Weisbuch, G, Deffuant G, Amblard F & Nadal J P (2001),
Interacting agents and continuous opinion dynamics. http://arXiv.org/pdf/cond-mat/0111494
[15] Williams, A.B., Krygowski, T.A., & Thomas, G. (2002)
Using agents to reach an ontology consensus, Proc. of the 1st Int.
Joint Conf. on Autonomous agents and multiagent systems: part 2,
July, Bologna.
Edmonds, B. (in press, 2012) Modelling Belief Change in a Population Using Explanatory Coherence, Advances in Complex Systems.
See: http://cfpm.org/cpmrep185.html for past versions of this paper.
extensions [table array ]
globals [colour-list base-colour-list num-type1s num-type2s trace?
zero-cf incr-cf decr-cf sing-cf dble-cf scep-cf fixr-cf red-cf blue-cf yell-cf
anti-red-cf anti-blue-cf anti-yell-cf
nk0-cf nk1-cf nk2-cf nk3-cf nk4-cf nk5-cf nk6-cf
opinion-fn
poss-bs num-arcs any-change? no-change-for end-tick max-num
av-hamming sd-hamming max-hamming av-linked-hamming sd-linked-hamming max-linked-hamming
consensus possible-states av-opinion sd-opinion av-opinion-type1 sd-opinion-type1
av-opinion-type2 sd-opinion-type2
num-0-beliefs num-1-beliefs num-2-beliefs num-3-beliefs num-4-beliefs num-5-beliefs
num-6-beliefs num-7-beliefs num-8-beliefs num-9-beliefs num-10-beliefs num-11-beliefs
num-12-beliefs
fixed-random-network
filename]
breed [type1s type1]
breed [type2s type2]
;; beliefs are a list of 0/1
;; coherence is a float recoding current coherency level
;; cfn is the table inpl
turtles-own [beliefs belief-num coherence cfn cfname scaling-fn changed?]
to setup
clear-all
ifelse (strip-spaces title) = "" [set filename "ACS Model"] [set filename strip-spaces title]
set filename (word filename "-" (substring date-and-time 16 length date-and-time) "-" behaviorspace-run-number)
set fixed-random-network [[2 9] [3 6] [1 2] [2 6] [0 1] [2 8] [5 6] [0 3] [0 9] [7 9] [4 7] [3 8] [0 5] [8 9] [3 7] [2 5] [3 5] [4 9] [1 6] [7 8]]
set num-type1s round (num-agents * prop-of-type1)
set num-type2s num-agents - num-type1s
set num-arcs round num-agents * num-arcs-per-node
set max-num 2 ^ num-beliefs - 1
ifelse num-beliefs > 3 [
set base-colour-list sentence [yellow blue red] remove-list [black yellow blue red] base-colors
set colour-list fput grey n-colours (2 ^ (num-beliefs + 1))
] [
set colour-list [grey yellow blue green red orange magenta brown]
set base-colour-list [yellow blue red]
]
make-cfs
set opinion-fn fn-from Opinion-Fn-Name
let type-list shuffle sentence n-values num-type1s [1] n-values num-type2s [2]
foreach type-list [
ifelse ? = 1 [
create-type1s 1 [
set beliefs n-values num-beliefs [one-with-prob init-prob-belief]
set cfname Coherence-Fn-Type1
set scaling-fn Scaling-Fn-Type1
set shape "circle"
]
] [
create-type2s 1 [
set beliefs n-values num-beliefs [one-with-prob init-prob-belief]
set cfname Coherence-Fn-Type2
set scaling-fn Scaling-Fn-Type2
set shape "star" set size 1.5
]
]
]
ask turtles [initialise-cf]
ask turtles [init-appearence]
make-network
arrange-turtles
calc-op-data
reset-ticks
end
to make-network
;; "random" "regular" "star" "planar" "small world"
if network-topology = "random" [
while [count links < num-arcs] [
ask one-of turtles [
maybe-make-link one-of other turtles
]
]
stop
]
if network-topology = "regular" [
let base 0
foreach sort turtles [
ask ? [
foreach seq 1 num-arcs-per-node 1 [
maybe-make-link turtle ((who + ?) mod num-agents)
]
]
]
stop
]
if network-topology = "planar" [
foreach sort turtles [
ask ? [
repeat num-arcs-per-node [
maybe-make-link min-one-of
(other turtles with [not linked-from? myself])
[distance myself]
]
]
]
stop
]
if network-topology = "star" [
let centre-turtles turtles with [who < num-arcs-per-node]
let other-turtles turtles with [who >= num-arcs-per-node]
ask other-turtles [
ask centre-turtles [maybe-make-link myself]
]
stop
]
if network-topology = "small world" [
let base 0
foreach sort turtles [
ask ? [
foreach seq 1 num-arcs-per-node 1 [
maybe-make-link turtle ((who + ?) mod num-agents)
]
]
]
ask links [
if prob 0.1 [randomly-rewire-dest end1 end2]
]
stop
]
if network-topology = "preferential attachment" [
while [count links < num-arcs] [
ask one-of turtles [
maybe-make-link random-member (sentence one-of other turtles [end2] of links)
]
]
stop
]
if network-topology = "fixed random" [
foreach fixed-random-network [
ask type1 first ? [maybe-make-link type1 second ?]
]
stop
]
error (word network-topology " not yet implemented!!!")
end
to maybe-make-link [oth]
if self = oth [stop]
ifelse bi-directional-arcs?
[if not link-neighbor? oth
[create-link-with oth [set color white show-link]]
]
[if not out-link-neighbor? oth
[create-link-to oth [set color white show-link]]
]
end
to randomly-rewire-dest [stn enn]
let cand-nodes no-turtles
ifelse bi-directional-arcs?
[
ask stn [
ask link-with enn [die]
set cand-nodes other turtles with [not link-neighbor? myself]
if any? cand-nodes [
create-link-with one-of cand-nodes [set color white show-link]
]
]
]
[
ask stn [
ask out-link-to enn [die]
set cand-nodes other turtles with [not in-link-neighbor? myself]
if any? cand-nodes [
create-link-to one-of cand-nodes [set color white show-link]
]
]
]
end
to-report linked-from? [oth]
ifelse bi-directional-arcs?
[report link-neighbor? oth]
[report in-link-neighbor? oth]
end
to init-appearence
setxy random-float max-pxcor random-float max-pycor
show-turtle
update-appearence
end
to update-appearence
set any-change? true
set coherence table:get cfn beliefs
set belief-num num-of beliefs
adjust-shade
end
to adjust-shade
;; set color base-col - 3 + round (8 * (position beliefs poss-bs) / length poss-bs)
set color item num-of beliefs colour-list
end
to arrange-turtles
;; "random" "regular" "star" "planar" "small world"
if network-topology = "random"
[repeat 100000 / num-agents [layout-spring turtles links 0.02 1 0.25]]
if network-topology = "fixed random"
[repeat 100000 / num-agents [layout-spring turtles links 0.02 1 0.25]]
if network-topology = "regular"
[layout-circle sort turtles 14]
if network-topology = "small world"
[layout-circle sort turtles 14]
if network-topology = "star" [
let centre-turtles turtles with [who < num-arcs-per-node]
ifelse count centre-turtles = 1
[layout-circle sort centre-turtles 0]
[layout-circle sort centre-turtles 2]
layout-circle sort turtles with [who >= num-arcs-per-node] 14
]
if network-topology = "preferential attachment"
[repeat 100000 / num-agents [layout-spring turtles links 0.02 4 1]]
end
to-report one-with-prob [prb]
ifelse prob prb [report 1] [report 0]
end
to initialise-cf
set cfn fn-from cfname
end
to-report fn-from [str]
;; "zero" "incr" "decr" "scep" "sing" "dble" "indr" "fixr"
set possible-states poss-of-len num-beliefs
let tfn table:make
if str = "zero" [report zero-cf]
if str = "incr" [report incr-cf]
if str = "decr" [report decr-cf]
if str = "scep" [report scep-cf]
if str = "sing" [report sing-cf]
if str = "dble" [report dble-cf]
if str = "fixr" [report fixr-cf]
if str = "zero" [report zero-cf]
if str = "indr" [
foreach poss-bs [
table:put tfn ? rand-val
]
report tfn
]
if str = "yell" [report yell-cf]
if str = "anti-yell" [report anti-yell-cf]
if str = "blue" [
ifelse num-beliefs > 1
[report blue-cf]
[error (word str " can't be used with " num-beliefs " beliefs!!!")]
]
if str = "anti-blue" [
ifelse num-beliefs > 1
[report anti-blue-cf]
[error (word str " can't be used with " num-beliefs " beliefs!!!")]
]
if str = "red" [
ifelse num-beliefs > 2
[report red-cf]
[error (word str " can't be used with " num-beliefs " beliefs!!!")]
]
if str = "anti-red" [
ifelse num-beliefs > 2
[report anti-red-cf]
[error (word str " can't be used with " num-beliefs " beliefs!!!")]
]
if str = "nk0" [report nk0-cf]
if str = "nk1" [report nk1-cf]
if str = "nk2" [report nk2-cf]
if str = "nk3" [report nk3-cf]
if str = "nk4" [report nk4-cf]
if str = "nk5" [report nk5-cf]
if str = "nk6" [report nk6-cf]
error (word str " is not an implemented coherency function!!!!")
end
to make-cfs
set poss-bs poss-of-len num-beliefs
set zero-cf table:make
foreach poss-bs [
table:put zero-cf ? 0
]
set incr-cf table:make
let incr-vals n-values (1 + num-beliefs) [2 * (? / num-beliefs) - 1]
;; let incr-vals [-1 -0.333 0.333 1]
foreach poss-bs [
table:put incr-cf ? item (sum ?) incr-vals
]
set decr-cf table:make
let decr-vals n-values (1 + num-beliefs) [-2 * (? / num-beliefs) + 1]
;; let decr-vals [1 0.333 -0.333 -1]
foreach poss-bs [
table:put decr-cf ? item (sum ?) decr-vals
]
set sing-cf table:make
let sing-vals sentence [0 1 -0.5] n-values (num-beliefs + 1) [-1]
set sing-vals sublist sing-vals 0 (num-beliefs + 1)
;; let sing-vals [0 1 -0.5 -1]
foreach poss-bs [
table:put sing-cf ? item (sum ?) sing-vals
]
set dble-cf table:make
let dble-vals sentence [-1 0 1] n-values (num-beliefs + 1) [-1]
set dble-vals sublist dble-vals 0 (num-beliefs + 1)
foreach poss-bs [
table:put dble-cf ? item (sum ?) dble-vals
]
set fixr-cf table:make
foreach poss-bs [
table:put fixr-cf ? (random-float 2) - 1
]
set scep-cf table:make
let scep-vals sentence [1] n-values num-beliefs [-1]
foreach poss-bs [
table:put scep-cf ? item (sum ?) scep-vals
]
set yell-cf table:make
foreach poss-bs [
table:put yell-cf ? (ifelse-value (item 0 ? = 1) [1] [-1])
]
set anti-yell-cf table:make
foreach poss-bs [
table:put anti-yell-cf ? (ifelse-value (item 0 ? = 1) [-1] [1])
]
if num-beliefs > 1 [
set blue-cf table:make
foreach poss-bs [
table:put blue-cf ? (ifelse-value (item 1 ? = 1) [1] [-1])
]
set anti-blue-cf table:make
foreach poss-bs [
table:put anti-blue-cf ? (ifelse-value (item 1 ? = 1) [-1] [1])
]
]
if num-beliefs > 2 [
set red-cf table:make
foreach poss-bs [
table:put red-cf ? (ifelse-value (item 2 ? = 1) [1] [-1])
]
set anti-red-cf table:make
foreach poss-bs [
table:put anti-red-cf ? (ifelse-value (item 2 ? = 1) [1] [-1])
]
]
set nk0-cf nk-table 0
if num-beliefs > 1 [
set nk1-cf nk-table 1
if num-beliefs > 2 [
set nk2-cf nk-table 2
if num-beliefs > 3 [
set nk3-cf nk-table 3
if num-beliefs > 4 [
set nk4-cf nk-table 4
if num-beliefs > 5 [
set nk5-cf nk-table 5
if num-beliefs > 6 [
set nk6-cf nk-table 6
]]]]]]
end
to-report nk-table [k]
if k > num-beliefs [error (word "k=" k " bigger than num-beliefs, " num-beliefs)]
let vl 0
let p []
let nkfn table:make
let nk-vals n-values num-beliefs [n-values (2 ^ (k + 1)) [random-float 1]]
foreach poss-bs [
set p ?
set vl 0
foreach seq 0 (num-beliefs - 1) 1 [
set vl vl + item (num-of (bit-of ? (k + 1) p)) (item ? nk-vals)
]
set vl vl / num-beliefs
table:put nkfn p (2 * vl - 1)
]
report nkfn
end
to-report bit-of [s l lis]
let opl []
let ll length lis
foreach seq s (s + l - 1) 1 [
set opl lput (item (? mod ll) lis) opl
]
report opl
end
to-report rand-val
report (random-float 2) - 1
end
to do-hist
set-current-plot "Histogram of Hamming distances"
let hamm-list map [(hamming-dist first ? second ?) / num-beliefs] n-values 10000 [(list ([beliefs] of one-of turtles) ([beliefs] of one-of turtles))]
set av-hamming mean hamm-list
set sd-hamming standard-deviation hamm-list
set max-hamming ceiling max hamm-list
set-plot-x-range 0 1 + (1 / num-beliefs)
set-plot-pen-interval 1 / num-beliefs
histogram hamm-list
set-current-plot "Av Hamming Dist"
set-plot-y-range 0 1
if av-hamming > sd-hamming
[set-current-plot-pen "av-sd"
plot av-hamming - sd-hamming]
set-current-plot-pen "av"
plot av-hamming
set-current-plot-pen "av+sd"
plot av-hamming + sd-hamming
set-current-plot "Histogram of Linked Hamming distances"
let linked-hamm-list map [(hamming-dist first ? second ?) / num-beliefs] n-values 10000 [beliefs-of-ends-of one-of links]
set av-linked-hamming mean linked-hamm-list
set sd-linked-hamming standard-deviation linked-hamm-list
set max-linked-hamming ceiling max linked-hamm-list
set-plot-x-range 0 1 + (1 / num-beliefs)
set-plot-pen-interval 1 / num-beliefs
histogram linked-hamm-list
end
to-report hamming-dist [vec1 vec2]
report sum (map [ifelse-value (?1 = ?2) [0] [1]] vec1 vec2)
end
to-report beliefs-of-ends-of [lnk]
report list
[beliefs] of [end1] of lnk
[beliefs] of [end2] of lnk
end
to-report name
report (word self)
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
to go
;; if time is done stop simulation
if max-time > 0 [if ticks > max-time [do-hist stop]]
set end-tick ticks
set any-change? false
ask links [set color white]
ask links [maybe-transmit-a-belief]
ask turtles [maybe-drop-a-belief]
if mut-prob-power < 0 [
ask turtles [maybe-mutate-a-belief]
]
ifelse any-change?
[set no-change-for 0]
[set no-change-for no-change-for + 1]
if auto-stop? [
if no-change-for > 100 [set end-tick ticks - 100 do-hist stop]
if length remove-duplicates [beliefs] of turtles = 1 [do-hist stop]
]
if Hist? [do-hist]
calc-op-data
tick
end
to maybe-transmit-a-belief
let transmitted? false
let n1 end1
let n2 end2
if bi-directional-arcs? [
let ends list end1 end2
set n1 random-member ends
set n2 first remove n1 ends
]
let bel-pos -1
ask n1 [
if some-beliefs? [
set bel-pos a-belief-pos-from beliefs
]
]
if bel-pos < 0 [stop]
ask n2 [
if item bel-pos beliefs = 0 [
let new-beliefs set-pos bel-pos beliefs
let new-coherence table:get cfn new-beliefs
if prob (copy-rate / num-arcs-per-node * scale scaling-fn (new-coherence - coherence)) [
set beliefs new-beliefs
update-appearence
set transmitted? true
]
]
]
if transmitted? [set color item bel-pos base-colour-list]
end
to-report coherency-diff [ps]
let with-bel replace-item ps beliefs 1
let coh-with table:get cfn with-bel
let without-bel replace-item ps beliefs 0
let coh-without table:get cfn without-bel
report scale scaling-fn (coh-with - coh-without)
end
to-report num-links
ifelse bi-directional-arcs?
[report count my-links]
[report count my-out-links]
end
to maybe-mutate-a-belief
if prob (10 ^ mut-prob-power) [
let pos random num-beliefs
set beliefs replace-item pos beliefs (1 - item pos beliefs)
update-appearence
]
end
to-report some-beliefs?
report (sum beliefs) > 0
end
to-report no-beliefs?
report (sum beliefs) = 0
end
to-report set-pos [pos lis]
report replace-item pos lis 1
end
to-report clear-pos [pos lis]
report replace-item pos lis 0
end
to-report a-belief-pos-from [bels]
if empty? bels [error "Trying to find the position of the 1's in the empty list!!!"]
report random-member pos-of-1s-in bels
end
to-report pos-of-1s-in [bels]
report map [length bels - 1 - ?] po bels
end
to-report po [bels]
if empty? bels [report []]
ifelse first bels = 1
[report fput (length bels - 1) (po but-first bels)]
[report po but-first bels]
end
to maybe-drop-a-belief
if conditional-drop? and coherence >= 0 [stop]
if no-beliefs? [stop]
let bel-pos a-belief-pos-from beliefs
let new-beliefs clear-pos bel-pos beliefs
let new-coherence table:get cfn new-beliefs
if prob (drop-rate * scale scaling-fn (new-coherence - coherence))
[set beliefs new-beliefs update-appearence]
end
to-report opinion-from [bel]
report table:get opinion-fn bel
end
to-report num-of [bels]
if empty? bels [report 0]
report first bels + 2 * num-of but-first bels
end
to-report scale [labl val]
;; linear maps [-1, 1] to [0, 1]
if labl = "linear" [report (val + 1) / 2]
;; ramped flat in [-1, -0.5] and [0.5, 1]
if labl = "ramped" [report min list 1 max list 0 val]
;; sudden a step fn
if labl = "step" [report ifelse-value (val > 0) [1] [0]]
;; very weak logistic
if labl = "very weak logistic" [report 1 / (1 + 1.5 ^ (-1 * val))]
;; soft logistic
if labl = "weak logistic" [report 1 / (1 + 2 ^ (-1 * val))]
;; medium logistic
if labl = "med logistic" [report 1 / (1 + 2 ^ (-1 * 2 * val))]
;; strong logistic
if labl = "strong logistic" [report 1 / (1 + 2 ^ (-1 * 10 * val))]
error (word labl " is not an inplemented scaling function!!!")
end
to-report safe-item [pos lis]
if pos > (length lis - 1) [report 0]
report item pos lis
end
to calc-op-data
set num-0-beliefs (count turtles with [(safe-item 0 beliefs) = 1]) / num-agents
if num-beliefs > 1
[set num-1-beliefs (count turtles with [(safe-item 1 beliefs) = 1]) / num-agents]
if num-beliefs > 2
[set num-2-beliefs (count turtles with [(safe-item 2 beliefs) = 1]) / num-agents]
if num-beliefs > 3
[set num-3-beliefs (count turtles with [(safe-item 3 beliefs) = 1]) / num-agents]
if num-beliefs > 4
[set num-4-beliefs (count turtles with [(safe-item 4 beliefs) = 1]) / num-agents]
if num-beliefs > 5
[set num-5-beliefs (count turtles with [(safe-item 5 beliefs) = 1]) / num-agents]
if num-beliefs > 6
[set num-6-beliefs (count turtles with [(safe-item 6 beliefs) = 1]) / num-agents]
if num-beliefs > 7
[set num-7-beliefs (count turtles with [(safe-item 7 beliefs) = 1]) / num-agents]
if num-beliefs > 8
[set num-8-beliefs (count turtles with [(safe-item 8 beliefs) = 1]) / num-agents]
if num-beliefs > 9
[set num-9-beliefs (count turtles with [(safe-item 9 beliefs) = 1]) / num-agents]
if num-beliefs > 10
[set num-10-beliefs (count turtles with [(safe-item 10 beliefs) = 1]) / num-agents]
if num-beliefs > 11
[set num-11-beliefs (count turtles with [(safe-item 11 beliefs) = 1]) / num-agents]
if num-beliefs > 12
[set num-12-beliefs (count turtles with [(safe-item 12 beliefs) = 1]) / num-agents]
set av-opinion mean [opinion-from beliefs] of turtles
set sd-opinion standard-deviation [opinion-from beliefs] of turtles
if num-type1s > 0 [
set av-opinion-type1 mean [opinion-from beliefs] of type1s
set sd-opinion-type1 standard-deviation [opinion-from beliefs] of type1s
]
if num-type2s > 0 [
set av-opinion-type2 mean [opinion-from beliefs] of type2s
set sd-opinion-type2 standard-deviation [opinion-from beliefs] of type2s
]
let freq-pair-list map [list count turtles with [beliefs = ?] ?] possible-states
set freq-pair-list sort-by [first ?1 > first ?2] freq-pair-list
set consensus first first freq-pair-list
end
to op-graphs
export-all-plots filename
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
to a-a-GEN-UTILS end
to-report remove-list [remlis lis]
let opl lis
foreach remlis [
set opl remove ? lis
]
report opl
end
to-report n-colours [n]
;; produces a list of n random visible colurs (not too near black)
report n-values n [(list (10 + random 245) (10 + random 245) (10 + random 245))]
end
to-report poss-of-len [dim]
if dim <= 0 [report [[]]]
let poss-minus1 poss-of-len (dim - 1)
report sentence (map [fput 0 ?] poss-minus1) (map [fput 1 ?] poss-minus1)
end
to pause
if not user-yes-or-no? (word "Continue?") [error "User halted simulation!!"]
end
to-report showpause [inp]
if not user-yes-or-no? (word "Value is: " inp " -- Continue?") [error "User halted simulation!!"]
report inp
end
to ipat [p1 p2]
inspect patch p1 p2
end
to ith
ask turtles-here [inspect self]
end
to-report link-breed [p1 p2]
let pl []
ask p1 [set pl sort my-links]
ask p2 [
let p2l sort my-links
set pl filter [member? ? p2l] pl
]
if empty? pl [report "none"]
report [breed] of (random-member pl)
end
to-report random-member [ls]
report item (random length ls) ls
end
to-report prob [p]
report random-float 1 < p
end
to-report subtract-list [lis1 lis2]
report filter [not member? ? lis2] lis1
end
to-report safeSubList [lis srt en]
let len length lis
if en < 1 or srt > len [report []]
report subList lis max list 0 srt min list en len
end
to-report safe-n-of [nm lis]
if is-list? lis [if length lis >= nm [report n-of nm lis]]
if is-agentset? lis [if count lis >= nm [report n-of nm lis]]
report lis
end
to-report safe-one-of [lis]
report safe-n-of 1 lis
end
to-report flatten-once [lis]
let op-list []
foreach lis [
foreach ? [set op-list fput ? op-list]
]
report op-list
end
to-report minList [lis1 lis2]
report (map [min list ?1 ?2] lis1 lis2)
end
to-report maxList [lis1 lis2]
report (map [max list ?1 ?2] lis1 lis2)
end
to-report sumList [lis1 lis2]
report (map [?1 + ?2] lis1 lis2)
end
to-report sdList [sqLis sumLis numLis]
report (map [sqrt max (list 0 ((?1 / numLis) - ((?2 / numLis) ^ 2)))] sqLis sumLis)
end
to-report fputIfNew [exLisLis newLis]
report (map [ifelse-value (member? ?2 ?1) [?1] [fput ?2 ?1]] exLisLis newLis)
end
to-report csv-string-to-list [str]
let lis []
while [not empty? str] [
set lis fput next-value str lis
set str after-next str
]
report reverse lis
end
to-report after-next [str]
let pos-comma position "," str
if pos-comma != false [report subString str (pos-comma + 1) length str]
report ""
end
to-report next-value [str]
let pos-comma position "," str
if pos-comma != false [
report read subString str 0 pos-comma
]
report read str
end
to-report read [str]
set str strip-spaces str
if empty? str [report nobody]
ifelse is-string-a-number? str
[report read-from-string str]
[report str]
end
to-report strip-spaces [str]
report strip-leading-spaces strip-trailing-spaces str
end
to-report strip-leading-spaces [str]
if empty? str [report str]
if first str != " " [report str]
report strip-leading-spaces but-first str
end
to-report is-string-a-number? [str]
if empty? str
[report false]
report is-nonempty-string-a-number? str
end
to-report is-nonempty-string-a-number? [str]
if empty? str [report true]
let ch first str
if ch = "." [report is-string-digits? but-first str]
if not is-str-digit? ch [report false]
report is-nonempty-string-a-number? but-first str
end
to-report is-string-digits? [str]
if empty? str [report true]
let ch first str
if not is-str-digit? ch [report false]
report is-string-digits? but-first str
end
to-report is-str-digit? [ch]
ifelse ch >= "0" and ch <= "9"
[report true]
[report false]
end
to-report strip-trailing-spaces [str]
if empty? str [report str]
if last str != " " [report str]
report strip-trailing-spaces but-last str
end
to-report insert [itm ps lis]
report (sentence sublist lis 0 ps (list itm) sublist lis ps (length lis))
end
to-report insertAfter [itm ps lis]
report insert itm (ps + 1) lis
end
to-report num-nodes [lis]
report length nodes-in lis
end
to-report nodes-in [lis]
if not is-list? lis [report (list lis)]
let op-list []
foreach lis [set op-list append op-list nodes-in ?]
report op-list
end
to-report second [lis]
report item 1 lis
end
to-report third [lis]
report item 2 lis
end
to XXX
let tt 1
set tt tt - 1
set tt 1 / tt
end
to-report showPass [arg]
show arg
report arg
end
to-report posBiggest [lis]
report position (reduce [ifelse-value (?1 >= ?2) [?1] [?2]] lis) lis
end
to-report allPos [expr]
let oplis [[]]
foreach but-first (n-values (length expr) [?]) [
let ps ?
let posLis allPos (item ps expr)
set opLis append (map [fput ps ?1] posLis) opLis
]
report opLis
end
to-report replaceAtPos [posList baseExpr insExpr]
if posList = [] [report insExpr]
report replace-item (first posList) baseExpr (replaceAtPos (but-first posList) (item first posList baseExpr) insExpr)
end
to-report atPos [posList expr]
if empty? posList [report expr]
report atPos but-first posList item (first poslist) expr
end
to-report append [list1 list2]
if empty? list1 [report list2]
report fput (first list1) (append (but-first list1) list2)
end
to-report selectProbilistically [charList numList]
report item (chooseProbilistically numList) charList
end
to-report chooseProbilistically [numList]
report findPos (random-float 1) cummulateList scaleList numList
end
to-report chooseReverseProbilistically [numList]
if length numList = 1 [report 0]
report findPos (random-float 1) cummulateList reverseProbList scaleList numList
end
to-report reverseProbList [numList]
report map [1 - ?1] numList
end
to-report cummulateList [numList]
report cummulateListR numList 0
end
to-report cummulateListR [numList cumm]
if empty? numList [report []]
let newCumm cumm + first numList
report fput newCumm cummulateListR but-first numList newCumm
end
to-report scaleList [numLis]
if empty? numLis [report numLis]
let sumLis sum numLis
if sumLis = 0 [report numLis]
report map [?1 / sumLis] numLis
end
to-report findPos [vl numList]
report findPosR vl numList 0
end
to-report findPosR [vl numList ps]
if empty? numList [report ps]
if vl <= (first numList) [report ps]
report findPosR vl but-first numList (1 + ps)
end
to-report freqOfIn [lis allList]
report reduce [fput (numOfIn ?2 lis) ?1 ] (fput [] allList)
end
to-report freqOf [lis]
if empty? lis [report []]
let sort-lis sort lis
let red-lis sort remove-duplicates lis
let op-lis red-lis
let num-lis []
let cnt 0
foreach sort-lis [
ifelse ? = first red-lis
[set cnt cnt + 1]
[set num-lis fput cnt num-lis
set cnt 1
set red-lis but-first red-lis]
]
set num-lis fput cnt num-lis
report pair-list (reverse num-lis) op-lis
;; report pair-list reverse num-lis red-lis
;; report fput (list (numOfIn first lis lis) (first lis)) (freqOf remove first lis lis)
end
to-report freqRep [lis]
report sort-by [first ?1 > first ?2] filter [first ? > 1] freqOf lis
end
to-report numOfIn [itm lis]
report length (filter [itm = ?] lis)
end
to-report patchesToDist [dist]
if dist = 0 [report self]
let patchList []
foreach seq (-1 * dist) dist 1 [
let xc ?
foreach seq (-1 * dist) dist 1 [
set patchList fput patch-at xc ? patchList
]
]
report patch-set patchList
end
to-report individualsToDist [dist]
report turtles-on patchesToDist dist
end
to-report hammingDist [gene1 gene2]
report sum (map [ifelse-value (?1 = ?2) [0] [1]] gene1 gene2)
end
to-report distBetween [x1 y1 x2 y2]
report (max list abs (x1 - x2) abs (y1 - y2))
;; report sqrt (((x1 - x2) ^ 2) + ((y1 - y2) ^ 2))
end
to-report seq [from upto stp]
report n-values (1 + ceiling ((upto - from) / stp)) [from + ? * stp]
end
to-report safeDiv [numer denom]
if denom = 0 and numer = 0 [report 1]
if denom = 0 [report 0]
report numer / denom
end
to-report flip-bit [ps bitList]
report replace-item ps bitList (1 - (item ps bitList))
end
to showList [lis]
foreach but-last lis [type ? type " "]
print last lis
end
to-report is-divisor-of [num den]
report (0 = (num mod den))
end
to-report pair-list [lis1 lis2]
report (map [list ?1 ?2] lis1 lis2)
end
to-report depth [lis]
if not is-list? lis [report 0]
if empty? lis [report 0]
report 1 + max map [depth ?] lis
end
to-report empty-as
report no-turtles
end
to-report exists [obj]
if is-turtle-set? obj [report any? obj]
report obj != nobody
end
to-report pick-at-random-from-list [lis]
report item random length lis lis
end
to tv [str val]
if trace? [output-print (word str "=" val)]
end
to-report normal-dist [x mn sd]
report exp (-0.5 * ((x - mn) / sd) ^ 2) / (sd * sqrt (2 * pi))
end
to-report careful-item [ps lis str]
let rs 0
carefully
[set rs item ps lis]
[output-print (word "str" ": no position " ps " in: " lis)]
report rs
end