Sierpinski triangle (Forth)

From LiteratePrograms

Other implementations: C | Erlang | Forth | Haskell | JavaScript | OCaml | Perl | Python | Scheme | Sed

This program will display a crude Sierpinski triangle by calculating a simple one-dimensional cellular automaton and displaying its changing state over time.

We will use a byte array to represent the current state of the one-dimensional universe. We allocate an extra byte at the end (1+ allot and 1+ erase) to avoid overflow during the later generational calculation. init-state clears the array and sets one cell to Full. .state prints the current state, showing a space for Empty cells and '@' for full cells. (. is typically pronounced "print" in Forth.)

<<state>>=
80 constant size
create state size 1+ allot
: init-state
  state size 1+ erase
  1 state size 2/ + c! ;
ctable symbol  bl c,  char @ c,
: .state
  cr size 0 do
    state i + c@ symbol emit
  loop ;

The CREATE-DOES> construct works well for defining the character tables we use for the state transitions and the output symbols.

<<ctable>>=
: ctable   create does> + c@ ;

The particular cellular automaton for generating a Sierpinski triangle looks at the current cell and the two neighboring cells. There are eight possible permutations of the states of these three cells (which will henceforth be called the neighborhood), and we will represent the automaton as a table mapping the state of the neighborhood (represented as a number from 0..7) to the next state of the current cell. The rule stated succinctly is to clear the cell if the neighborhood cells are the same (all Empty or all Full) and set the cell if the three cells differ.

<<automaton rules>>=
\ the input has three bits: b0,b1,b2 = next neighbor, current cell, previous neighbor
ctable transition
\ 000  001  010  011  100  101  110  111
   0 c, 1 c, 1 c, 1 c, 1 c, 1 c, 1 c, 0 c,

The gen word will keep the neighborhood of the current cell on the stack. It is easy to obtain the neighborhood of the current cell from the neighborhood of the previous cell. You just shift the window: shift right (2*), shifting the state of the next neighbor into the LSB (state i + 1+ c@ or) and taking away the old neighbor from the MSB by restricting the result to three bits (7 and).

<<current neighborhood>>=
2*  state i + 1+ c@ or  7 and

gen invokes the automaton to obtain the next generation of the state from the previous state.

<<gen>>=
: gen
  state c@ ( neighborhood )
  size 0 do
    current neighborhood
    dup transition state i + c!
  loop drop ;

sierpinski will calculate and show n generations of the automaton (including the initial one), displaying a Sierpinski triangle n characters tall and 2n+1 characters wide. Powers of two for n generate complete triangles.

<<sierpinski.f>>=
ctable
state
automaton rules
gen
: sierpinski ( n -- )
  init-state .state
  1 ?do gen .state loop ;
32 sierpinski bye

Download code