4 Block Stalagmites

globals [
         ;; colors of the background of the view and of the two possible colors in samples
         background-color column-color target-color other-color
         num-columns ;; how many columns there are in the graphics-window histogram
         num-target-color  ;; how many of the squares (patches) in the sample are of the favored color
         sample-right-xcor ;; the x-coordinate of the moving sample (not the magnified sample)
         sample-location-patch-agentset ;; patches where the moving sample will sprout
         token-sample-dude ;; bottom-left turtle in the moving sample
         stop-all? ;; Boolean variable for stopping the experiment
         side ;; tells how big the side of the block is--2 for 4-block

         popping?
         ]

patches-own [ column ]

breed [ column-kids column-kid ]
column-kids-own [ binomial-coefficient sample-list ]

breed [ sample-dudes sample-dude ]
sample-dudes-own [ distance-for-jump ]

breed [ baby-dudes baby-dude ]

;; jwu - instead of having the sample-dudes stamp, they're going to create
;; a sample-organizer. the sample-organizers are going to have a better idea
;; of which specific sample the sample-dudes represented.
breed [ sample-organizers ]
sample-organizers-own [
  sample-values
  original-pycor
]

to Go-org
  if stop-all? [stop]
    super-go
    organize-results
end 

to super-go
  if stop-all? [stop]
  ifelse popping? [
    no-display
    unpop
    go
    pop
    display
  ] [
    go
    display
  ]
end 

;; the popping? global controls the popping visuals

to pop
  set popping? true
  recolor-columns
end 

to unpop
  set popping? false
  recolor-columns
end 

;; jwu - different color for each sample-summary-value

to-report popping-color ; sample-organizers procedure
  report 15 + ((sample-summary-value * 10) mod 120)
end 

to-report sample-summary-value ; sample-organizers reporter
  let result 0
  let power-of-two 3
  foreach sample-values [
    if ? = 1 [
      set result result + 2 ^ power-of-two
    ]
    set power-of-two power-of-two - 1
  ]
  report result
end 

to-report sample-patches ; sample-organizers procedure
  let result []
  foreach n-values side [?][
    let i ?
    foreach n-values side [?] [
      set result lput patch-at ? (- i) result
    ]
  ]
  report result
end 

to display-sample ; sample-organizers procedure
  let patch-popping-color popping-color
  (foreach sample-values sample-patches [
    ask ?2 [
      ifelse popping? [
        set pcolor patch-popping-color
      ] [
        ifelse ?1 = 1 [
          set pcolor target-color
        ] [
          set pcolor other-color
        ]
      ]
    ]
  ])
end 

to recolor-columns
  reset-column-colors
  ask sample-organizers [
    display-sample
  ]
end 

to reset-column-colors ; column-kids procedure
  ask column-kids [
    ask patches with [ pcolor != black and
                       (pxcor = [pxcor] of myself or
                        pxcor = [pxcor] of myself - 1) ] [
      set pcolor [pcolor] of myself
    ]
  ]
end 

to make-a-sample-organizer ; sample-dudes procedure
  hatch-sample-organizers 1 [
    ht
    set sample-values map [ ifelse-value ([color] of ? = target-color) [1] [0] ]
                          sorted-sample-dudes
    display-sample
  ]
end 

to organize-results
  ask sample-organizers [
    if original-pycor = 0 [
      set original-pycor pycor
    ]
  ]
  ask column-kids [
    organize-column
  ]
  recolor-columns
end 

to organize-column ; column-kids procedure
  let column-organizers sample-organizers with [ pxcor + 1 = [pxcor] of myself ]
  (foreach sort-by [ [ sample-summary-value ] of ?1 <=
                     [ sample-summary-value ] of ?2
                   ] [self] of column-organizers
           sort [ pycor ] of column-organizers
           [ ask ?1 [set ycor ?2] ])
end 

to disorganize-results
 ask sample-organizers [
   set ycor original-pycor
 ]
 recolor-columns
end 

to startup
  ;set total-samples
end 

