extensions [ array table ]
breed [ agents agent ]
breed [ urn-nodes urn-node ]
breed [ ball-color-nodes ball-color-node ]
; This is an unusual NetLogo model --- as the simulation is structurally
; so simple, most of the interaction is stored in global variables.
globals [
sender ; the Sender agent
receiver ; the Receiver agent
nature ; not used for anything except display purposes
state-swap-history ; a list of the times when a state/action pair swap occurred
state-added-history ; a list of the times when a new state/action pair was added
history ; a list of the past N signalling outcomes
; (used for calculating the moving average)
successful-signalling-attempts ; a tally of the total number of successful
; signalling attempts (used to calculate the
; cumulative frequency)
state-action-map ; Indicates which action is correct given the state of the world.
; The index i should be the current state of the world, the
; value stored in the list is the correct action to perform.
output-string ; The history of state-action pairs, to be displayed in the output window
world-state ; The current state of the world
next-color ; The next ball color to use
signal-sent ; The most recent signal sent by the Sender
action-done ; The most recent action performed by the Receiver
new-signal-tried?
results-to-display?
last-signalling-attempt-successful?
last-used-world-state-weights
]
agents-own [
; An urn is coded as a list of two lists:
; - the first list is the set of ball colours
; - the second list is the number of balls of each colour
; [ [...colours...] [...counts...] ]
urn-array ; Just used by the Sender
dictionary ; Just used by the Receiver
]
; parent = "Sender" or "Receiver"
; id = urn # or ball color #
; kind = 0 for urn link, 1 for ball color link
links-own [
parent
id
]
urn-nodes-own [
reference
]
ball-color-nodes-own [
ball-color
urn-tag
agent-type
]
to setup
clear-all
set state-swap-history ""
set history []
set state-added-history []
set results-to-display? false
set next-color 1
set successful-signalling-attempts 0
set output-string "Correct act for the state of the world: (state->act)\n\n"
set last-signalling-attempt-successful? false
; Open up a data file to store the complete history of the model
; (This was commented out for purposes of posting online...)
; if (log-data? = true)
; [
; if (file-exists? "parameters-and-data.m")
; [
; file-close-all
; file-delete "parameters-and-data.m"
; ]
; file-open "parameters-and-data.m"
; file-print "{"
; file-type " History->{\n "
; ]
if (initial-state-probabilities = "Manual distribution" and length state-probabilities != number-of-states)
[
beep
user-message "You have not specified probabilities for\nthe correct number of states."
stop
]
if (initial-state-probabilities = "Equiprobable")
[
set world-state-weights (word "[ " (reduce [(word ?1 " " ?2)] (n-values number-of-states [1 / number-of-states])) " ]")
]
; This just sets the default value of state-action-map to
; the list [0 1 2 ... number-of-states - 1 ], indicating that the correct
; action for state i is action i.
set state-action-map (n-values number-of-states [?])
; Although no swap has occurred, we call the next method because that serves to note
; what the correct state/action pairs are at the start of the simulation.
; (Note it has to be called here because it depends on state-action-map being
; initialized.)
note-swap-occurred
; Next, we create 2 turtles whose only purpose is being a carrier
; for the labels "Sender" or "Receiver"... they do nothing in the
; model - they just carry some text on the display.
create-turtles 1 [
setxy -3 1
set label "Sender"
set size 0
]
create-turtles 1 [
setxy 5.2 1
set label "Receiver"
set size 0
]
; Now create the Sender.
create-agents 1 [
set sender self
setxy -6 0
set shape "circle"
set size player-node-size
set color blue
;set urn-array (array:from-list (n-values number-of-states [ [[0] [1]] ]))
set urn-array (array:from-list (n-values number-of-states [ (list (list 0) (list mutator-weight)) ] ))
let i 0
while [i < number-of-states ] [
hatch-urn-nodes 1 [
let urn self
set reference i
set color green
set size 1
set shape "circle"
create-link-with sender [
set parent "Sender"
set id i ; this is the urn label
set color white
set label i
]
hatch-ball-color-nodes 1 [
set color blue
set size 0.5
set shape "circle"
set label 1
set agent-type "Sender"
set ball-color 0
set urn-tag i
create-link-with urn [
set parent (word "Sender-Urn-" i)
set id 0 ; this is the ball color
set label 0
]
]
]
set i (i + 1)
]
]
create-agents 1 [
set receiver self
setxy 6 0
set shape "circle"
set size player-node-size
set color blue
set dictionary table:make
]
create-turtles 1 [
set nature self
setxy 4 -5
set shape "square"
set size 0
set color green
set label ""
]
create-turtles 1 [
setxy 3 -5
set size 0
set label "State of the world:"
]
update-display
end
to go
step
end
to step
set new-signal-tried? false
set results-to-display? true
; check to see if we are to swap the correct action for the state
; of the world, and do, if so.
if (enable-swap-states? = true and ((random-float 1.0) < swap-state-probability))
[
randomly-swap-correct-response-to-world-state
note-swap-occurred
]
; check to see if we are to add a new state/action pair, and then do, if so
if (enable-add-new-states? = true and ((random-float 1.0) < new-state-action-pair-probability))
[
add-new-state-action-pair
]
; determine the state of the world and note in on the display
set world-state select-world-state
ask nature [ set label world-state ]
comment (word "World state: " world-state)
set signal-sent get-signal-from-sender
comment (word "Signal from sender: " signal-sent)
set action-done get-action-from-receiver signal-sent
comment (word "Action performed by receiver: " action-done)
ifelse (is-action-performed-correct? action-done world-state)
[
set last-signalling-attempt-successful? true
; signalling attempt was successful, so make a note of that
set successful-signalling-attempts (successful-signalling-attempts + 1.0)
; append data to the "complete-history" file
; (Commented out for purposes of posting online...)
; if (log-data? = true)
; [
; file-open "parameters-and-data.m"
; ifelse (ticks != 0)
; [ file-type ",1" ]
; [ file-type "1" ]
; if (ticks > 0 and (ticks mod 50 = 0))
; [ file-type "\n " ]
; ]
set history (lput 1 history)
if (length history > length-moving-average)
[
set history (but-first history)
]
; reinforce the appropriate urns
if (new-signal-tried? = true) [
add-new-ball-color-to-sender-urns signal-sent
; must update the urns..
create-urn-nodes 1 [
set color green
set size 1
set shape "circle"
set reference signal-sent
create-link-with receiver [
set parent "Receiver"
set id signal-sent ; this is the urn label
set color white
set label signal-sent
]
; now create the nodes for the various action types
let urn self
let i 0
while [i < number-of-states]
[
hatch-ball-color-nodes 1 [
set color blue
set size 0.5
set shape "circle"
set label 1
set urn-tag signal-sent
set ball-color i
set agent-type "Receiver"
create-link-with urn [
set parent (word "Receiver-Urn-" signal-sent)
set id i ; this is the ball color
set color white
set label i
]
]
set i (i + 1)
]
]
set next-color (next-color + 1)
]
reinforce-sender-urn world-state signal-sent
reinforce-receiver-urn signal-sent action-done
]
[
; we didn't succeed in signalling
set last-signalling-attempt-successful? false
; append data to the data file
; Commented out for purposes of posting online
; if (log-data? = true)
; [
; file-open "parameters-and-data.m"
; ifelse (ticks != 0)
; [ file-type ",0" ]
; [ file-type "0" ]
; if (ticks > 0 and (ticks mod 50 = 0))
; [ file-type "\n " ]
; ]
set history (lput 0 history)
if (length history > length-moving-average)
[
set history (but-first history)
]
if (new-signal-tried? = true)
[
; This is just done to keep the urns in alignment
remove-urn-from-receiver signal-sent
]
]
if (enable-forgetting? = true) ; and (random-float 1.0 < forgetting-rate))
[
if (forgetting-type = "Forgetting A" and (random-float 1.0 < forgetting-rate))
[ do-forgetting-A ]
if (forgetting-type = "Forgetting B" and (random-float 1.0 < forgetting-rate))
[ do-forgetting-B ]
if (forgetting-type = "Discount the past")
[ do-discount-the-past ]
]
check-for-extinct-signals
update-display
tick
update-plot
end
to-report is-action-performed-correct? [ action state ]
ifelse ((item state state-action-map) = action)
[ report true ]
[ report false ]
end
to randomly-swap-correct-response-to-world-state
let i (random number-of-states)
let j (random number-of-states)
while [j = i]
[
set j (random number-of-states)
]
let old-i-action (item i state-action-map)
let old-j-action (item j state-action-map)
set state-action-map (replace-item i state-action-map old-j-action)
set state-action-map (replace-item j state-action-map old-i-action)
end
; Report an urn of the form [ [ 0 s_1 ... s_n ] [ 1 1 ... 1 ] ]
; (it contains one ball for each of the currently used signals, plus
; a mutator ball.)
to-report create-urn-with-currently-used-signals
let used-signals signals-in-use
; Only need N-1 values because the mutator gets a different weight...
let counts (n-values ((length used-signals) - 1) [1])
report (list used-signals (fput mutator-weight counts))
end
to add-new-state-action-pair
; First, note when we added a new state
set state-added-history (lput ticks state-added-history)
; It's easier to follow the logic if we use new-state rather than number-of-states
let new-state number-of-states
; We need to do several things:
;
; 1. Add a new urn, empty except for the black ball and the used signals, to the Sender's
; array of urns.
; 2. Create the nodes used to draw and display the contents of the new
; Sender urn -- this means creating a new hatch-urn-node and a new
; hatch-ball-color-node.
; 3. Add a new entry to the state-action-map, thereby allowing us to both
; add new state/action pairs to the model in addition to swapping the
; correct answers from time to time.
; 4. Update the world state probabilities so that there is a nonzero
; chance that nature will select the new state of the world and present
; it to the Sender.
; 5. Loop through all of the *Receiver's* urns which currently exist and
; insert a new ball representing the new action now available to the
; Receiver.
; 6. Create the nodes used to draw and display the contents of the
; Receiver's urns, adding a new edge for the new available action.
;
ask sender [
; add a new urn to the Sender's array (this achieves 1.)
let urn-list array:to-list urn-array
let urn create-urn-with-currently-used-signals
set urn-list (lput urn urn-list )
set urn-array array:from-list urn-list
; Now create the nodes to display the status of the urn
; this achieves 2.
hatch-urn-nodes 1 [
let urn-node self
set reference new-state
set color green
set size 1
set shape "circle"
create-link-with sender [
set parent "Sender"
set id new-state ; this is the urn label
set color white
set label new-state
]
; now create the ball color nodes for each of the balls in
; the urn
foreach (item 0 urn) [
let col ?
hatch-ball-color-nodes 1 [
set color blue
set size 0.5
set shape "circle"
set label 1
set agent-type "Sender"
;set ball-color 0
set ball-color col
set urn-tag new-state
create-link-with urn-node [
set parent (word "Sender-Urn-" new-state)
set id col ; this is the ball color
set label col
]
]
]
]
]
; Extend the list of correct responses to the (new) state of the world
; by one new act. (This achieves 3.)
set state-action-map (lput new-state state-action-map)
; Change the probabilities of the states of the world. (This achieves 4.)
let new-probs (read-from-string world-state-weights)
set new-probs (map [ (number-of-states / (number-of-states + 1)) * ? ] new-probs)
set new-probs (lput (1 / (number-of-states + 1)) new-probs)
set world-state-weights (word "[" (reduce [ (word ?1 " " ?2) ] new-probs) "]")
; Now add the new action to the *Receiver's* existing urns. (This achieves 5.)
ask receiver [
let keys table:keys dictionary
foreach keys [
let urn table:get dictionary ?
let actions (item 0 urn)
let totals (item 1 urn)
set actions (lput new-state actions)
set totals (lput 1 totals)
table:put dictionary ? (list actions totals)
]
; Now create the new nodes to display the contents of the Receiver's urns
; this (finally) completes 6.
ask my-links [ ; This contacts the nodes connected to the Receiver
ask other-end [ ; This contacts the urn-node at the other end
; now create the new action node
let urn self
let ref reference
hatch-ball-color-nodes 1 [
set color blue
set size 0.5
set shape "circle"
set label 1
set urn-tag ref
set ball-color new-state
set agent-type "Receiver"
create-link-with urn [
set parent (word "Receiver-Urn-" signal-sent)
set id new-state ; this is the ball color
set color white
set label new-state
]
]
]
]
]
set number-of-states (number-of-states + 1)
update-display
end
to update-plot
; Have to add 1 to the ticks count below because otherwise we get
; a division by zero message at the start Ñ because we don't advance
; the tick counter until the very end (after we update both the plot
; and the display)
set-current-plot-pen "cumulf"
plot cumulative-frequency
set-current-plot-pen "movingf"
plot moving-frequency
end
to-report cumulative-frequency
report successful-signalling-attempts / ticks
end
to-report moving-frequency
ifelse (length history = 0)
[ report 0 ]
[ report mean history ]
end
to-report signals-in-use
let signals []
let i 0
while [i < number-of-states]
[
let urn array:item ([urn-array] of sender) i
set signals (sentence signals (item 0 urn))
set i (i + 1)
]
set signals (sort (remove-duplicates signals))
report signals
end
to check-for-extinct-signals
let used-signals signals-in-use
let signals-receiver-responds-to (table:keys ([dictionary] of receiver))
foreach signals-receiver-responds-to
[
if ((member? ? used-signals ) = false)
[
; kill the nodes in the display
ask ball-color-nodes with [ agent-type = "Receiver" and urn-tag = ?]
[ die ]
ask receiver [
ask link-neighbors with [ reference = ? ]
[ die ]
table:remove dictionary ?
]
]
]
end
to remove-urn-from-receiver [ signal ]
ask receiver [
table:remove dictionary signal
]
end
to add-new-ball-color-to-sender-urns [ col ]
ask sender [
let i 0
while [ i < number-of-states ]
[
let urn (array:item urn-array i)
array:set urn-array i (add-new-ball-color-to-urn col urn)
set i (i + 1)
]
ask link-neighbors [
let r reference
hatch-ball-color-nodes 1 [
set urn-tag r
set ball-color col
set agent-type "Sender"
set label 1
set color blue
set size 0.1
set shape "circle"
create-link-with myself [
set parent (word "Sender-Urn-" r)
set id col ; this is the ball color
set label col
]
]
]
]
end
to reinforce-sender-urn [ state signal ]
ask sender [
let urn (array:item urn-array state)
set urn (reinforce-urn signal urn)
array:set urn-array state urn
]
end
to reinforce-receiver-urn [ signal action ]
ask receiver [
let urn (table:get dictionary signal)
table:put dictionary signal (reinforce-urn action urn)
]
end
to-report get-action-from-receiver [ signal ]
let response -1
ask receiver [
ifelse (table:has-key? dictionary signal = true)
[
; retrieve the urn and select an action
let urn table:get dictionary signal
set response (draw-ball-from-urn urn)
]
[
; create a new urn and add it to the table
let ball-colors (n-values number-of-states [?])
let ball-counts (n-values number-of-states [1])
let urn (list ball-colors ball-counts)
table:put dictionary signal urn
set response (draw-ball-from-urn urn)
]
]
report response
end
to-report get-signal-from-sender
let signal-to-send -1
ask sender [
let urn (array:item urn-array world-state )
let ball (draw-ball-from-urn urn)
ifelse (ball = 0)
[
set new-signal-tried? true
set signal-to-send next-color
]
[ set signal-to-send ball ]
]
report signal-to-send
end
; World states can be 0, 1, 2, etc.
; Indexing the states from 0 is more convenient for list extraction.
to-report select-world-state
let list-of-states n-values number-of-states [?]
report select-randomly-by-weight list-of-states state-probabilities
end
to-report state-probabilities
ifelse (initial-state-probabilities = "Equiprobable")
[
report n-values number-of-states [ 1.0 / number-of-states ]
]
[
ifelse (initial-state-probabilities = "Random distribution")
[ report random-distribution ]
[ report read-from-string world-state-weights ]
]
end
; Use a stick-breaking algorithm to generate an unbiased probability vector
to-report random-distribution
let lst (sort (sentence [ 0.0 1.0 ] (n-values (number-of-states - 1) [random-float 1.0] )))
let dist (map [?1 - ?2] (but-first lst) (but-last lst))
set last-used-world-state-weights (word "[ " (reduce [(word ?1 " " ?2)] dist) " ]")
report dist
end
to update-display
ask agents [
set size player-node-size
]
ask ball-color-nodes with [ agent-type = "Sender" ]
[
let urn (array:item ([urn-array] of sender) urn-tag)
; Trim the weight to 5 characters if we are discounting the past
ifelse (forgetting-type = "Discount the past")
[ set label (trim-string (word (number-of-balls-in-urn-of-this-color ball-color urn)) 5) ]
[ set label (number-of-balls-in-urn-of-this-color ball-color urn) ]
]
ask ball-color-nodes with [ agent-type = "Receiver" ]
[
let urn (table:get ([dictionary] of receiver) urn-tag)
; Trim the label to 5 characters if we are discounting the past
ifelse (forgetting-type = "Discount the past")
[ set label (trim-string (word (number-of-balls-in-urn-of-this-color ball-color urn)) 5) ]
[ set label (number-of-balls-in-urn-of-this-color ball-color urn) ]
]
; need to include this always in case we flipped off
; the show-urn-results? switch
ask links [
set color white
set thickness 0
]
if (show-urn-results? = true and results-to-display? = true)
[
ask links with [ parent = "Sender" and id = world-state ]
[
ifelse (last-signalling-attempt-successful?)
[ set color green ]
[ set color red ]
set thickness 0.5
]
ask links with [ parent = (word "Sender-Urn-" world-state) and id = signal-sent ]
[
ifelse (last-signalling-attempt-successful?)
[ set color green ]
[ set color red ]
set thickness 0.5
]
ask links with [ parent = "Receiver" and id = signal-sent ]
[
ifelse (last-signalling-attempt-successful?)
[ set color green ]
[ set color red ]
set thickness 0.5
]
ask links with [ parent = (word "Receiver-Urn-" signal-sent) and id = action-done ]
[
ifelse (last-signalling-attempt-successful?)
[ set color green ]
[ set color red ]
set thickness 0.5
]
]
layout-sender-urns
layout-receiver-urns
end
;to forget
; if (forgetting-type = "Forgetting A")
; [ do-forgetting-A ]
;
; if (forgetting-type = "Forgetting B")
; [ do-forgetting-B ]
;end
to do-forgetting-A
ask sender [
; pick an urn
let i (random number-of-states)
let urn (array:item urn-array i)
let c draw-ball-from-urn urn
if (c = 0)
[ stop ]
; Check to see how many balls of that color there are
; because, if this is the last one, we need to remove the
; corresponding node from the display
if ((number-of-balls-in-urn-of-this-color c urn) = 1)
[
; kill the node
ask ball-color-nodes with [ agent-type = "Sender" and urn-tag = i and ball-color = c ]
[ die ]
]
array:set urn-array i (deinforce-urn c urn)
]
end
to do-forgetting-B
ask sender [
; pick an urn
let i (random number-of-states)
let urn (array:item urn-array i)
; pick a color
let ball-colors (item 0 urn)
let c (item (random (length ball-colors)) ball-colors)
if (c = 0)
[ stop ]
; Check to see how many balls of that color there are
; because, if this is the last one, we need to remove the
; corresponding node from the display
if ((number-of-balls-in-urn-of-this-color c urn) = 1)
[
; kill the node
ask ball-color-nodes with [ agent-type = "Sender" and urn-tag = i and ball-color = c ]
[ die ]
]
array:set urn-array i (deinforce-urn c urn)
]
end
to do-discount-the-past
ask sender [
; loop over all the urns, discounting each one.
let i 0
while [i < number-of-states]
[
let urn (array:item urn-array i)
set urn (discount-urn 1 urn)
; Now we need to inspect the discounted urn, killing the nodes
; used to show the weight if the weight has dipped below the
; cutoff threshold.
let ball-colors (item 0 urn) ; the colors in the urn
let ball-weights (item 1 urn) ; the weight assigned to each color
let len (length ball-weights) ; the number of colours in the urn
let c 1 ; the index of the current colour we are checking
; it is set to 1 because 0 is the black ball and
; we never discount the weight attached to the black ball
; Now loop over the weights, killing the node if the weight is below the cutoff threshold.
; At this point, we don't alter the structure of the urn -- we will do that next.
while [c < len]
[
if ((item c ball-weights) < cutoff-threshold)
[
; kill the node
ask ball-color-nodes with [ agent-type = "Sender" and urn-tag = i and ball-color = (item c ball-colors) ]
[ die ]
]
set c (c + 1)
]
; Now clean up the urn, removing any balls whose weight dropped below the cutoff threshold.
; We do this by building up a new urn, only including those colors from the old urn whose
; weight is greater than the cutoff threshold.
let new-ball-colors []
let new-ball-weights []
let old-ball-colors (item 0 urn)
let old-ball-weights (item 1 urn)
set c 0
set len (length old-ball-colors)
while [c < len]
[
if ((item c old-ball-weights) >= cutoff-threshold)
[
set new-ball-colors (lput (item c old-ball-colors) new-ball-colors)
set new-ball-weights (lput (item c old-ball-weights) new-ball-weights)
]
set c (c + 1)
]
set urn (list new-ball-colors new-ball-weights)
array:set urn-array i urn
set i (i + 1)
]
]
ask receiver [
let signals (table:keys dictionary)
foreach signals
[
let urn table:get dictionary ?
set urn (discount-urn 0 urn)
table:put dictionary ? urn
]
]
end
;to discount-the-past [ rate ]
; ask researchers [
; let ball-colors (item 0 urn)
; comment (word "Ball colors: " ball-colors)
;
; let ball-counts (item 1 urn)
; comment (word "Ball counts: " ball-counts)
;
; let new-ball-counts map [ ? * rate ] ball-counts
;
; ; reset the count of the black ball to 1, if it exists
; let pos (position 0 ball-colors)
; if (pos != false)
; [
; set ball-counts (replace-item pos new-ball-counts 1)
; ]
; set urn (list ball-colors ball-counts)
;
; ; now prune the urn of colors below a certain threshold
; foreach ball-colors [
; if ( (number-of-balls-in-urn-of-this-color ?) / total-number-of-balls-in-urn < 0.000001)
; [
; remove-color-from-urn ?
; remove-arm-from-bandit ?
; ask arm-link-neighbors with [ arm-colour = ? ] [ die ]
; ]
; ]
; ]
;end
; observer context
to-report select-randomly-by-weight [ lst weights ]
let total-weight (sum weights)
let r (random-float total-weight)
let list-position 0
let item-selected false
while [item-selected = false] [
let current-weight (item list-position weights)
ifelse r > current-weight
[
set r (r - current-weight)
set list-position (list-position + 1)
]
[ set item-selected true]
]
report item list-position lst
end
; researcher context
to-report total-number-of-balls-in-urn [ urn ]
report sum (item 1 urn)
end
; researcher context
to-report number-of-balls-in-urn-of-this-color [ c urn ]
let ball-colors (item 0 urn)
let ball-counts (item 1 urn)
let pos (position c ball-colors)
ifelse (pos = false)
[ report 0 ]
[ report item pos ball-counts]
end
; researcher context
to-report number-of-colors-in-urn [ urn ]
report length (item 0 urn)
end
; researcher context
to-report ball-color-probability [ col urn ]
report (number-of-balls-in-urn-of-this-color col urn) / ( total-number-of-balls-in-urn urn )
end
; the structure of an urn is [ [ ...colours...] [ ...numbers...] ]
; researcher context
to-report draw-ball-from-urn [ urn ]
let ball-colors (item 0 urn)
let ball-counts (item 1 urn)
let number-of-balls (sum ball-counts )
let r (random-float number-of-balls)
let list-position 0
let ball-selected false
while [ball-selected = false] [
let current-ball-count (item list-position ball-counts)
ifelse r < current-ball-count
[
set ball-selected true
]
[
set r (r - current-ball-count)
set list-position (list-position + 1)
]
]
report item list-position ball-colors
end
; The variable 'starting-point' below specifies the first index
; from which we begin discounting the urn. We need to do that
; because when we discount the Sender's urn, we don't discount the
; black ball (so we start at index = 1). When we discount the
; Receiver's urn, we discount everything (so we start at index = 0).
to-report discount-urn [ starting-point urn ]
let ball-colors (item 0 urn)
let ball-weights (item 1 urn)
let len (length ball-weights)
let i starting-point
while [i < len]
[
let weight (item i ball-weights)
set weight (discount-factor * weight)
set ball-weights (replace-item i ball-weights weight)
set i (i + 1)
]
report (list ball-colors ball-weights)
end
to-report add-new-ball-color-to-urn [ col urn ]
let ball-colors (item 0 urn)
let ball-counts (item 1 urn)
set ball-colors (lput col ball-colors)
set ball-counts (lput 1 ball-counts)
report (list ball-colors ball-counts)
end
; the structure of an urn is [ [ ...colours...] [ ...numbers...] ]
to-report reinforce-urn [ col urn ]
let ball-colors (item 0 urn)
let ball-counts (item 1 urn)
let list-position (position col ball-colors)
let cnt (item list-position ball-counts)
set ball-counts (replace-item list-position ball-counts (cnt + 1))
report (list ball-colors ball-counts)
end
; the structure of an urn is [ [ ...colours...] [ ...numbers...] ]
to-report deinforce-urn [ col urn ]
let ball-colors (item 0 urn)
let ball-counts (item 1 urn)
let list-position (position col ball-colors)
let cnt (item list-position ball-counts)
ifelse (cnt > 1)
[
set ball-counts (replace-item list-position ball-counts (cnt - 1))
report (list ball-colors ball-counts)
]
[
set ball-colors (remove-item list-position ball-colors)
set ball-counts (remove-item list-position ball-counts)
report (list ball-colors ball-counts)
]
end
to-report remove-color-from-urn [ col urn ]
let ball-colors (item 0 urn)
let ball-counts (item 1 urn)
let pos (position col ball-colors)
set ball-colors (remove-item pos ball-colors)
set ball-counts (remove-item pos ball-counts)
report (list ball-colors ball-counts)
end
to layout-sender-urns
ask sender [
let x xcor
let y ycor
let i 0
; This next bit includes a fudge for when the number of states is 1 (since we
; don't really need a delta value -- but we have to calculate one anyway to keep
; from splitting the code
let delta 0
if (number-of-states > 1)
[ set delta sender-urn-cone-angle / (number-of-states - 1) ]
while [ i < number-of-states ]
[
ask link-neighbors with [ reference = i ]
[
; this positions the node represent the urn
setxy x y
ifelse (number-of-states = 1)
[ set heading -90 ]
[
set heading -90 - (sender-urn-cone-angle / 2)
set heading (heading + delta * i)
]
fd length-of-links
; the following positions the nodes representing the contents of the urn
let new-x xcor
let new-y ycor
let default-heading heading
let s (count link-neighbors with [breed = ball-color-nodes])
let new-delta 0
if (s > 1)
[
set new-delta sender-urn-contents-cone-angle / (s - 1)
]
let j 0
foreach (sort link-neighbors with [ breed = ball-color-nodes ] )
[
ask ? [
setxy new-x new-y
ifelse (s > 1)
[
set heading default-heading - (sender-urn-contents-cone-angle / 2)
set heading (heading + new-delta * j)
fd length-of-links
]
[
set heading default-heading
fd length-of-links
]
set j (j + 1)
]
]
]
set i (i + 1)
]
]
end
to layout-receiver-urns
ask receiver [
let keys (sort table:keys dictionary)
let x xcor
let y ycor
let i 0
if (length keys) = 0
[ stop ]
let delta 0
if (length keys) > 1
[
set delta (receiver-urn-cone-angle / ((length keys) - 1))
]
while [ i < (length keys) ]
[
ask link-neighbors with [ reference = (item i keys) ]
[
setxy x y
ifelse (length keys) = 1
[
set heading 90
]
[
set heading 90 + (receiver-urn-cone-angle / 2)
set heading (heading - delta * i)
]
fd length-of-links
; the following positions the nodes representing the contents of the urn
let new-x xcor
let new-y ycor
let default-heading heading
; As elsewhere, we don't need a new-delta value if there's only one
; state -- but we have to include this fudge to avoid splitting the code
let new-delta 0
if (number-of-states > 1)
[ set new-delta receiver-urn-contents-cone-angle / (number-of-states - 1) ]
let j 0
foreach (sort link-neighbors with [ breed = ball-color-nodes ] )
[
ask ? [
setxy new-x new-y
set heading default-heading + (receiver-urn-contents-cone-angle / 2)
set heading (heading - new-delta * j)
fd length-of-links
set j (j + 1)
]
]
]
set i (i + 1)
]
]
end
;; some helper reporters
; This constructs a string of the form "At time t: 0->i, 1->j,..." noting what the correct
; action is for the states of the world at the present tick.
to note-swap-occurred
let indexes (n-values (length state-action-map) [?])
let s reduce [(word ?1 ?2)] (map [(word ?1 "->" ?2 ", ") ] indexes state-action-map)
set s (substring s 0 (length s - 2))
ifelse (ticks = 0)
[ set state-swap-history (word state-swap-history ticks "->{" s "}") ]
[ set state-swap-history (word state-swap-history "," ticks "->{" s "}") ]
set s (word "At time " ticks ": " s "\n")
set output-string (word output-string s)
clear-output
output-print output-string
end
to-report number-of-signals-in-use
report length (table:keys ([dictionary] of receiver))
end
to comment [ string ]
; if show-console-comments?
; [ print string ]
end
to-report trim-string [ string chars ]
let len ((length string) - 1)
ifelse (len > chars)
[ report substring string 0 (chars - 1) ]
[ report string ]
end
to-report probability-to-greyscale [ p ]
let g (round (255 * p))
report (list g g g )
end
to-report probability-to-red-green-mix [ p ]
let r (round (255 * (1 - p)))
let g (round (255 * p))
report (list r g 0 )
end
to generate-latex-output
if file-exists? "image.tex"
[ file-delete "image.tex" ]
file-open "image.tex"
file-print "\\begin{tikzpicture}[scale=1]"
file-print "\\pgfsetxvec{\\pgfpoint{.25cm}{0cm}}"
file-print "\\pgfsetyvec{\\pgfpoint{0cm}{.25cm}}"
ask links [
let x1 ([xcor] of end1)
let y1 ([ycor] of end1)
let x2 ([xcor] of end2)
let y2 ([ycor] of end2)
link-node x1 y1 x2 y2
]
ask sender [
plot-sender
ask my-links [
ask other-end [
plot-urn-node
]
]
]
ask receiver [
plot-receiver
ask my-links [
ask other-end [
plot-urn-node
]
]
]
ask ball-color-nodes [
plot-ball-node "black"
]
file-print "\\end{tikzpicture}"
file-close
end
; This must be called within the context of a node...
to plot-urn-node
file-print (word "\\draw[fill=black!30] (" xcor "," ycor ") circle (" (size * 3) "pt);")
end
to plot-ball-node [c]
let angle ( - (atan xcor ycor) + 90)
file-print (word "\\node[shape=circle,draw=black,transform shape,scale=.25,fill=black,label={[scale=.75,transform shape,inner sep=1pt]" angle ":" label "}] at (" xcor "," ycor ") {};")
end
; must be called from the Sender's context
to plot-sender
file-print (word "\\draw[draw=black,fill=blue!50] (" xcor "," ycor ") circle (" (size * 3) "pt) node[anchor=south west,transform shape,outer sep=1pt] {Sender};")
end
to plot-receiver
file-print (word "\\draw[draw=black,fill=blue!50] (" xcor "," ycor ") circle (" (size * 3) "pt) node[anchor=north east,transform shape,outer sep=1pt] {Receiver};")
end
; This must be called within the context of a link...
to link-node [x1 y1 x2 y2]
file-print (word "\\draw (" x1 "," y1 ") -- (" x2 "," y2 ") node[fill opacity=.75,fill=white,text opacity=1,scale=.8,transform shape,inner sep=0pt,outer sep=1pt,pos=.5] {" label "};")
end
; Commented out for purposes of posting online
;to close-data-file
; file-open "parameters-and-data.m"
; ; first, close off the history
; file-print "},"
; file-print (word " NumberOfStates->" number-of-states ",")
; file-print (word " MutatorWeight->" mutator-weight ",")
; file-print (word " CutoffThreshold->" cutoff-threshold ",")
; file-print (word " SwapStates->" enable-swap-states? ",")
; file-print (word " SwapStateProbability->" swap-state-probability ",")
; file-print (word " AddNewStates->" enable-add-new-states? ",")
; ifelse (length state-added-history = 0)
; [ file-print " AddNewStatesHistory->{}" ]
; [ file-print (word " AddNewStatesHistory->{" (reduce [(word ?1 "," ?2 )] state-added-history ) "},") ]
; file-print (word " NewStateActionPairProbability->" new-state-action-pair-probability ",")
; file-print (word " WorldStateWeights->{" (reduce [(word ?1 "," ?2 )] state-probabilities ) "},")
; file-print (word " StateSwapHistory->{" state-swap-history "}")
; file-print "}"
; file-close
;end
Department of Philosophy, Logic and Scientific Method
Description