Generalised Urn Model with Triggering

extensions[rnd]


globals[selected-colour-count current-cohort last-cohort last-colour max-ball-index ball-colours
  ball-pile-x ball-pile-y colour-created-time ball-counts ball-in-transit
  gini-index youth-index time-to-unlocked]
turtles-own[in-transit cohort ball-index adjacent-possible ball-created-time]

to setup
  ca
  reset-ticks
  set-default-shape turtles "circle"
  import-drawing "urn.png"

  ;set initial-colour-count 3
  set selected-colour-count 0

  set ball-in-transit false
  set current-cohort 1
  set last-cohort 1
  set max-ball-index 0
  set ball-counts []

  set ball-colours [15 65 95 125 85 45 55 135 75 35 25 5 115 13 63 93 123 83 43 53 133 73 33 23 2 113 17 67 97 127 87 47 57 137 77 37 27 7 117]
  set ball-pile-x [-14 -11 -8 -5 -2 1 4 7 10 13 -14 -11 -8 -5 -2 1 4 7 10 13 -14 -11 -8 -5 -2 1 4 7 10 13 -14 -11 -8 -5 -2 1 4 7 10 13]
  set ball-pile-y [14 14 14 14 14 14 14 14 14 14 10 10 10 10 10 10 10 10 10 10 6 6 6 6 6 6 6 6 6 6 2 2 2 2 2 2 2 2 2 2]
  set colour-created-time []
  set time-to-unlocked 0
  set gini-index 0
  set youth-index 0

  ; add initial balls
  repeat initial-colour-count [
    start-new-colour
    set ball-counts lput 1 ball-counts
  ]

  ask turtles[
      ; Act like these initial balls have been "instantiated"
      set adjacent-possible false
      ; Put each initial ball in a different cohort
      set cohort current-cohort
      set current-cohort current-cohort + 1
    ]


  setup-plots
end 

; Main function pick a new ball and move it to the pile.

to go

    pick-ball

    set ball-in-transit true

    if behaviorspace-run-number = 0 [move-to-pile]

    set ball-counts []

    clear-output

    tick
    set-current-plot "gini-curve"
    clear-plot
    do-plotting
    update-labels
end 

; Select a new ball from the urn, triggering additions

to pick-ball
  set last-colour 0
  let last-ball-index 0

  ; hatch according to turtle weights
  ask rnd:weighted-one-of turtles [colour-weight][
    hatch 1 [
      setxy 0 -2.2
      set shape "circle"
      set size 2
      let mycolor color


      ; set turtle vars
      set in-transit true
      set last-colour color
      set last-ball-index ball-index
      set last-cohort cohort
      set ball-created-time ticks

      ; ball colour is "instantiated", so no longer in the adjacent possible
      ask turtles with [color = mycolor] [set adjacent-possible false]
    ]
  ]
  if triggering [
  ; we add new colours if the ball was from the adjacent possible
  if  count turtles with [color = last-colour] = 2
    [
     set selected-colour-count selected-colour-count + 1
     ; Is this from the adjacent possible?
     if (selected-colour-count  > (initial-colour-count - 1)) [
        ; do we still have new colours?
        ifelse  (max-ball-index + initial-colour-count < length(ball-colours))
         [
            set current-cohort current-cohort + 1

            ; Create balls of new colours
            repeat initial-colour-count + 1[
              start-new-colour
            ]
          ]
          [
          ; Store the time the last colour was unlocked
              if time-to-unlocked = 0 [set time-to-unlocked ticks]
          ]

        ]

    ]
  ]
end 

; Allow for different weights to different types of balls - used by the weighted-random function

to-report colour-weight
  ; Initially use 1 across the board
  if max-ball-index = initial-colour-count[
    report 1
  ]

  ; total of balls that have been drawn before
  ;let drawn-count count turtles with [not adjacent-possible]
  let mycohort  cohort

  ; is the current ball from the adjacent possible? (colours with only 1 ball)
  ifelse not adjacent-possible[
    ifelse last-cohort = mycohort
    [
      report 1
    ]
    [
       report non-cohort-weight
    ]

  ]
  ; balls in the adjacent possible
  [
    ifelse last-cohort = mycohort
    [
      report ap-weight
    ]
    [
      report non-cohort-ap-weight
    ]
  ]
