Galton box animation

Galton box animation
You are encouraged to solve this task according to the task description, using any language you may know.

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.

AutoHotkey

Uses an edit box for the (text based) animation <lang AutoHotkey>AutoTrim Off

User settings

bottompegs := 6 SleepTime  := 200 fallspace  := 30

create the board

out := (pad2 := Space(bottompegs*2+1)) "`n" Loop % bottompegs { out .= Space(bottompegs-A_Index+1) Loop % A_Index out .= "* " out .= Space(bottompegs-A_Index+1) . "`n" } StringTrimRight, strboard, out, 1 ; remove last newline Loop % fallspace-1 strboard .= "`n" . pad2 strboard .= "`n" Loop % bottompegs*2+1 strboard .= "="

Create Gui

Gui Font, , Consolas Gui -Caption Gui Margin, 0, 0 Gui, Add, edit, -VScroll vE, % strboard Gui Show Loop { ballX := bottompegs+1, BallY := 1 strboard := ChangeChar(strboard, BallX, ballY, "O") GuiControl,, E, % strboard sleep SleepTime ; Make ball fall and bounce Loop % bottompegs { strboard := ChangeChar(strboard, BallX, BallY, " ") ballY += 1 ballX += RandAdd() ; MsgBox % ballX ", " ballY GuiControl,, E, % strboard := ChangeChar(strboard, ballX, ballY, "O") sleep SleepTime } ; now fall to the bottom While GetChar(strboard, BallX, BallY+1) = A_Space { strboard := ChangeChar(strboard, BallX, BallY, " ") BallY += 1 strboard := ChangeChar(strboard, BallX, BallY, "O") GuiControl,, E, % strboard sleep SleepTime } } ~Esc:: GuiClose: ExitApp

Space(n){ If n return " " Space(n-1) return "" } RandAdd(){ Random, n, 3, 4 return (n=3 ? -1 : 1) }

GetChar(s, x, y){ Loop Parse, s, `n if (A_Index = y) return SubStr(A_LoopField, x, 1) } ChangeChar(s, x, y, c){ Loop Parse, s, `n { If (A_Index = y) { Loop Parse, A_LoopField If (A_Index = x) out .= c else out .= A_LoopField } else out .= A_LoopField out .= "`n" } StringTrimRight, out, out, 1 ; removes the last newline return out }</lang>

C

<lang c>#include <stdio.h>

1. include <stdlib.h>
2. include <string.h>

1. define BALLS 1024

int n, w, h = 45, *x, *y, cnt = 0; char *b;

1. define B(y, x) b[(y)*w + x]
2. define C(y, x) ' ' == b[(y)*w + x]
3. define V(i) B(y[i], x[i])

inline int rnd(int a) { return (rand()/(RAND_MAX/a))%a; }

void show_board() { int i, j; for (puts("\033[H"), i = 0; i < h; i++, putchar('\n')) for (j = 0; j < w; j++, putchar(' ')) printf(B(i, j) == '*' ? C(i - 1, j) ? "\033[32m%c\033[m" : "\033[31m%c\033[m" : "%c", B(i, j)); }

void init() { int i, j; puts("\033[H\033[J"); b = malloc(w * h); memset(b, ' ', w * h);

x = malloc(sizeof(int) * BALLS * 2); y = x + BALLS;

for (i = 0; i < n; i++) for (j = -i; j <= i; j += 2) B(2 * i+2, j + w/2) = '*'; srand(time(0)); }

void move(int idx) { int xx = x[idx], yy = y[idx], c, kill = 0, sl = 3, o = 0;

if (yy < 0) return; if (yy == h - 1) { y[idx] = -1; return; }

switch(c = B(yy + 1, xx)) { case ' ': yy++; break; case '*': sl = 1; default: if (xx < w - 1 && C(yy, xx + 1) && C(yy + 1, xx + 1)) if (!rnd(sl++)) o = 1; if (xx && C(yy, xx - 1) && C(yy + 1, xx - 1)) if (!rnd(sl++)) o = -1; if (!o) kill = 1; xx += o; }

c = V(idx); V(idx) = ' '; idx[y] = yy, idx[x] = xx; B(yy, xx) = c; if (kill) idx[y] = -1; }

int run(void) { static int step = 0; int i; for (i = 0; i < cnt; i++) move(i); if (2 == ++step && cnt < BALLS) { step = 0; x[cnt] = w/2; y[cnt] = 0; if (V(cnt) != ' ') return 0; V(cnt) = rnd(80) + 43; cnt++; } return 1; }

int main(int c, char **v) { if (c < 2 || (n = atoi(v[1])) <= 3) n = 5; if (n >= 20) n = 20; w = n * 2 + 1; init();

do { show_board(), usleep(60000); } while (run());

return 0; }</lang>

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>

Ruby

Library: Shoes

Sample display of Ruby solution

<lang ruby>$rows_of_pins = 12 $width = $rows_of_pins * 10 + ($rows_of_pins+1)*14

Shoes.app(

   :width => $width + 14,
   :title => "Galton Box"

) do

 @bins = Array.new($rows_of_pins+1, 0)

 @x_coords = Array.new($rows_of_pins) {Array.new}
 @y_coords = Array.new($rows_of_pins)
 stack(:width => $width) do
   stroke gray
   fill gray
   1.upto($rows_of_pins) do |row|
     y = 14 + 24*row
     @y_coords[row-1] = y
     row.times do |i|
       x = $width / 2 + (i - 0.5*row)*24 + 14
       @x_coords[row-1] << x
       oval x+2, y, 6
     end
   end
 end
 @y_coords << @y_coords[-1] + 24
 @x_coords << @x_coords[-1].map {|x| x-12} + [@x_coords[-1][-1]+12]

 @balls = stack(:width => $width) do
   stroke red
   fill red
 end.move(0,0)

 @histogram = stack(:width => $width) do
   nostroke
   fill black
 end.move(0, @y_coords[-1] + 10)

 @paused = false
 keypress do |key|
   case key
   when "\x11", :control_q
     exit
   when "\x10", :control_p
     @paused = !@paused
   end
 end

 @ball_row = 0
 @ball_col = 0
 animate(2*$rows_of_pins) do
   if not @paused
     y = @y_coords[@ball_row] - 12
     x = @x_coords[@ball_row][@ball_col]
     @balls.clear {oval x, y, 10}
     @ball_row += 1
     if @ball_row <= $rows_of_pins
       @ball_col += 1 if rand >= 0.5
     else
       @bins[@ball_col] += 1
       @ball_row = @ball_col = 0
       update_histogram
     end
   end
 end

 def update_histogram
   y = @y_coords[-1] + 10
   @histogram.clear do
     @bins.each_with_index do |num, i|
       if num > 0
         x = @x_coords[-1][i]
         rect x-6, 0, 24, num
       end
     end
   end
 end

end</lang>