152 lines
3.8 KiB
Forth
152 lines
3.8 KiB
Forth
# 1D Cellular Automota
|
|
|
|
Assume an array of cells with an initial distribution of live
|
|
and dead cells, and imaginary cells off the end of the array
|
|
having fixed values.
|
|
|
|
Cells in the next generation of the array are calculated based
|
|
on the value of the cell and its left and right nearest neighbours
|
|
in the current generation.
|
|
|
|
If, in the following table, a live cell is represented by 1 and
|
|
a dead cell by 0 then to generate the value of the cell at a
|
|
particular index in the array of cellular values you use the
|
|
following table:
|
|
|
|
000 -> 0 #
|
|
001 -> 0 #
|
|
010 -> 0 # Dies without enough neighbours
|
|
011 -> 1 # Needs one neighbour to survive
|
|
100 -> 0 #
|
|
101 -> 1 # Two neighbours giving birth
|
|
110 -> 1 # Needs one neighbour to survive
|
|
111 -> 0 # Starved to death.
|
|
|
|
I had originally written an implementation of this in RETRO 11. For
|
|
RETRO 12 I took advantage of new language features and some further
|
|
considerations into the rules for this task.
|
|
|
|
The first word, `string,` inlines a string to `here`. I'll use this to
|
|
setup the initial input.
|
|
|
|
~~~
|
|
:string, (s-) [ , ] s:for-each #0 , ;
|
|
~~~
|
|
|
|
The next two lines setup an initial generation and a buffer for the
|
|
evolved generation. In this case, `This` is the current generation and
|
|
`Next` reflects the next step in the evolution.
|
|
|
|
~~~
|
|
'This d:create
|
|
'.###.##.#.#.#.#..#.. string,
|
|
|
|
'Next d:create
|
|
'.................... string,
|
|
~~~
|
|
|
|
I use `display` to show the current generation.
|
|
|
|
~~~
|
|
:display (-)
|
|
&This s:put nl ;
|
|
~~~
|
|
|
|
As might be expected, `update` copies the `Next` generation to the
|
|
`This` generation, setting things up for the next cycle.
|
|
|
|
~~~
|
|
:update (-)
|
|
&Next &This dup s:length copy ;
|
|
~~~
|
|
|
|
The word `group` extracts a group of three cells. This data will be
|
|
passed to `evolve` for processing.
|
|
|
|
~~~
|
|
:group (a-nnn)
|
|
[ fetch ]
|
|
[ n:inc fetch ]
|
|
[ n:inc n:inc fetch ] tri ;
|
|
~~~
|
|
|
|
I use `evolve` to decide how a cell should change, based on its initial
|
|
state with relation to its neighbors.
|
|
|
|
In the prior implementation this part was much more complex as I tallied
|
|
things up and had separate conditions for each combination. This time I
|
|
take advantage of the fact that only cells with two neighbors will be
|
|
alive in the next generation. So the process is:
|
|
|
|
- take the data from `group`
|
|
- compare to `$#` (for living cells)
|
|
- add the flags
|
|
- if the result is `#-2`, the cell should live
|
|
- otherwise it'll be dead
|
|
|
|
~~~
|
|
:evolve (nnn-c)
|
|
[ $# eq? ] tri@ + +
|
|
#-2 eq? [ $# ] [ $. ] choose ;
|
|
~~~
|
|
|
|
For readability I separated out the next few things. `at` takes an index
|
|
and returns the address in `This` starting with the index.
|
|
|
|
~~~
|
|
:at (n-na)
|
|
&This over + ;
|
|
~~~
|
|
|
|
The `record` word adds the evolved value to a buffer. In this case my
|
|
`generation` code will set the buffer to `Next`.
|
|
|
|
~~~
|
|
:record (c-)
|
|
buffer:add n:inc ;
|
|
~~~
|
|
|
|
And now to tie it all together. Meet `generation`, the longest bit of
|
|
code in this sample. It has several bits:
|
|
|
|
- setup a new buffer pointing to `Next`
|
|
- this also preserves the old buffer
|
|
- setup a loop for each cell in `This`
|
|
- initial loop index at -1, to ensure proper dummy state for first cell
|
|
- get length of `This` generation
|
|
- perform a loop for each item in the generation, updating `Next` as it goes
|
|
- copy `Next` to `This` using `update`.
|
|
|
|
~~~
|
|
:generation (-)
|
|
[ &Next buffer:set
|
|
#-1 &This s:length
|
|
[ at group evolve record ] times drop
|
|
update
|
|
] buffer:preserve ;
|
|
~~~
|
|
|
|
The last bit is a helper. It takes a number of generations and displays
|
|
the state, then runs a `generation`.
|
|
|
|
~~~
|
|
:generations (n-)
|
|
[ display generation ] times ;
|
|
~~~
|
|
|
|
And a text. The output should be:
|
|
|
|
.###.##.#.#.#.#..#..
|
|
.#.#####.#.#.#......
|
|
..##...##.#.#.......
|
|
..##...###.#........
|
|
..##...#.##.........
|
|
..##....###.........
|
|
..##....#.#.........
|
|
..##.....#..........
|
|
..##................
|
|
..##................
|
|
|
|
~~~
|
|
#10 generations
|
|
~~~
|