extra/rosetta-code/one-d-cellular/one-d-cellular.factor

   1 ! Copyright (c) 2012 Anonymous
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: bit-arrays io kernel math sequences ;
   4 IN: rosetta-code.one-d-cellular
   5
   6 ! http://rosettacode.org/wiki/One-dimensional_cellular_automata
   7
   8 ! Assume an array of cells with an initial distribution of live
   9 ! and dead cells, and imaginary cells off the end of the array
  10 ! having fixed values.
  11
  12 ! Cells in the next generation of the array are calculated based
  13 ! on the value of the cell and its left and right nearest
  14 ! neighbors in the current generation. If, in the following
  15 ! table, a live cell is represented by 1 and a dead cell by 0 then
  16 ! to generate the value of the cell at a particular index in the
  17 ! array of cellular values you use the following table:
  18
  19 ! 000 -> 0  #
  20 ! 001 -> 0  #
  21 ! 010 -> 0  # Dies without enough neighbors
  22 ! 011 -> 1  # Needs one neighbor to survive
  23 ! 100 -> 0  #
  24 ! 101 -> 1  # Two neighbors giving birth
  25 ! 110 -> 1  # Needs one neighbor to survive
  26 ! 111 -> 0  # Starved to death.
  27
  28 : bool-sum ( bool1 bool2 -- sum )
  29     [ [ 2 ] [ 1 ] if ]
  30     [ [ 1 ] [ 0 ] if ] if ;
  31
  32 :: neighbors ( index world -- # )
  33     index [ 1 - ] [ 1 + ] bi [ world ?nth ] bi@ bool-sum ;
  34
  35 : count-neighbors ( world -- neighbours )
  36     [ length <iota> ] keep [ neighbors ] curry map ;
  37
  38 : life-law ( alive? neighbors -- alive? )
  39     swap [ 1 = ] [ 2 = ] if ;
  40
  41 : step ( world -- world' )
  42     dup count-neighbors [ life-law ] ?{ } 2map-as ;
  43
  44 : print-cellular ( world -- )
  45     [ CHAR: # CHAR: _ ? ] "" map-as print ;
  46
  47 : main-cellular ( -- )
  48     ?{ f t t t f t t f t f t f t f t f f t f f }
  49     10 [ dup print-cellular step ] times print-cellular ;
  50
  51 MAIN: main-cellular