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.

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>