end 

; triggers creation of a new ball colour

to start-new-colour
  create-turtles 1
    [

      set ball-index max-ball-index
      setxy 0 -2.2
      set color item ball-index ball-colours
      let x item ball-index ball-pile-x
      let y item ball-index ball-pile-y
      facexy x y ; for the inherited trajectory
      setxy x y
      set shape "circle"
      set in-transit false
      set size 2
      set max-ball-index max-ball-index + 1
      set cohort current-cohort
      set adjacent-possible true

      ; keep track of how far into the model the new colour is added
      set colour-created-time lput ticks colour-created-time

      ; add a new pen to the distribution plot
      set-current-plot "distribution"
      create-temporary-plot-pen word "ball" ball-index

    ]
end 


; Animate the ball moving to the relevant pile

to move-to-pile
  while [ball-in-transit] [
  ; See if it has reached pile
  ask turtles with [in-transit][
    ifelse ycor > item ball-index ball-pile-y
      [
        ; ball has reached the pile
        set shape "checker piece 2"
        set size 3
        set ball-in-transit false
        set in-transit false

      ]
      [
        fd 0.008
      ]
    ]
  ]
end 

; this updates the charts dynamically as we have new colours being added so can't store the pens

to do-plotting

  let current-pen 0
  repeat max-ball-index

  [
      set-current-plot "distribution"
      set-current-plot-pen word "ball" current-pen
      set-plot-pen-color item current-pen ball-colours
      plotxy ticks count turtles with [color = item current-pen ball-colours]

      set-current-plot "gini-curve"
      set-current-plot-pen "gini"
      set ball-counts lput count turtles with [color = item current-pen ball-colours] ball-counts
      plotxy item current-pen colour-created-time sum ball-counts

      set current-pen current-pen + 1
  ]

  let current-tick-interval floor(ticks / 10)

  if ticks mod 10 = 0 and current-tick-interval > 0 [

    ;record most popular after intervals of 10 ticks
    set-current-plot "Popular by time slot"
    set-current-plot-pen "appearance"

    ;get the colour of the most popular in the time slot
    let current-index 0
    let colour-count  0
    let last-colour-count  0
    let top-colour 0
    let youth-sum 0
    repeat max-ball-index
    [
      let current-colour item current-index ball-colours

      set colour-count count turtles with [(color = current-colour) and (ball-created-time >= (current-tick-interval - 1) * 10 ) and (ball-created-time < current-tick-interval * 10) ]

      set youth-sum youth-sum + (item current-index ball-counts * item current-index colour-created-time)

      if colour-count > last-colour-count[
          set last-colour-count colour-count
          set top-colour current-colour
      ]
      set current-index current-index + 1
    ]

    let youth-ticks ticks
    ; calculate youth index
    if (time-to-unlocked < ticks and time-to-unlocked > 0)[
      set youth-ticks time-to-unlocked
    ]
    set youth-index  youth-sum / (sum(ball-counts) * youth-ticks)


    ;get the created time of the top colour in the interval
    set-plot-pen-color top-colour
    let top-colour-index [ball-index] of one-of turtles with [color = top-colour]
    let appearance-time item top-colour-index colour-created-time
    plotxy current-tick-interval * 10 appearance-time
  ]


    ;calculate gini-index
    let sorted-count sort ball-counts
    let cum-count 0
    let index 0
    set gini-index 0

    ;print word "number of colours: " max-ball-index
    ;print word "counts: " ball-counts

    repeat max-ball-index [
      set cum-count cum-count + ((max-ball-index - index ) * item index sorted-count)
      set index (index + 1)
    ]

    set gini-index (1 / max-ball-index) * (max-ball-index + 1 - (2 * ( cum-count / sum(ball-counts))))

 update-plots
end 

; this procedure puts the colour count labels onto the relevant patches

to update-labels
  let current-colour 0
  repeat max-ball-index
  [
    ask patch item current-colour ball-pile-x (item current-colour ball-pile-y - 2)[
      set plabel item current-colour ball-counts ;count turtles with [color = item current-colour ball-colours]
    ]
    set current-colour current-colour + 1
  ]
end 

to-report gini
  report gini-index
end 

to-report youth
  report youth-index
end