;; This procedure colors the view, divides patches into columns of equal length ( plus a single partition column),
;; and numbers these columns, beginning from the left, 0, 1, 2, 3, etc.

to setup
  clear-all
  set-default-shape turtles "square big"
  clear-output
  set background-color white - 1;black
  set column-color grey
  set target-color green
  set other-color blue
  set side 2

  set popping? false

  ;; num-columns is how many columns (bars) there are in the graphics-window histogram.
  ;; We need side ^ 2 + 1 columns in a histogram. For example, 3-by-3 samples (9 patches)
  ;; have 10 -- that is, 3 ^ 2 + 1 -- different possible counts of target-color (0, 1, 2, 3, ...9).
  set num-columns ( side ^ 2 + 1)

  ;; determines the location of the sample array beginning one column to the left of the histogram
  set sample-right-xcor -1 * round ( ( num-columns / 2 ) * ( side + 1 ) )

  ;; assigns each patch with a column number. Each column is as wide as the value set in the 'side' slider
  ask patches
  [
    set pcolor background-color
    ;; The following both centers the columns and assigns a column number to each patch
    ;; We use "side + 1" and not just "side" so as to create an empty column between samples
    set column floor ( ( pxcor + ( ( num-columns * ( side + 1 ) ) / 2 ) ) / ( side + 1 ) )
    if column < 0 or column >= num-columns
      [ set column -100 ]
  ]

  ;; leave one-patch strips between the columns empty
  ask patches with
  [ [column] of patch-at -1 0 != column ]
  [
    set column -100  ;; so that they do not take part in commands that report relevant column numbers
  ]

   ;; colors the columns with two shades of some color, alternately
   ask patches
   [
     if column != -100
     [
       ifelse int ( column / 2 ) = column / 2
       [ set pcolor column-color ][ set pcolor column-color - 1 ]
     ]
   ]

  ;; This draws the  base-line and creates a sample-kids turtle at the base of each column
  ask patches with
  [ ( pycor = -1 * max-pycor + side + 3 ) and  ;; The base line is several patches above the column labels.
    ( column != -100 ) ]
  [
    set pcolor black
    if [column] of patch-at -1 0 != column   ;; find the leftmost patch in the column...
    [
      ask patch (pxcor + side - 1)  ;; ...then move over to the right of the column
                ( -1 * max-pycor + 1 )
        [ set plabel column ]
      ask patch (pxcor + floor (side / 2))  ;; ...then move over to the middle of the column
                ( -1 * max-pycor + 1 )
      [
       sprout 1
        [
          hide-turtle
          set color pcolor
          set breed column-kids
          set sample-list []

          ;; each column-kid knows how many different combinations his column has
          set binomial-coefficient item column binomrow (num-columns - 1)
        ]
      ]
    ]
  ]
  set stop-all? false
  set num-target-color false
  reset-ticks
end 

to go
  if stop-all? [stop]
  ;; The model keeps track of which different combinations have been discovered. Each
  ;; column-kid reports whether or not its column has all the possible combinations. When bound? is true,
  ;; a report from ALL column-kids that their columns are full will stop the run.
  if stop-at-all-found? [if count column-kids with [length remove-duplicates sample-list = binomial-coefficient] = count column-kids
    [stop]]
  sample
  ifelse magnify? [ magnify-on-side ] [ ask baby-dudes [ die ] ]
  drop-in-bin

  tick
  if plot? [ histogram-blocks ]
end 

;; This procedure creates a square sample of dimensions side-times-side, e.g., 3-by-3,
;; located to the left of the columns. Each patch in this sample sprouts a turtle.
;; The color of the sample-dudes in this square are either target-color or other-color,
;; based on a random algorithm (see below)

