Galton box animation

Galton box animation is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

Generate an animated simulation of Sir Francis Galton's device. An example can be found to the right.

Example of a Galton Box at the end of animation.

In a Galton box, there are a set of pins arranged in a triangular pattern. A number of balls are dropped so that they fall in line with the top pin, deflecting to the left or the right of the pin. The ball continues to fall to the left or right of subsequent pins before arriving at one of the collection points between and to the sides of the bottom row of pins.

For the purpose of this task the box should have at least 5 pins on the bottom row. Your solution can use graphics or ASCII animation. Provide a sample of the output/display such as a screenshot.

Your solution can have either one or more balls in flight at the same time. If multiple balls are in flight, ensure they don't interfere with each other.

Your solution should allow users to specify the number of balls or it should run until full or a preset limit. Optionally, display the number of balls.

Icon and Unicon

The code here is adapted from the Unicon Book.

<lang Icon>link graphics

global pegsize, pegsize2, height, width, delay

procedure main(args) # galton box simulation from Unicon book

  pegsize2 := (pegsize := 10) * 2    # pegs & steps
  delay := 2                         # ms delay
  setup_galtonwindow(pegsize)
  n := integer(args[1]) | 100        # balls to drop 
  every 1 to n do galton(pegsize)
  WDone()

end

procedure setup_galtonwindow(n) # Draw n levels of pegs, local xpos, ypos, i, j

  # Pegboard size is 2n-1 square
  # Expected max value of histogram is (n, n/2)/2^n 
  # ... approximate with something simpler?

  height := n*n/2*pegsize + (width := (2*n+1)*pegsize)
  Window("size=" || width || "," || height, "fg=grayish-white")
  WAttrib("fg=dark-grey")
  every ypos := (i := 1 to n) * pegsize2 do {
     xpos := width/2 - (i - 1) * pegsize - pegsize/2 - pegsize2
     every 1 to i do
        FillArc(xpos +:= pegsize2, ypos, pegsize, pegsize)
     }
  WAttrib("fg=black","drawop=reverse")      # set drawing mode for balls

end

procedure galton(n) # drop a ball into the galton box local xpos, ypos, oldx, oldy

  xpos := oldx := width/2 - pegsize/2
  ypos := oldy := pegsize
  every 1 to n do {                         # For every ball...
     xpos +:= ((?2 = 1) | -1) * pegsize     # +/- pegsize
     animate(.oldx, .oldy, oldx := xpos, oldy := ypos +:= pegsize2)
     }
  animate(xpos, ypos, xpos, ypos + 40)      # Now the ball falls ...
  animate(xpos, ypos+40, xpos, ypos + 200)  # ... to the floor
  draw_ball(xpos)                           # Record this ball

end

procedure animate(xfrom, yfrom, xto, yto)

  animate_actual(xfrom, yfrom, xto, yfrom, 4)
  animate_actual(xto, yfrom, xto, yto, 10)

end

procedure animate_actual(xfrom, yfrom, xto, yto, steps) # attribs already set local x, y, xstep, ystep, lastx, lasty

  x -:= xstep := (xto - (x := xfrom))/steps
  y -:= ystep := (yto - (y := yfrom))/steps
  every 1 to steps do {      
     FillArc(lastx := x +:= xstep, lasty := y +:= ystep, pegsize, pegsize)
     WDelay(delay)      # wait in ms
     FillArc(x, y, pegsize, pegsize)
     }

end

procedure draw_ball(x) static ballcounts initial ballcounts := table(0)

  FillArc(x, height-(ballcounts[x] +:= 1)*pegsize, pegsize, pegsize)

end</lang>