One-dimensional cellular automata
You are encouraged to solve this task according to the task description, using any language you may know.
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.
Ada
<lang ada>with Ada.Text_IO; use Ada.Text_IO;
procedure Cellular_Automata is
type Petri_Dish is array (Positive range <>) of Boolean;
procedure Step (Culture : in out Petri_Dish) is
Left : Boolean := False;
This : Boolean;
Right : Boolean;
begin
for Index in Culture'First..Culture'Last - 1 loop
Right := Culture (Index + 1);
This := Culture (Index);
Culture (Index) := (This and (Left xor Right)) or (not This and Left and Right);
Left := This;
end loop;
Culture (Culture'Last) := Culture (Culture'Last) and not Left;
end Step;
procedure Put (Culture : Petri_Dish) is
begin
for Index in Culture'Range loop
if Culture (Index) then
Put ('#');
else
Put ('_');
end if;
end loop;
end Put;
Culture : Petri_Dish :=
( False, True, True, True, False, True, True, False, True, False, True,
False, True, False, True, False, False, True, False, False
);
begin
for Generation in 0..9 loop
Put ("Generation" & Integer'Image (Generation) & ' ');
Put (Culture);
New_Line;
Step (Culture);
end loop;
end Cellular_Automata;</lang> The implementation defines Petri dish type with Boolean items identifying whether a place is occupied by a living cell. State transition is determined by a simple Boolean expression of three arguments. Sample output:
Generation 0 _###_##_#_#_#_#__#__ Generation 1 _#_#####_#_#_#______ Generation 2 __##___##_#_#_______ Generation 3 __##___###_#________ Generation 4 __##___#_##_________ Generation 5 __##____###_________ Generation 6 __##____#_#_________ Generation 7 __##_____#__________ Generation 8 __##________________ Generation 9 __##________________
ALGOL 68
Using the low level packed arrays of BITS manipulation operators
<lang algol68>INT stop generation = 9; INT universe width = 20; FORMAT alive or dead = $b("#","_")$;
BITS universe := 2r01110110101010100100;
# universe := BIN ( ENTIER ( random * max int ) ); #
INT upb universe = bits width; INT lwb universe = bits width - universe width + 1;
PROC couple = (BITS parent, INT lwb, upb)BOOL: (
SHORT INT sum := 0; FOR bit FROM lwb TO upb DO sum +:= ABS (bit ELEM parent) OD; sum = 2
);
FOR generation FROM 0 WHILE
printf(($"Generation "d": "$, generation,
$f(alive or dead)$, []BOOL(universe)[lwb universe:upb universe],
$l$));
- WHILE # generation < stop generation DO
BITS next universe := 2r0;
# process the first event horizon manually #
IF couple(universe,lwb universe,lwb universe + 1) THEN
next universe := 2r10
FI;
# process the middle kingdom in a loop #
FOR bit FROM lwb universe + 1 TO upb universe - 1 DO
IF couple(universe,bit-1,bit+1) THEN
next universe := next universe OR 2r1
FI;
next universe := next universe SHL 1
OD;
# process the last event horizon manually # IF couple(universe, upb universe - 1, upb universe) THEN next universe := next universe OR 2r1 FI; universe := next universe
OD</lang> Output:
Generation 0: _###_##_#_#_#_#__#__ Generation 1: _#_#####_#_#_#______ Generation 2: __##___##_#_#_______ Generation 3: __##___###_#________ Generation 4: __##___#_##_________ Generation 5: __##____###_________ Generation 6: __##____#_#_________ Generation 7: __##_____#__________ Generation 8: __##________________ Generation 9: __##________________
Using high level BOOL arrays
<lang algol68>INT stop generation = 9; <lang algol68>INT stop generation = 9; INT upb universe = 20; FORMAT alive or dead = $b("#","_")$;
BITS bits universe := 2r01110110101010100100;
# bits universe := BIN ( ENTIER ( random * max int ) ); #
[upb universe] BOOL universe := []BOOL(bits universe)[bits width - upb universe + 1:];
PROC couple = (REF[]BOOL parent)BOOL: (
SHORT INT sum := 0; FOR bit FROM LWB parent TO UPB parent DO sum +:= ABS (parent[bit]) OD; sum = 2
);
FOR generation FROM 0 WHILE
printf(($"Generation "d": "$, generation,
$f(alive or dead)$, universe,
$l$));
- WHILE # generation < stop generation DO
[UPB universe]BOOL next universe; # process the first event horizon manually # next universe[1] := couple(universe[:2]); # process the middle kingdom in a loop # FOR bit FROM LWB universe + 1 TO UPB universe - 1 DO next universe[bit] := couple(universe[bit-1:bit+1]) OD;
# process the last event horizon manually # next universe[UPB universe] := couple(universe[UPB universe - 1: ]); universe := next universe
OD</lang> Output:
Generation 0: _###_##_#_#_#_#__#__ Generation 1: _#_#####_#_#_#______ Generation 2: __##___##_#_#_______ Generation 3: __##___###_#________ Generation 4: __##___#_##_________ Generation 5: __##____###_________ Generation 6: __##____#_#_________ Generation 7: __##_____#__________ Generation 8: __##________________ Generation 9: __##________________
AutoHotkey
ahk discussion <lang autohotkey>n := 22, n1 := n+1, v0 := v%n1% := 0 ; set grid dimensions, and fixed cells
Loop % n { ; draw a line of checkboxes
v%A_Index% := 0 Gui Add, CheckBox, % "y10 w17 h17 gCheck x" A_Index*17-5 " vv" A_Index
} Gui Add, Button, x+5 y6, step ; button to step to next generation Gui Show Return
Check:
GuiControlGet %A_GuiControl% ; set cells by the mouse
Return
ButtonStep: ; move to next generation
Loop % n
i := A_Index-1, j := i+2, w%A_Index% := v%i%+v%A_Index%+v%j% = 2
Loop % n
GuiControl,,v%A_Index%, % v%A_Index% := w%A_Index%
Return
GuiClose: ; exit when GUI is closed ExitApp</lang>
BASIC
<lang qbasic>DECLARE FUNCTION life$ (lastGen$) DECLARE FUNCTION getNeighbors! (group$) CLS start$ = "_###_##_#_#_#_#__#__" numGens = 10 FOR i = 0 TO numGens - 1 PRINT "Generation"; i; ": "; start$ start$ = life$(start$) NEXT i
FUNCTION getNeighbors (group$) ans = 0 IF (MID$(group$, 1, 1) = "#") THEN ans = ans + 1 IF (MID$(group$, 3, 1) = "#") THEN ans = ans + 1 getNeighbors = ans END FUNCTION
FUNCTION life$ (lastGen$) newGen$ = "" FOR i = 1 TO LEN(lastGen$) neighbors = 0 IF (i = 1) THEN 'left edge IF MID$(lastGen$, 2, 1) = "#" THEN neighbors = 1 ELSE neighbors = 0 END IF ELSEIF (i = LEN(lastGen$)) THEN 'right edge IF MID$(lastGen$, LEN(lastGen$) - 1, 1) = "#" THEN neighbors = 1 ELSE neighbors = 0 END IF ELSE 'middle neighbors = getNeighbors(MID$(lastGen$, i - 1, 3)) END IF
IF (neighbors = 0) THEN 'dies or stays dead with no neighbors newGen$ = newGen$ + "_" END IF IF (neighbors = 1) THEN 'stays with one neighbor newGen$ = newGen$ + MID$(lastGen$, i, 1) END IF IF (neighbors = 2) THEN 'flips with two neighbors IF MID$(lastGen$, i, 1) = "#" THEN newGen$ = newGen$ + "_" ELSE newGen$ = newGen$ + "#" END IF END IF NEXT i life$ = newGen$ END FUNCTION</lang> Output:
Generation 0 : _###_##_#_#_#_#__#__ Generation 1 : _#_#####_#_#_#______ Generation 2 : __##___##_#_#_______ Generation 3 : __##___###_#________ Generation 4 : __##___#_##_________ Generation 5 : __##____###_________ Generation 6 : __##____#_#_________ Generation 7 : __##_____#__________ Generation 8 : __##________________ Generation 9 : __##________________
BBC BASIC
<lang bbcbasic> DIM rule$(7)
rule$() = "0", "0", "0", "1", "0", "1", "1", "0"
now$ = "01110110101010100100"
FOR generation% = 0 TO 9
PRINT "Generation " ; generation% ":", now$
next$ = ""
FOR cell% = 1 TO LEN(now$)
next$ += rule$(EVAL("%"+MID$("0"+now$+"0", cell%, 3)))
NEXT cell%
SWAP now$, next$
NEXT generation%</lang>
Output:
Generation 0: 01110110101010100100 Generation 1: 01011111010101000000 Generation 2: 00110001101010000000 Generation 3: 00110001110100000000 Generation 4: 00110001011000000000 Generation 5: 00110000111000000000 Generation 6: 00110000101000000000 Generation 7: 00110000010000000000 Generation 8: 00110000000000000000 Generation 9: 00110000000000000000
Befunge
<lang befunge>v
" !!! !! ! ! ! ! ! " ,*25 <v
" " ,*25,,,,,,,,,,,,,,,,,,,,<v
" " ,*25,,,,,,,,,,,,,,,,,,,,<v
" " ,*25,,,,,,,,,,,,,,,,,,,,<v
" " ,*25,,,,,,,,,,,,,,,,,,,,<v
" " ,*25,,,,,,,,,,,,,,,,,,,,<v
" " ,*25,,,,,,,,,,,,,,,,,,,,<v
" " ,*25,,,,,,,,,,,,,,,,,,,,<v
" " ,*25,,,,,,,,,,,,,,,,,,,,<v
v$< @,*25,,,,,,,,,,,,,,,,,,,,<
>110p3>:1-10gg" "-4* \:10gg" "-2* \:1+10gg" "-\:54*1+`#v_20p++ :2`#v_ >:4`#v_> >$" "v
>:3`#^_v>:6`|
^ >$$$$320p10g1+:9`v > >$"!"> 20g10g1+p 20g1+:20p
^ v_10p10g
> ^</lang>
C
<lang c>#include <stdio.h>
- include <string.h>
char trans[] = "___#_##_";
- define v(i) (cell[i] != '_')
int evolve(char cell[], char backup[], int len) { int i, diff = 0;
for (i = 0; i < len; i++) { /* use left, self, right as binary number bits for table index */ backup[i] = trans[ v(i-1) * 4 + v(i) * 2 + v(i + 1) ]; diff += (backup[i] != cell[i]); }
strcpy(cell, backup); return diff; }
int main() { char c[] = "_###_##_#_#_#_#__#__\n", b[] = "____________________\n";
do { printf(c + 1); } while (evolve(c + 1, b + 1, sizeof(c) - 3)); return 0; }</lang>output
###_##_#_#_#_#__#__ #_#####_#_#_#______ _##___##_#_#_______ _##___###_#________ _##___#_##_________ _##____###_________ _##____#_#_________ _##_____#__________ _##________________
Similar to above, but without a backup string: <lang c>#include <stdio.h>
char trans[] = "___#_##_";
int evolve(char c[], int len) { int i, diff = 0;
- define v(i) ((c[i] & 15) == 1)
- define each for (i = 0; i < len; i++)
each c[i] = (c[i] == '#'); each c[i] |= (trans[(v(i-1)*4 + v(i)*2 + v(i+1))] == '#') << 4; each diff += (c[i] & 0xf) ^ (c[i] >> 4); each c[i] = (c[i] >> 4) ? '#' : '_';
- undef each
- undef v
return diff; }
int main() { char c[] = "_###_##_#_#_#_#__#__\n";
do { printf(c + 1); } while (evolve(c + 1, sizeof(c) - 3)); return 0; }</lang>
C++
Uses std::bitset for efficient packing of bit values. <lang Cpp>#include <iostream>
- include <bitset>
- include <string>
const int ArraySize = 20; const int NumGenerations = 10; const std::string Initial = "0011101101010101001000";
int main() {
// + 2 for the fixed ends of the array std::bitset<ArraySize + 2> array(Initial);
for(int j = 0; j < NumGenerations; ++j)
{
std::bitset<ArraySize + 2> tmpArray(array);
for(int i = ArraySize; i >= 1 ; --i)
{
if(array[i])
std::cout << "#";
else
std::cout << "_";
int val = (int)array[i-1] << 2 | (int)array[i] << 1 | (int)array[i+1];
tmpArray[i] = (val == 3 || val == 5 || val == 6);
}
array = tmpArray;
std::cout << std::endl;
}
}</lang>
Output:
_###_##_#_#_#_#__#__ _#_#####_#_#_#______ __##___##_#_#_______ __##___###_#________ __##___#_##_________ __##____###_________ __##____#_#_________ __##_____#__________ __##________________ __##________________
C#
<lang csharp>using System; using System.Collections.Generic;
namespace prog { class MainClass { const int n_iter = 10; static int[] f = { 0, 1, 1, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 0 };
public static void Main (string[] args) { for( int i=0; i<f.Length; i++ ) Console.Write( f[i]==0 ? "-" : "#" ); Console.WriteLine("");
int[] g = new int[f.Length]; for( int n=n_iter; n!=0; n-- ) { for( int i=1; i<f.Length-1; i++ ) { if ( (f[i-1] ^ f[i+1]) == 1 ) g[i] = f[i]; else if ( f[i] == 0 && (f[i-1] & f[i+1]) == 1 ) g[i] = 1; else g[i] = 0; } g[0] = ( (f[0] & f[1]) == 1 ) ? 1 : 0; g[g.Length-1] = ( (f[f.Length-1] & f[f.Length-2]) == 1 ) ? 1 : 0;
int[] tmp = f; f = g; g = tmp;
for( int i=0; i<f.Length; i++ ) Console.Write( f[i]==0 ? "-" : "#" ); Console.WriteLine(""); } } } }</lang>
Clojure
<lang clojure>(ns one-dimensional-cellular-automata
(:require (clojure.contrib (string :as s))))
(defn next-gen [cells]
(loop [cs cells ncs (s/take 1 cells)]
(let [f3 (s/take 3 cs)]
(if (= 3 (count f3))
(recur (s/drop 1 cs)
(str ncs (if (= 2 (count (filter #(= \# %) f3))) "#" "_")))
(str ncs (s/drop 1 cs))))))
(defn generate [n cells]
(if (= n 0) '() (cons cells (generate (dec n) (next-gen cells)))))
</lang> <lang clojure>one-dimensional-cellular-automata> (doseq [cells (generate 9 "_###_##_#_#_#_#__#__")]
(println cells))
_###_##_#_#_#_#__#__ _#_#####_#_#_#______ __##___##_#_#_______ __##___###_#________ __##___#_##_________ __##____###_________ __##____#_#_________ __##_____#__________ __##________________ nil </lang>
CoffeeScript
<lang coffeescript>
- We could cheat and count the bits, but let's keep this general.
- . = dead, # = alive, middle cells survives iff one of the configurations
- below is satisified.
survival_scenarios = [
'.##' # happy neighbors '#.#' # birth '##.' # happy neighbors
]
b2c = (b) -> if b then '#' else '.'
cell_next_gen = (left_alive, me_alive, right_alive) ->
fingerprint = b2c(left_alive) + b2c(me_alive) + b2c(right_alive) fingerprint in survival_scenarios
cells_for_next_gen = (cells) ->
# This function assumes a finite array, i.e. cells can't be born outside # the original array. (cell_next_gen(cells[i-1], cells[i], cells[i+1]) for i in [0...cells.length])
display = (cells) ->
(b2c(is_alive) for is_alive in cells).join
simulate = (cells) ->
while true console.log display cells new_cells = cells_for_next_gen cells break if display(cells) == display(new_cells) cells = new_cells console.log "equilibrium achieved"
simulate (c == '#' for c in ".###.##.#.#.#.#..#..") </lang> output <lang> > coffee cellular_automata.coffee .###.##.#.#.#.#..#.. .#.#####.#.#.#...... ..##...##.#.#....... ..##...###.#........ ..##...#.##......... ..##....###......... ..##....#.#......... ..##.....#.......... ..##................ equilibrium achieved </lang>
Common Lisp
Based upon the Ruby version. <lang lisp>(defun value (x)
(assert (> (length x) 1)) (coerce x 'simple-bit-vector))
(defun count-neighbors-and-self (value i)
(flet ((ref (i)
(if (array-in-bounds-p value i)
(bit value i)
0)))
(declare (inline ref))
(+ (ref (1- i))
(ref i)
(ref (1+ i)))))
(defun next-cycle (value)
(let ((new-value (make-array (length value) :element-type 'bit)))
(loop for i below (length value)
do (setf (bit new-value i)
(if (= 2 (count-neighbors-and-self value i))
1
0)))
new-value))
(defun print-world (value &optional (stream *standard-output*))
(loop for i below (length value)
do (princ (if (zerop (bit value i)) #\. #\#)
stream))
(terpri stream))</lang>
<lang lisp>CL-USER> (loop for previous-value = nil then value
for value = #*01110110101010100100 then (next-cycle value)
until (equalp value previous-value)
do (print-world value))
.###.##.#.#.#.#..#.. .#.#####.#.#.#...... ..##...##.#.#....... ..##...###.#........ ..##...#.##......... ..##....###......... ..##....#.#......... ..##.....#.......... ..##................</lang>
D
<lang d>import std.stdio, std.algorithm;
void main() {
enum ngenerations = 10; enum initial = "0011101101010101001000"; enum table = "00010110";
char[initial.length + 2] A = '0', B = '0';
A[1 .. $-1] = initial;
foreach (_; 0 .. ngenerations) {
foreach (i; 1 .. A.length-1) {
write(A[i] == '0' ? '_' : '#');
int val = (A[i-1]-'0' << 2) | (A[i]-'0' << 1) | (A[i+1]-'0');
B[i] = table[val];
}
swap(A, B);
writeln();
}
}</lang> Output:
__###_##_#_#_#_#__#___ __#_#####_#_#_#_______ ___##___##_#_#________ ___##___###_#_________ ___##___#_##__________ ___##____###__________ ___##____#_#__________ ___##_____#___________ ___##_________________ ___##_________________
DWScript
<lang delphi>const ngenerations = 10; const table = [0, 0, 0, 1, 0, 1, 1, 0];
var a := [0, 0, 1, 1, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 0, 0]; var b := a;
var i, j : Integer; for i := 1 to ngenerations do begin
for j := a.low+1 to a.high-1 do begin
if a[j] = 0 then
Print('_')
else Print('#');
var val := (a[j-1] shl 2) or (a[j] shl 1) or a[j+1];
b[j] := table[val];
end;
var tmp := a;
a := b;
b := tmp;
PrintLn();
end; </lang> Output:
_###_##_#_#_#_#__#__ _#_#####_#_#_#______ __##___##_#_#_______ __##___###_#________ __##___#_##_________ __##____###_________ __##____#_#_________ __##_____#__________ __##________________ __##________________
E
<lang e>def step(state, rule) {
var result := state(0, 1) # fixed left cell
for i in 1..(state.size() - 2) {
# Rule function receives the substring which is the neighborhood
result += E.toString(rule(state(i-1, i+2)))
}
result += state(state.size() - 1) # fixed right cell
return result
}
def play(var state, rule, count, out) {
out.print(`0 | $state$\n`)
for i in 1..count {
state := step(state, rosettaRule)
out.print(`$i | $state$\n`)
}
return state
}</lang>
<lang e>def rosettaRule := [
" " => " ", " #" => " ", " # " => " ", " ##" => "#", "# " => " ", "# #" => "#", "## " => "#", "###" => " ",
].get
? play(" ### ## # # # # # ", rosettaRule, 9, stdout) 0 | ### ## # # # # # 1 | # ##### # # # 2 | ## ## # # 3 | ## ### # 4 | ## # ## 5 | ## ### 6 | ## # # 7 | ## # 8 | ## 9 | ##
- value: " ## "</lang>
Euphoria
<lang euphoria>include machine.e
function rules(integer tri)
return tri = 3 or tri = 5 or tri = 6
end function
function next_gen(atom gen)
atom new, bit
new = rules(and_bits(gen,3)*2) -- work with the first bit separately
bit = 2
while gen > 0 do
new += bit*rules(and_bits(gen,7))
gen = floor(gen/2) -- shift right
bit *= 2 -- shift left
end while
return new
end function
constant char_clear = '_', char_filled = '#'
procedure print_gen(atom gen)
puts(1, int_to_bits(gen,32) * (char_filled - char_clear) + char_clear) puts(1,'\n')
end procedure
function s_to_gen(sequence s)
s -= char_clear return bits_to_int(s)
end function
atom gen, prev integer n
n = 0 prev = 0 gen = bits_to_int(rand(repeat(2,32))-1) while gen != prev do
printf(1,"Generation %d: ",n) print_gen(gen) prev = gen gen = next_gen(gen) n += 1
end while
printf(1,"Generation %d: ",n) print_gen(gen)</lang>
Output:
Generation 0: ####__#_###_#_#_#_#_##___##_##__ Generation 1: ___#___##_##_#_#_#_###___#####__ Generation 2: _______######_#_#_##_#___#___#__ Generation 3: _______#____##_#_####___________ Generation 4: ____________###_##__#___________ Generation 5: ____________#_####______________ Generation 6: _____________##__#______________ Generation 7: _____________##_________________ Generation 8: _____________##_________________
Factor
<lang factor>USING: bit-arrays io kernel locals math sequences ; IN: cellular
- bool-sum ( bool1 bool2 -- sum )
[ [ 2 ] [ 1 ] if ] [ [ 1 ] [ 0 ] if ] if ;
- neighbours ( index world -- # )
index [ 1 - ] [ 1 + ] bi [ world ?nth ] bi@ bool-sum ;
- count-neighbours ( world -- neighbours )
[ length iota ] keep [ neighbours ] curry map ;
- life-law ( alive? neighbours -- alive? )
swap [ 1 = ] [ 2 = ] if ;
- step ( world -- world' )
dup count-neighbours [ life-law ] ?{ } 2map-as ;
- print-cellular ( world -- )
[ CHAR: # CHAR: _ ? ] "" map-as print ;
- main-cellular ( -- )
?{ f t t t f t t f t f t f t f t f f t f f }
10 [ dup print-cellular step ] times print-cellular ;
MAIN: main-cellular </lang>
( scratchpad ) "cellular" run _###_##_#_#_#_#__#__ _#_#####_#_#_#______ __##___##_#_#_______ __##___###_#________ __##___#_##_________ __##____###_________ __##____#_#_________ __##_____#__________ __##________________ __##________________ __##________________
Fantom
<lang fantom> class Automaton {
static Int[] evolve (Int[] array)
{
return array.map |Int x, Int i -> Int|
{
if (i == 0)
return ( (x + array[1] == 2) ? 1 : 0)
else if (i == array.size-1)
return ( (x + array[-2] == 2) ? 1 : 0)
else if (x + array[i-1] + array[i+1] == 2)
return 1
else
return 0
}
}
public static Void main ()
{
Int[] array := [0,1,1,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1,0,0]
echo (array.join(""))
Int[] newArray := evolve(array)
while (newArray != array)
{
echo (newArray.join(""))
array = newArray
newArray = evolve(array)
}
}
} </lang>
Forth
<lang forth>: init ( bits count -- )
0 do dup 1 and c, 2/ loop drop ;
20 constant size create state $2556e size init 0 c,
- .state
cr size 0 do state i + c@ if ." #" else space then loop ;
- ctable create does> + c@ ;
ctable rules $68 8 init
- gen
state c@ ( window ) size 0 do 2* state i + 1+ c@ or 7 and dup rules state i + c! loop drop ;
- life1d ( n -- )
.state 1 do gen .state loop ;
10 life1d</lang>
Fortran
<lang fortran>PROGRAM LIFE_1D
IMPLICIT NONE
LOGICAL :: cells(20) = (/ .FALSE., .TRUE., .TRUE., .TRUE., .FALSE., .TRUE., .TRUE., .FALSE., .TRUE., .FALSE., &
.TRUE., .FALSE., .TRUE., .FALSE., .TRUE., .FALSE., .FALSE., .TRUE., .FALSE., .FALSE. /)
INTEGER :: i
DO i = 0, 9
WRITE(*, "(A,I0,A)", ADVANCE = "NO") "Generation ", i, ": "
CALL Drawgen(cells)
CALL Nextgen(cells)
END DO
CONTAINS
SUBROUTINE Nextgen(cells)
LOGICAL, INTENT (IN OUT) :: cells(:)
LOGICAL :: left, centre, right
INTEGER :: i
left = .FALSE.
DO i = 1, SIZE(cells)-1
centre = cells(i)
right = cells(i+1)
IF (left .AND. right) THEN
cells(i) = .NOT. cells(i)
ELSE IF (.NOT. left .AND. .NOT. right) THEN
cells(i) = .FALSE.
END IF
left = centre
END DO
cells(SIZE(cells)) = left .AND. right
END SUBROUTINE Nextgen
SUBROUTINE Drawgen(cells)
LOGICAL, INTENT (IN OUT) :: cells(:)
INTEGER :: i
DO i = 1, SIZE(cells)
IF (cells(i)) THEN
WRITE(*, "(A)", ADVANCE = "NO") "#"
ELSE
WRITE(*, "(A)", ADVANCE = "NO") "_"
END IF
END DO
WRITE(*,*)
END SUBROUTINE Drawgen
END PROGRAM LIFE_1D</lang> Output
Generation 0: _###_##_#_#_#_#__#__ Generation 1: _#_#####_#_#_#______ Generation 2: __##___##_#_#_______ Generation 3: __##___###_#________ Generation 4: __##___#_##_________ Generation 5: __##____###_________ Generation 6: __##____#_#_________ Generation 7: __##_____#__________ Generation 8: __##________________ Generation 9: __##________________
Go
<lang go>package main
import "fmt"
const start = "_###_##_#_#_#_#__#__"
func main() {
g0 := []byte(start)
g1 := []byte(start)
fmt.Println(string(g0))
last := len(g0) - 1
for g := 0; g < 10; g++ {
for i := 1; i < last; i++ {
switch {
case g0[i-1] != g0[i+1]:
g1[i] = g0[i]
case g0[i] == '_':
g1[i] = g0[i-1]
default:
g1[i] = '_'
}
}
fmt.Println(string(g1))
copy(g0, g1)
}
}</lang> Output:
_###_##_#_#_#_#__#__ _#_#####_#_#_#______ __##___##_#_#_______ __##___###_#________ __##___#_##_________ __##____###_________ __##____#_#_________ __##_____#__________ __##________________ __##________________ __##________________
Haskell
<lang haskell>module Life1D where
import Data.List import System.Random import Control.Monad import Control.Arrow
bnd :: [Char] -> Char bnd bs =
case bs of
"_##" -> '#'
"#_#" -> '#'
"##_" -> '#'
_ -> '_'
donxt xs = unfoldr(\xs -> case xs of [_,_] -> Nothing ;
_ -> Just (bnd $ take 3 xs, drop 1 xs)) $ '_':xs++"_"
lahmahgaan xs = init.until (liftM2 (==) last (last. init)) (ap (++)(return. donxt. last)) $ [xs, donxt xs]
main = do
g <- newStdGen
let oersoep = map ("_#"!!). take 36 $ randomRs(0,1) g
mapM_ print . lahmahgaan $ oersoep</lang>
Some output: <lang haskell>*Life1D> mapM_ print . lahmahgaan $ "_###_##_#_#_#_#__#__" "_###_##_#_#_#_#__#__" "_#_#####_#_#_#______" "__##___##_#_#_______" "__##___###_#________" "__##___#_##_________" "__##____###_________" "__##____#_#_________" "__##_____#__________" "__##________________"
- Life1D> main
"__##_##__#____###__#__#_______#_#_##" "__#####_______#_#______________#_###" "__#___#________#________________##_#" "________________________________###_" "________________________________#_#_" "_________________________________#__" "____________________________________"</lang>
Icon and Unicon
<lang icon>
- One dimensional Cellular automaton
record Automaton(size, cells)
procedure make_automaton (size, items)
automaton := Automaton (size, items) while (*items < size) do push (automaton.cells, 0) return automaton
end
procedure automaton_display (automaton)
every (write ! automaton.cells)
end
procedure automaton_evolve (automaton)
revised := make_automaton (automaton.size, [])
# do the left-most cell
if ((automaton.cells[1] + automaton.cells[2]) = 2) then
revised.cells[1] := 1
# do the right-most cell
if ((automaton.cells[automaton.size] + automaton.cells[automaton.size-1]) = 2) then
revised.cells[revised.size] := 1
# do the intermediate cells
every (i := 2 to (automaton.size-1)) do {
if ((automaton.cells[i-1] + automaton.cells[i] + automaton.cells[i+1]) = 2) then
revised.cells[i] := 1
}
return revised
end
procedure main ()
automaton := make_automaton (20, [0,1,1,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1,0,0])
every (1 to 10) do { # generations
automaton_display (automaton)
automaton := automaton_evolve (automaton)
}
end </lang>
An alternative approach is to represent the automaton as a string. The following solution takes advantage of the implicit type coercions between string and numeric values in Icon and Unicon. It also surrounds the automaton with a border of 'dead' (always 0) cells to eliminate the need to special case the first and last cells in the automaton. Although the main procedure displays up to the first 10 generations, the evolve procedure fails if a new generation is unchanged from the previous, stopping the generation cycle early.
<lang unicon>procedure main(A)
A := if *A = 0 then ["01110110101010100100"]
CA := show("0"||A[1]||"0") # add always dead border cells
every CA := show(|evolve(CA)\10) # limit to max of 10 generations
end
procedure show(ca)
write(ca[2:-1]) # omit border cells return ca
end
procedure evolve(CA)
newCA := repl("0",*CA)
every newCA[i := 2 to (*CA-1)] := (CA[i-1]+CA[i]+CA[i+1] = 2, "1")
return CA ~== newCA # fail if no change
end</lang>
A couple of sample runs:
->odca 01110110101010100100 01011111010101000000 00110001101010000000 00110001110100000000 00110001011000000000 00110000111000000000 00110000101000000000 00110000010000000000 00110000000000000000 ->odca 01110110 01110110 01011110 00110010 00110000 ->
J
<lang j>life1d=: '_#'{~ (2 = 3+/\ 0,],0:)^:a:</lang> Example use: <lang j> life1d ? 20 # 2 _###_##_#_#_#_#__#__ _#_#####_#_#_#______ __##___##_#_#_______ __##___###_#________ __##___#_##_________ __##____###_________ __##____#_#_________ __##_____#__________ __##________________</lang>
Alternative implementation:
<lang j>Rule=:2 :0 NB. , m: number of generations, n: rule number
'_#'{~ (3 ((|.n#:~8#2) {~ #.)\ 0,],0:)^:(i.m)
)</lang>
Example use:
<lang j> 9 Rule 104 '#'='_###_##_#_#_#_#__#__' _###_##_#_#_#_#__#__ _#_#####_#_#_#______ __##___##_#_#_______ __##___###_#________ __##___#_##_________ __##____###_________ __##____#_#_________ __##_____#__________ __##________________</lang>
Java
This example requires a starting generation of at least length two (which is what you need for anything interesting anyway). <lang java>public class Life{ public static void main(String[] args) throws Exception{ String start= "_###_##_#_#_#_#__#__"; int numGens = 10; for(int i= 0; i < numGens; i++){ System.out.println("Generation " + i + ": " + start); start= life(start); } }
public static String life(String lastGen){ String newGen= ""; for(int i= 0; i < lastGen.length(); i++){ int neighbors= 0; if (i == 0){//left edge neighbors= lastGen.charAt(1) == '#' ? 1 : 0; } else if (i == lastGen.length() - 1){//right edge neighbors= lastGen.charAt(i - 1) == '#' ? 1 : 0; } else{//middle neighbors= getNeighbors(lastGen.substring(i - 1, i + 2)); }
if (neighbors == 0){//dies or stays dead with no neighbors newGen+= "_"; } if (neighbors == 1){//stays with one neighbor newGen+= lastGen.charAt(i); } if (neighbors == 2){//flips with two neighbors newGen+= lastGen.charAt(i) == '#' ? "_" : "#"; } } return newGen; }
public static int getNeighbors(String group){ int ans= 0; if (group.charAt(0) == '#') ans++; if (group.charAt(2) == '#') ans++; return ans; } }</lang> Output:
Generation 0: _###_##_#_#_#_#__#__ Generation 1: _#_#####_#_#_#______ Generation 2: __##___##_#_#_______ Generation 3: __##___###_#________ Generation 4: __##___#_##_________ Generation 5: __##____###_________ Generation 6: __##____#_#_________ Generation 7: __##_____#__________ Generation 8: __##________________ Generation 9: __##________________
In this version, b is replaced by a backup which is local to the evolve method, and the evolve method returns a boolean.
<lang java>public class Life{
private static char[] trans = "___#_##_".toCharArray();
private static int v(StringBuilder cell, int i){ return (cell.charAt(i) != '_') ? 1 : 0; }
public static boolean evolve(StringBuilder cell){ boolean diff = false; StringBuilder backup = new StringBuilder(cell.toString());
for(int i = 1; i < cell.length() - 3; i++){ /* use left, self, right as binary number bits for table index */ backup.setCharAt(i, trans[v(cell, i - 1) * 4 + v(cell, i) * 2 + v(cell, i + 1)]); diff = diff || (backup.charAt(i) != cell.charAt(i)); }
cell.delete(0, cell.length());//clear the buffer cell.append(backup);//replace it with the new generation return diff; }
public static void main(String[] args){ StringBuilder c = new StringBuilder("_###_##_#_#_#_#__#__\n");
do{ System.out.printf(c.substring(1)); }while(evolve(c)); } }</lang> Output:
###_##_#_#_#_#__#__ #_#####_#_#_#______ _##___##_#_#_______ _##___###_#________ _##___#_##_________ _##____###_________ _##____#_#_________ _##_____#__________ _##________________
JavaScript
The example below expects an array of 1s or 0s, as in the example. It also adds dead cells to both ends, which aren't included in the returned next generation.
state[i-1] refers to the new cell in question, (old[i] == 1) checks if the old cell was alive. <lang javascript>function caStep(old) {
var old = [0].concat(old, [0]); // Surround with dead cells.
var state = []; // The new state.
for (var i=1; i<old.length-1; i++) {
switch (old[i-1] + old[i+1]) {
case 0: state[i-1] = 0; break;
case 1: state[i-1] = (old[i] == 1) ? 1 : 0; break;
case 2: state[i-1] = (old[i] == 1) ? 0 : 1; break;
}
}
return state;
}</lang>
Example usage: <lang javascript>alert(caStep([0,1,1,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1,0,0]));</lang> shows an alert with "0,1,0,1,1,1,1,1,0,1,0,1,0,1,0,0,0,0,0,0".
K
<lang K>f:{2=+/(0,x,0)@(!#x)+/:!3}</lang>
Example usage: <lang K> `0:"_X"@f\0 1 1 1 0 1 1 0 1 0 1 0 1 0 1 0 0 1 0 0 _XXX_XX_X_X_X_X__X__ _X_XXXXX_X_X_X______ __XX___XX_X_X_______ __XX___XXX_X________ __XX___X_XX_________ __XX____XXX_________ __XX____X_X_________ __XX_____X__________ __XX________________ </lang>
Liberty BASIC
<lang lb>' [RC] 'One-dimensional cellular automata'
global rule$, state$
rule$ ="00010110" ' Rule 22 decimal
state$ ="0011101101010101001000"
for j =1 to 20
oldState$ =state$
state$ ="0"
for k =2 to 32
NHood$ =mid$( oldState$, k -1, 3) ' pick 3 char neighbourhood and turn binary string to decimal
vNHood =0
for kk =3 to 1 step -1
vNHood =vNHood +val( mid$( NHood$, kk, 1)) *2^( 3 -kk)
next kk
' .... & use it to index into rule$ to find appropriate new value
state$ =state$ +mid$( rule$, vNHood +1, 1)
next k
print state$
next j
end</lang>
Locomotive Basic
<lang locobasic>10 MODE 1:n=10:READ w:DIM x(w+1),x2(w+1):FOR i=1 to w:READ x(i):NEXT 20 FOR k=1 TO n 30 FOR j=1 TO w 40 IF x(j) THEN PRINT "#"; ELSE PRINT "_"; 50 IF x(j-1)+x(j)+x(j+1)=2 THEN x2(j)=1 ELSE x2(j)=0 60 NEXT:PRINT 70 FOR j=1 TO w:x(j)=x2(j):NEXT 80 NEXT 90 DATA 20,0,1,1,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1,0,0</lang>
Output:
Logo
<lang logo>make "cell_list [0 1 1 1 0 1 1 0 1 0 1 0 1 0 1 0 0 1 0 0] make "generations 9
to evolve :n ifelse :n=1 [make "nminus1 item :cell_count :cell_list][make "nminus1 item :n-1 :cell_list] ifelse :n=:cell_count[make "nplus1 item 1 :cell_list][make "nplus1 item :n+1 :cell_list] ifelse ((item :n :cell_list)=0) [ ifelse (and (:nminus1=1) (:nplus1=1)) [output 1][output (item :n :cell_list)] ][ ifelse (and (:nminus1=1) (:nplus1=1)) [output 0][ ifelse and (:nminus1=0) (:nplus1=0) [output 0][output (item :n :cell_list)]] ] end
to CA_1D :cell_list :generations make "cell_count count :cell_list (print ") make "printout " repeat :cell_count [ make "printout word :printout ifelse (item repcount :cell_list)=1 ["#]["_] ] (print "Generation "0: :printout)
repeat :generations [
(make "cell_list_temp [])
repeat :cell_count[
(make "cell_list_temp (lput (evolve repcount) :cell_list_temp))
]
make "cell_list :cell_list_temp
make "printout "
repeat :cell_count [
make "printout word :printout ifelse (item repcount :cell_list)=1 ["#]["_]
]
(print "Generation word repcount ": :printout)
] end
CA_1D :cell_list :generations</lang> Sample Output:
Generation 0: _###_##_#_#_#_#__#__ Generation 1: _#_#####_#_#_#______ Generation 2: __##___##_#_#_______ Generation 3: __##___###_#________ Generation 4: __##___#_##_________ Generation 5: __##____###_________ Generation 6: __##____#_#_________ Generation 7: __##_____#__________ Generation 8: __##________________ Generation 9: __##________________
Lua
<lang lua>num_iterations = 9 f = { 0, 1, 1, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 0 }
function Output( f, l )
io.write( l, ": " )
for i = 1, #f do
local c
if f[i] == 1 then c = '#' else c = '_' end
io.write( c )
end
print ""
end
Output( f, 0 )
for l = 1, num_iterations do
local g = {}
for i = 2, #f-1 do
if f[i-1] + f[i+1] == 1 then
g[i] = f[i]
elseif f[i] == 0 and f[i-1] + f[i+1] == 2 then
g[i] = 1
else
g[i] = 0
end
end
if f[1] == 1 and f[2] == 1 then g[1] = 1 else g[1] = 0 end
if f[#f] == 1 and f[#f-1] == 1 then g[#f] = 1 else g[#f] = 0 end
f, g = g, f
Output( f, l )
end </lang>
0: _###_##_#_#_#_#__#__ 1: _#_#####_#_#_#______ 2: __##___##_#_#_______ 3: __##___###_#________ 4: __##___#_##_________ 5: __##____###_________ 6: __##____#_#_________ 7: __##_____#__________ 8: __##________________ 9: __##________________
M4
<lang M4>divert(-1) define(`set',`define(`$1[$2]',`$3')') define(`get',`defn(`$1[$2]')') define(`setrange',`ifelse(`$3',`',$2,`define($1[$2],$3)`'setrange($1,
incr($2),shift(shift(shift($@))))')')
dnl throw in sentinels at each end (0 and size+1) to make counting easy define(`new',`set($1,size,eval($#-1))`'setrange($1,1,
shift($@))`'set($1,0,0)`'set($1,$#,0)')
define(`for',
`ifelse($#,0,``$0, `ifelse(eval($2<=$3),1, `pushdef(`$1',$2)$4`'popdef(`$1')$0(`$1',incr($2),$3,`$4')')')')
define(`show',
`for(`k',1,get($1,size),`get($1,k) ')')
dnl swap(`a',a,`b') using arg stack for temp define(`swap',`define(`$1',$3)`'define(`$3',$2)') define(`nalive',
`eval(get($1,decr($2))+get($1,incr($2)))')
setrange(`live',0,0,1,0) setrange(`dead',0,0,0,1) define(`nv',
`ifelse(get($1,z),0,`get(dead,$3)',`get(live,$3)')')
define(`evolve',
`for(`z',1,get($1,size),
`set($2,z,nv($1,z,nalive($1,z)))')')
new(`a',0,1,1,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1,0,0) set(`b',size,get(`a',size))`'set(`b',0,0)`'set(`b',incr(get(`a',size)),0) define(`x',`a') define(`y',`b') divert for(`j',1,10,
`show(x)`'evolve(`x',`y')`'swap(`x',x,`y')
')`'show(x)</lang>
Output:
0 1 1 1 0 1 1 0 1 0 1 0 1 0 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 1 0 1 0 1 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 0 1 0 1 0 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
Mathematica
Built-in function: <lang Mathematica>CellularAutomaton[{{0,0,_}->0,{0,1,0}->0,{0,1,1}->1,{1,0,0}->0,{1,0,1}->1,{1,1,0}->1,{1,1,1}->0},{{1,1,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1},0},12] Print @@@ (% /. {1 -> "#", 0 -> "."});</lang> gives back: <lang Mathematica>###.##.#.#.#.#..#
- .#####.#.#.#....
.##...##.#.#..... .##...###.#...... .##...#.##....... .##....###....... .##....#.#....... .##.....#........ .##.............. .##.............. .##.............. .##.............. .##..............</lang>
Modula-3
Modula-3 provides a module Word for doing bitwise operations, but it segfaults when trying to use BOOLEAN types, so we use INTEGER instead.
<lang modula3>MODULE Cell EXPORTS Main;
IMPORT IO, Fmt, Word;
VAR culture := ARRAY [0..19] OF INTEGER {0, 1, 1, 1,
0, 1, 1, 0,
1, 0, 1, 0,
1, 0, 1, 0,
0, 1, 0, 0};
PROCEDURE Step(VAR culture: ARRAY OF INTEGER) =
VAR left: INTEGER := 0;
this, right: INTEGER;
BEGIN
FOR i := FIRST(culture) TO LAST(culture) - 1 DO
right := culture[i + 1];
this := culture[i];
culture[i] :=
Word.Or(Word.And(this, Word.Xor(left, right)), Word.And(Word.Not(this), Word.And(left, right)));
left := this;
END;
culture[LAST(culture)] := Word.And(culture[LAST(culture)], Word.Not(left));
END Step;
PROCEDURE Put(VAR culture: ARRAY OF INTEGER) =
BEGIN
FOR i := FIRST(culture) TO LAST(culture) DO
IF culture[i] = 1 THEN
IO.PutChar('#');
ELSE
IO.PutChar('_');
END;
END;
END Put;
BEGIN
FOR i := 0 TO 9 DO
IO.Put("Generation " & Fmt.Int(i) & " ");
Put(culture);
IO.Put("\n");
Step(culture);
END;
END Cell.</lang> Output:
Generation 0 _###_##_#_#_#_#__#__ Generation 1 _#_#####_#_#_#______ Generation 2 __##___##_#_#_______ Generation 3 __##___###_#________ Generation 4 __##___#_##_________ Generation 5 __##____###_________ Generation 6 __##____#_#_________ Generation 7 __##_____#__________ Generation 8 __##________________ Generation 9 __##________________
Nial
(life.nial) <lang nial>% we need a way to write a values and pass the same back wi is rest link [write, pass] % calculate the neighbors by rotating the array left and right and joining them neighbors is pack [pass, sum [-1 rotate, 1 rotate]] % calculate the individual birth and death of a single array element igen is fork [ = [ + [first, second], 3 first], 0 first, = [ + [first, second], 2 first], 1 first, 0 first ] % apply that to the array nextgen is each igen neighbors % 42 life is fork [ > [sum pass, 0 first], life nextgen wi, pass ]</lang> Using it <lang nial>|loaddefs 'life.nial' |I := [0,1,1,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1,0,0] |life I</lang>
OCaml
<lang ocaml>let get g i =
try g.(i) with _ -> 0
let next_cell g i =
match get g (i-1), get g (i), get g (i+1) with | 0, 0, 0 -> 0 | 0, 0, 1 -> 0 | 0, 1, 0 -> 0 | 0, 1, 1 -> 1 | 1, 0, 0 -> 0 | 1, 0, 1 -> 1 | 1, 1, 0 -> 1 | 1, 1, 1 -> 0 | _ -> assert(false)
let next g =
let old_g = Array.copy g in for i = 0 to pred(Array.length g) do g.(i) <- (next_cell old_g i) done
let print_g g =
for i = 0 to pred(Array.length g) do if g.(i) = 0 then print_char '_' else print_char '#' done; print_newline()</lang>
put the code above in a file named "life.ml", and then use it in the ocaml toplevel like this:
#use "life.ml" ;;
let iter n g =
for i = 0 to n do
Printf.printf "Generation %d: " i; print_g g;
next g;
done
;;
let g_of_string str =
let f = (function '_' -> 0 | '#' -> 1 | _ -> assert false) in
Array.init (String.length str) (fun i -> f str.[i])
;;
# iter 9 (g_of_string "_###_##_#_#_#_#__#__") ;;
Generation 0: _###_##_#_#_#_#__#__
Generation 1: _#_#####_#_#_#______
Generation 2: __##___##_#_#_______
Generation 3: __##___###_#________
Generation 4: __##___#_##_________
Generation 5: __##____###_________
Generation 6: __##____#_#_________
Generation 7: __##_____#__________
Generation 8: __##________________
Generation 9: __##________________
- : unit = ()
Oz
<lang oz>declare
A0 = {List.toTuple unit "_###_##_#_#_#_#__#__"}
MaxGenerations = 9
Rules = unit('___':&_
'__#':&_
'_#_':&_
'_##':&#
'#__':&_
'#_#':&#
'##_':&#
'###':&_)
fun {Evolve A}
{Record.mapInd A
fun {$ I V}
Left = {CondSelect A I-1 &_}
Right = {CondSelect A I+1 &_}
Env = {String.toAtom [Left V Right]}
in
Rules.Env
end
}
end
fun lazy {Iterate X F}
X|{Iterate {F X} F}
end
in
for
I in 0..MaxGenerations
A in {Iterate A0 Evolve}
do
{System.showInfo "Gen. "#I#": "#{Record.toList A}}
end</lang>
Output:
Gen. 0: _###_##_#_#_#_#__#__ Gen. 1: _#_#####_#_#_#______ Gen. 2: __##___##_#_#_______ Gen. 3: __##___###_#________ Gen. 4: __##___#_##_________ Gen. 5: __##____###_________ Gen. 6: __##____#_#_________ Gen. 7: __##_____#__________ Gen. 8: __##________________ Gen. 9: __##________________
PARI/GP
This version defines the fixed cells to the left and right as dead; of course other versions are possible. This function generates one generation from a previous one, passed as a 0-1 vector. <lang parigp>step(v)=my(u=vector(#v),k);u[1]=v[1]&v[2];u[#u]=v[#v]&v[#v-1];for(i=2,#v-1,k=v[i-1]+v[i+1];u[i]=if(v[i],k==1,k==2));u;</lang>
Perl 6
Short though it is, this solution even detects stability. Z+ is a zip metaop with addition, and X== is a cross metaop with equality. (Crossing with a scalar always producing a list of the same length.) We have taken the slight liberty of defining a wraparound universe, but it doesn't matter for this example. <lang perl6>my @c = <_ #>; my @array = '_###_##_#_#_#_#__#__'.comb.map: { $_ eq '#' };
repeat until @array eqv my @prev {
say @c[@prev = @array]; @array = ((@array Z+ @array.rotate(1)) Z+ @array.rotate(-1)) X== 2;
}</lang>
Output:
_###_##_#_#_#_#__#__ _#_#####_#_#_#______ __##___##_#_#_______ __##___###_#________ __##___#_##_________ __##____###_________ __##____#_#_________ __##_____#__________ __##________________
PicoLisp
<lang PicoLisp>(let Cells (chop "_###_##_#_#_#_#__#__")
(do 10
(prinl Cells)
(setq Cells
(make
(link "_")
(map
'((L)
(case (head 3 L)
(`(mapcar chop '("___" "__#" "_#_" "#__" "###"))
(link "_") )
(`(mapcar chop '("_##" "#_#" "##_"))
(link "#") ) ) )
Cells )
(link "_") ) ) ) )</lang>
Output:
_###_##_#_#_#_#__#__ _#_#####_#_#_#______ __##___##_#_#_______ __##___###_#________ __##___#_##_________ __##____###_________ __##____#_#_________ __##_____#__________ __##________________ __##________________
Prolog
Works ith SWI-Prolog. <lang Prolog>one_dimensional_cellular_automata(L) :- maplist(my_write, L), nl, length(L, N), length(LN, N), % there is a 0 before the beginning compute_next([0 |L], LN), ( L \= LN -> one_dimensional_cellular_automata(LN); true).
% All the possibilites compute_next([0, 0, 0 | R], [0 | R1]) :- compute_next([0, 0 | R], R1).
compute_next([0, 0, 1 | R], [0 | R1]) :- compute_next([0, 1 | R], R1).
compute_next([0, 1, 0 | R], [0 | R1]) :- compute_next([1, 0 | R], R1).
compute_next([0, 1, 1 | R], [1 | R1]) :- compute_next([1, 1 | R], R1).
compute_next([1, 0, 0 | R], [0 | R1]) :- compute_next([0, 0 | R], R1).
compute_next([1, 0, 1 | R], [1 | R1]) :- compute_next([0, 1 | R], R1).
compute_next([1, 1, 0 | R], [1 | R1]) :- compute_next([1, 0 | R], R1).
compute_next([1, 1, 1 | R], [0 | R1]) :- compute_next([1, 1 | R], R1).
% the last four possibilies => % we consider that there is à 0 after the end compute_next([0, 0], [0]).
compute_next([1, 0], [0]).
compute_next([0, 1], [0]).
compute_next([1, 1], [1]).
my_write(0) :- write(.).
my_write(1) :- write(#).
one_dimensional_cellular_automata :- L = [0,1,1,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1,0,0], one_dimensional_cellular_automata(L). </lang> Output :
?- one_dimensional_cellular_automata. .###.##.#.#.#.#..#.. .#.#####.#.#.#...... ..##...##.#.#....... ..##...###.#........ ..##...#.##......... ..##....###......... ..##....#.#......... ..##.....#.......... ..##................ true .
PureBasic
<lang PureBasic>EnableExplicit Dim cG.i(21) Dim nG.i(21) Define.i n, Gen
DataSection
Data.i 0,1,1,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1,0,0
EndDataSection For n=1 To 20
Read.i cG(n)
Next
OpenConsole() Repeat
Print("Generation "+Str(Gen)+": ")
For n=1 To 20
Print(Chr(95-cG(n)*60))
Next
Gen +1
PrintN("")
For n=1 To 20
If (cG(n) And (cG(n-1) XOr cg(n+1))) Or (Not cG(n) And (cG(n-1) And cg(n+1)))
nG(n)=1
Else
nG(n)=0
EndIf
Next
Swap cG() , nG()
Until Gen > 9
PrintN("Press any key to exit"): Repeat: Until Inkey() <> ""</lang>Output:
Generation 0: _###_##_#_#_#_#__#__ Generation 1: _#_#####_#_#_#______ Generation 2: __##___##_#_#_______ Generation 3: __##___###_#________ Generation 4: __##___#_##_________ Generation 5: __##____###_________ Generation 6: __##____#_#_________ Generation 7: __##_____#__________ Generation 8: __##________________ Generation 9: __##________________
Python
<lang python>import random
printdead, printlive = '_#' maxgenerations = 10 cellcount = 20 offendvalue = '0'
universe = .join(random.choice('01') for i in range(cellcount))
neighbours2newstate = {
'000': '0', '001': '0', '010': '0', '011': '1', '100': '0', '101': '1', '110': '1', '111': '0', }
for i in range(maxgenerations):
print "Generation %3i: %s" % ( i,
universe.replace('0', printdead).replace('1', printlive) )
universe = offendvalue + universe + offendvalue
universe = .join(neighbours2newstate[universe[i:i+3]] for i in range(cellcount))</lang>
Sample output:
Generation 0: _###_##_#_#_#_#__#__ Generation 1: _#_#####_#_#_#______ Generation 2: __##___##_#_#_______ Generation 3: __##___###_#________ Generation 4: __##___#_##_________ Generation 5: __##____###_________ Generation 6: __##____#_#_________ Generation 7: __##_____#__________ Generation 8: __##________________ Generation 9: __##________________
The following implementation uses boolean operations to realize the function.
<lang python>import random
nquads = 5 maxgenerations = 10 fmt = '%%0%ix'%nquads nbits = 4*nquads a = random.getrandbits(nbits) << 1
- a = int('01110110101010100100', 2) << 1
endmask = (2<<nbits)-2; endvals = 0<<(nbits+1) | 0 tr = ('____', '___#', '__#_', '__##', '_#__', '_#_#', '_##_', '_###',
'#___', '#__#', '#_#_', '#_##', '##__', '##_#', '###_', '####' )
for i in range(maxgenerations):
print "Generation %3i: %s" % (i,(.join(tr[int(t,16)] for t in (fmt%(a>>1))))) a |= endvals a = ((a&((a<<1) | (a>>1))) ^ ((a<<1)&(a>>1))) & endmask</lang>
R
<lang R>set.seed(15797, kind="Mersenne-Twister")
maxgenerations = 10 cellcount = 20 offendvalue = FALSE
- Cells are alive if TRUE, dead if FALSE
universe <- c(offendvalue,
sample( c(TRUE, FALSE), cellcount, replace=TRUE),
offendvalue)
- List of patterns in which the cell stays alive
stayingAlive <- lapply(list(c(1,1,0),
c(1,0,1),
c(0,1,0)), as.logical)
- x : length 3 logical vector
- map: list of length 3 logical vectors that map to patterns
- in which x stays alive
deadOrAlive <- function(x, map) list(x) %in% map
cellularAutomata <- function(x, map) {
c(x[1], apply(embed(x, 3), 1, deadOrAlive, map=map), x[length(x)])
}
deadOrAlive2string <- function(x) {
paste(ifelse(x, '#', '_'), collapse="")
}
for (i in 1:maxgenerations) {
universe <- cellularAutomata(universe, stayingAlive) cat(format(i, width=3), deadOrAlive2string(universe), "\n")
}</lang>
Sample output,
1 _##_____####_#___#_#__ 2 _##_____#__##_____#___ 3 _##________##_________ 4 _##________##_________ 5 _##________##_________ 6 _##________##_________ 7 _##________##_________ 8 _##________##_________ 9 _##________##_________ 10 _##________##_________
Retro
<lang Retro>{{
: $, ( $- ) withLength [ @+ , ] times @ , ; create this ".###.##.#.#.#.#..#.." $, create next this getLength allot create group "..." $, variable neighbours
: reset 0 !neighbours ; : hasNeighbour? @ '# = [ neighbours ++ ] ifTrue ; : countNeighboursOnEdge '# = [ 1 ] [ 0 ] if !neighbours ; : flip dup this + @ '# = [ '. ] [ '# ] if ; : extract dup this + 1- group 3 copy ;
: count ( left ) [ 0 = ] [ @this countNeighboursOnEdge ] when ( right ) [ 19 = ] [ this 19 + @ countNeighboursOnEdge ] when ( middle ) reset extract group dup 2 + 2hasNeighbour? ;
: process reset count @neighbours [ 0 = ] [ drop dup next + '. swap ! ] when [ 1 = ] [ drop dup this + @ over next + ! ] when [ 2 = ] [ drop flip over next + ! ] when drop ;
: generation 0 this getLength [ process 1+ ] times drop next this withLength copy ;
---reveal---
: generations cr 0 swap [ [ this swap "%d %s\n" puts ] sip generation 1+ ] times drop ;
}}</lang>
Sample Output:
10 generations 0 .###.##.#.#.#.#..#.. 1 .#.#####.#.#.#...... 2 ..##...##.#.#....... 3 ..##...###.#........ 4 ..##...#.##......... 5 ..##....###......... 6 ..##....#.#......... 7 ..##.....#.......... 8 ..##................ 9 ..##................
Ruby
<lang ruby>def evolve(ary)
new = Array.new(ary.length)
new[0] = (ary[0] == 1 and ary[1] == 1) ? 1 : 0
(1..new.length - 2).each {|i| new[i] = ary[i-1] + ary[i] + ary[i+1] == 2 ? 1 : 0}
new[-1] = (ary[-2] == 1 and ary[-1] == 1) ? 1 : 0
new
end
def printit(ary)
s = ary.join("")
s.gsub!(/1/,"#")
s.gsub!(/0/,".")
puts s
end
ary = [0,1,1,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1,0,0] printit ary while ary != new=evolve(ary)
printit new ary = new
end</lang>
.###.##.#.#.#.#..#.. .#.#####.#.#.#...... ..##...##.#.#....... ..##...###.#........ ..##...#.##......... ..##....###......... ..##....#.#......... ..##.....#.......... ..##................
Scala
<lang scala>def cellularAutomata(s: String) = {
def it = Iterator.iterate(s) ( generation =>
("_%s_" format generation).iterator
sliding 3
map (_ count (_ == '#'))
map Map(2 -> "#").withDefaultValue("_")
mkString
)
(it drop 1) zip it takeWhile Function.tupled(_ != _) map (_._2) foreach println
}</lang>
Sample:
scala> cellularAutomata("_###_##_#_#_#_#__#__")
_###_##_#_#_#_#__#__
_#_#####_#_#_#______
__##___##_#_#_______
__##___###_#________
__##___#_##_________
__##____###_________
__##____#_#_________
__##_____#__________
Scheme
<lang scheme>(define (next-generation left petri-dish right)
(if (null? petri-dish)
(list)
(cons (if (= (+ left
(car petri-dish)
(if (null? (cdr petri-dish))
right
(cadr petri-dish)))
2)
1
0)
(next-generation (car petri-dish) (cdr petri-dish) right))))
(define (display-evolution petri-dish generations)
(if (not (zero? generations))
(begin (display petri-dish)
(newline)
(display-evolution (next-generation 0 petri-dish 0)
(- generations 1)))))
(display-evolution (list 1 1 1 0 1 1 0 1 0 1 0 1 0 1 0 0 1 0) 10)</lang> Output:
(1 1 1 0 1 1 0 1 0 1 0 1 0 1 0 0 1 0) (1 0 1 1 1 1 1 0 1 0 1 0 1 0 0 0 0 0) (0 1 1 0 0 0 1 1 0 1 0 1 0 0 0 0 0 0) (0 1 1 0 0 0 1 1 1 0 1 0 0 0 0 0 0 0) (0 1 1 0 0 0 1 0 1 1 0 0 0 0 0 0 0 0) (0 1 1 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0) (0 1 1 0 0 0 0 1 0 1 0 0 0 0 0 0 0 0) (0 1 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0) (0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) (0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
Seed7
A graphical cellular automaton can be found here.
<lang seed7>$ include "seed7_05.s7i";
const string: start is "_###_##_#_#_#_#__#__";
const proc: main is func
local
var string: g0 is start;
var string: g1 is start;
var integer: generation is 0;
var integer: i is 0;
begin
writeln(g0);
for generation range 0 to 9 do
for i range 2 to pred(length(g0)) do
if g0[i-1] <> g0[i+1] then
g1 @:= [i] g0[i];
elsif g0[i] = '_' then
g1 @:= [i] g0[i-1];
else
g1 @:= [i] '_'
end if;
end for;
writeln(g1);
g0 := g1;
end for;
end func;</lang>
Output:
_###_##_#_#_#_#__#__ _#_#####_#_#_#______ __##___##_#_#_______ __##___###_#________ __##___#_##_________ __##____###_________ __##____#_#_________ __##_____#__________ __##________________ __##________________ __##________________
Tcl
<lang tcl>proc evolve {a} {
set new [list]
for {set i 0} {$i < [llength $a]} {incr i} {
lappend new [fate $a $i]
}
return $new
}
proc fate {a i} {
return [expr {[sum $a $i] == 2}]
}
proc sum {a i} {
set sum 0
set start [expr {$i - 1 < 0 ? 0 : $i - 1}]
set end [expr {$i + 1 >= [llength $a] ? $i : $i + 1}]
for {set j $start} {$j <= $end} {incr j} {
incr sum [lindex $a $j]
}
return $sum
}
proc print {a} {
puts [string map {0 _ 1 #} [join $a ""]]
}
proc parse {s} {
return [split [string map {_ 0 # 1} $s] ""]
}
set array [parse "_###_##_#_#_#_#__#__"] print $array while {[set new [evolve $array]] ne $array} {
set array $new print $array
}</lang>
Ursala
Three functions are defined. Rule takes a neighborhood of three cells to the succeeding value of the middle one, step takes a list of cells to its successor by applying the rule across a sliding window, and evolve takes an initial list of cells to a list of those evolving from it according to the rule. The cells are maintained as a list of booleans (0 and &) but are converted to characters for presentation in the example code. <lang Ursala>#import std
- import nat
rule = -$<0,0,0,&,0,&,&,0>@rSS zipp0*ziD iota8
step = rule*+ swin3+ :/0+ --<0>
evolve "n" = @iNC ~&x+ rep"n" ^C/step@h ~&
- show+
example = ~&?(`#!,`.!)** evolve10 <0,&,&,&,0,&,&,0,&,0,&,0,&,0,0,&,0,0></lang> output:
.###.##.#.#.#..#.. .#.#####.#.#...... ..##...##.#....... ..##...###........ ..##...#.#........ ..##....#......... ..##.............. ..##.............. ..##.............. ..##.............. ..##..............
Vedit macro language
This implementation writes the calculated patterns into an edit buffer, where the results can viewed and saved into a file if required. The edit buffer also acts as storage during calculations. <lang vedit>IT("Gen 0: ..###.##.#.#.#.#..#.....") // initial pattern
- 9 = Cur_Col
for (#8 = 1; #8 < 10; #8++) { // 10 generations
Goto_Col(7)
Reg_Empty(20)
while (Cur_Col < #9-1) {
if (Match("|{##|!#,#.#,|!###}")==0) {
Reg_Set(20, "#", APPEND)
} else {
Reg_Set(20, ".", APPEND)
}
Char
}
EOL IN
IT("Gen ") Num_Ins(#8, LEFT+NOCR) IT(": ")
Reg_Ins(20)
}</lang>
Sample output: <lang vedit>Gen 0: ..###.##.#.#.#.#..#..... Gen 1: ..#.#####.#.#.#......... Gen 2: ...##...##.#.#.......... Gen 3: ...##...###.#........... Gen 4: ...##...#.##............ Gen 5: ...##....###............ Gen 6: ...##....#.#............ Gen 7: ...##.....#............. Gen 8: ...##................... Gen 9: ...##...................</lang>
Visual Basic .NET
This implementation is run from the command line. The command is followed by a string of either 1's or #'s for an active cell, or 0's or _'s for an inactive one.
<lang Visual Basic .NET>Imports System.Text
Module CellularAutomata
Private Enum PetriStatus
Active
Stable
Dead
End Enum
Function Main(ByVal cmdArgs() As String) As Integer
If cmdArgs.Length = 0 Or cmdArgs.Length > 1 Then
Console.WriteLine("Command requires string of either 1s and 0s or #s and _s.")
Return 1
End If
Dim petriDish As BitArray
Try
petriDish = InitialisePetriDish(cmdArgs(0))
Catch ex As Exception
Console.WriteLine(ex.Message)
Return 1
End Try
Dim generation As Integer = 0
Dim ps As PetriStatus = PetriStatus.Active
Do While True
If ps = PetriStatus.Stable Then
Console.WriteLine("Sample stable after {0} generations.", generation - 1)
Exit Do
Else
Console.WriteLine("{0}: {1}", generation.ToString("D3"), BuildDishString(petriDish))
If ps = PetriStatus.Dead Then
Console.WriteLine("Sample dead after {0} generations.", generation)
Exit Do
End If
End If
ps = GetNextGeneration(petriDish)
generation += 1
Loop
Return 0 End Function
Private Function InitialisePetriDish(ByVal Sample As String) As BitArray
Dim PetriDish As New BitArray(Sample.Length)
Dim dead As Boolean = True
For i As Integer = 0 To Sample.Length - 1
Select Case Sample.Substring(i, 1)
Case "1", "#"
PetriDish(i) = True
dead = False
Case "0", "_"
PetriDish(i) = False
Case Else
Throw New Exception("Illegal value in string position " & i)
Return Nothing
End Select
Next
If dead Then
Throw New Exception("Entered sample is dead.")
Return Nothing
End If
Return PetriDish End Function
Private Function GetNextGeneration(ByRef PetriDish As BitArray) As PetriStatus
Dim petriCache = New BitArray(PetriDish.Length)
Dim neighbours As Integer
Dim stable As Boolean = True
Dim dead As Boolean = True
For i As Integer = 0 To PetriDish.Length - 1
neighbours = 0
If i > 0 AndAlso PetriDish(i - 1) Then neighbours += 1
If i < PetriDish.Length - 1 AndAlso PetriDish(i + 1) Then neighbours += 1
petriCache(i) = (PetriDish(i) And neighbours = 1) OrElse (Not PetriDish(i) And neighbours = 2)
If PetriDish(i) <> petriCache(i) Then stable = False
If petriCache(i) Then dead = False
Next
PetriDish = petriCache
If dead Then Return PetriStatus.Dead
If stable Then Return PetriStatus.Stable
Return PetriStatus.Active
End Function
Private Function BuildDishString(ByVal PetriDish As BitArray) As String
Dim sw As New StringBuilder()
For Each b As Boolean In PetriDish
sw.Append(IIf(b, "#", "_"))
Next
Return sw.ToString() End Function
End Module</lang>
Output:
C:\>CellularAutomata _###_##_#_#_#_#__#__ 000: _###_##_#_#_#_#__#__ 001: _#_#####_#_#_#______ 002: __##___##_#_#_______ 003: __##___###_#________ 004: __##___#_##_________ 005: __##____###_________ 006: __##____#_#_________ 007: __##_____#__________ 008: __##________________ Sample stable after 8 generations.
- Programming Tasks
- Games
- Ada
- ALGOL 68
- AutoHotkey
- BASIC
- BBC BASIC
- Befunge
- C
- C++
- C sharp
- Clojure
- CoffeeScript
- Common Lisp
- D
- DWScript
- E
- Euphoria
- Factor
- Fantom
- Forth
- Fortran
- Go
- Haskell
- Icon
- Unicon
- J
- Java
- JavaScript
- K
- Liberty BASIC
- Locomotive Basic
- Logo
- Lua
- M4
- Mathematica
- Modula-3
- Nial
- OCaml
- Oz
- PARI/GP
- Perl 6
- PicoLisp
- Prolog
- PureBasic
- Python
- R
- Retro
- Ruby
- Scala
- Scheme
- Seed7
- Tcl
- Ursala
- Vedit macro language
- Visual Basic .NET