to sample
  ;; creates a square agentset of as many sample-dudes as determined by the 'side' slider,
  ;; positioning these sample sample-dudes at the top of the screen and to the left of the histogram columns
  set sample-location-patch-agentset patches with
  [
    ( pxcor <= sample-right-xcor ) and
    ( pxcor > sample-right-xcor - side ) and
    ( pycor > ( max-pycor - side ) ) ]

  foreach sort sample-location-patch-agentset
  [
    ask ?
    [
      sprout 1
      [
        ht
        set breed sample-dudes
        setxy pxcor pycor

      ;; Each turtle in the sample area chooses randomly between the target-color and the other color.
      ;; The higher you have set the probability slider, the higher the chance the turtle will get the target color
      ifelse random 100 < probability-to-be-target-color
        [ set color target-color ]
        [ set color other-color ]
      st
      ]
    ]
  ]
  ;; num-target-color reports how many sample-dudes in the random sample are of the target color
  set num-target-color count sample-dudes with [ color = target-color ]
end 

;; procedure in which the sample turtles create an enlarged duplicate on the left side of the screen and this enlarged sample makes
;; a large duplicate of the sample. This helps users see the samples that may otherwise be too small to see comfortably.
;; Samples are small for side = 3 because we want the entire sample space to fit into the view.

to magnify-on-side
  ask baby-dudes [die] ;; clears the way for new magnified sample
  ask sample-dudes
  [
    hatch-a-big-baby
  ]
end 

to hatch-a-big-baby ;; sample-dudes procedure
  hatch 1
  [
    set breed baby-dudes
    set size 12 * ( 8 - side ) / side
    ;; This is tricky.  We want to center the new turtles vertically, and
    ;; put them to the right of all the columns, with a little space between.
    ;; The code is complicated, because it is supposed to work for other x-blocks, too
    setxy -1 * ( size * .35 ) + ( sample-right-xcor + ( .35 * size * ( xcor - sample-right-xcor ) ) )
          ( ( side - 1 ) * size / 2 ) + ( .35 * size * ( ycor + min-pycor ) )
    set size size * .33
  ]
end 

;; This procedure moves the random sample sideways to its column and then down above other previous samples
;; in that column.

to drop-in-bin
  find-your-column
  descend
end 

;; The random sample moves to the right until it is in its correct column, that is, until it is in the column
;; that collects samples which have exactly as many sample-dudes of the target color as this sample has.
;; The rationale is that the as long as the sample is not in its column, it keeps moving sideways.
;; So, if the sample has 9 sample-dudes (3-by-3) and is moving sideways, but 6 of them are not yet in their correct column,
;; the sample keeps moving. When all of the 9 sample-dudes are the sample's correct column, this procedure stops.

to find-your-column
  ask sample-dudes [ set heading 90 ]
  while
  [ count sample-dudes with [ column = num-target-color ] != side ^ 2  ]
  [
    ask sample-dudes
    [ fd 1 ]
  ]
end 

;; Moves the sample downwards along the column until it is either on the base line or
;; exactly over another sample in that column.

to descend
  let lowest-in-sample min [ pycor ] of sample-dudes
  ask sample-dudes
  [ set heading 180 ]

  ;; The lowest row in the square sample is in charge of checking whether or not the sample has arrived all the way down
  ;; In order to determine who this row is -- as the samples keeps moving down -- we find a turtle with the lowest y coordinate
  ;; checks whether the row directly below the sample's lowest row is available to keep moving down
  set token-sample-dude one-of sample-dudes with [ pycor = lowest-in-sample ]
  while
  [
    ( [ [pcolor] of patch-at 0 -2 ] of token-sample-dude ) != black  and
    ( [ [pcolor] of patch-at 0 -2 ] of token-sample-dude ) != target-color and
    ( [ [pcolor] of patch-at 0 -2 ] of token-sample-dude ) != other-color
  ]
  [
    ;; As in find-your-column, shift the sample one row down
    ask sample-dudes
    [ fd 1 ]

  ;; Instead of establishing again the lowest row in the sample, the y coordinate of the row
  ;; gets smaller by 1 because the sample is now one row lower than when it started this 'while' procedure
  set lowest-in-sample ( lowest-in-sample - 1 )
  ]

  ;; Once sample-dudes have reached as low down in the column as they can go (they are on top of either the base line
  ;; or a previous sample) they might color the patch with their own color before they "die."
  finish-off

  ;; If the column has been stacked up so far that it is near the top of the screen, the whole supra-procedure stops
  ;; and so the experiment ends
  if max-pycor - lowest-in-sample < ( side + 1 ) [ set stop-all? true ]
end 


;; we can't sort by who number, because who numbers get reused in weird ways, it seems.

to-report sorted-sample-dudes
;report sort sample-dudes
report sort-by [
         (([pxcor] of ?1 < [pxcor] of ?2) and ([pycor] of ?1 = [pycor] of ?2)) or
         (([pycor] of ?1 > [pycor] of ?2))
       ] sample-dudes
end 

to finish-off
  ;; creates local list of the colors of this specific sample, for instance the color combination of a 9-square,
  ;; beginning from its top-left corner and running to the right and then taking the next row and so on
  ;; might be "green green red green red green"
  ;; jwu - need to use map and sort instead of values-from cause of
  ;; the new randomized agentsets in 3.1pre2
  let sample-color-combination map [ [color] of ? ] sorted-sample-dudes

  ;; determines which turtle lives at the bottom of the column where the sample is
  let this-column-kid one-of column-kids with [ column = [ column ] of token-sample-dude ]

    ;; make the upper left sample-dude create a sample-organizer
    let the-sample-sample-dude max-one-of (sample-dudes with-min [ pxcor ]) [ pycor ]

  ;; accepts to list only new samples and makes a previously encountered sample if keep-duplicates? is on
  ifelse not member? sample-color-combination [sample-list] of this-column-kid
  [
    ask the-sample-sample-dude [
      make-a-sample-organizer
    ]
    ask sample-dudes
    [ die ]
  ]
  [
    ifelse keep-repeats? [
    ask the-sample-sample-dude [
      make-a-sample-organizer
    ]
    ask sample-dudes
    [ die ]
    ] [
      ask sample-dudes
        [  die ]
    ]
  ]
    ask this-column-kid
    [ set sample-list fput sample-color-combination sample-list ]
end 

;; procedure for calculating the row of coefficients
;; column-kids needs their coefficient so as to judge if their column has all the possible different combinations

to-report binomrow [n]
  if n = 0 [ report [1] ]
  let prevrow binomrow (n - 1)
  report (map [?1 + ?2] fput 0 prevrow
                        lput 0 prevrow)
end 

;;if the model has been run, report the number of patches
;;with the target-color -- otherwise, display "--"

to-report #-target-color
  ifelse ticks != 0
  [ report count patches with [ pcolor = target-color ] ]
  [ report "--" ]
end 

;;if has been run, report the number of patches
;;with the other-color -- otherwise, display "--"

to-report #-other-color
  ifelse ticks != 0
  [ report count patches with [ pcolor = other-color ] ]
  [ report "--" ]
end 

;; reports the proportion of the sample space that has been generated up to now

to-report %-full
  ifelse samples-found = 0
    [ report precision 0 0 ]
    [ report precision ( samples-found / ( 2 ^ ( side ^ 2 ) ) ) 3 ]
end 

to-report samples-found
  report sum [ length remove-duplicates sample-list ] of column-kids
end 

to-report total-samples-to-find
  report precision ( 2 ^ ( side ^ 2 ) ) 0
end 

to histogram-blocks
  let sample-value-summaries [ sample-summary-value ] of sample-organizers
  let possible-values n-values (2 ^ (side * side)) [?]
  let results []
  foreach possible-values [
    let i ?
    set results lput length filter [? = i] sample-value-summaries results
  ]

  set-current-plot "Events by Number of Outcomes"
  let max-results max results
  if mean results > 0 [ set-plot-x-range 0 (max-results + 1) ]
  set-current-plot-pen "Histogram"
  histogram results
  set-current-plot-pen "Mean"
  let mean-results mean results
  plot-pen-reset
  plotxy mean-results 0
  plotxy mean-results plot-y-max
end 


; Copyright 2006 Uri Wilensky.
; See Info tab for full copyright and license.