Rosetta Code

One-dimensional cellular automata: Difference between revisions

Page Discussion

One-dimensional cellular automata (view source)

Revision as of 09:36, 8 January 2024

2,169 bytes added ,  4 months ago
m
→‎{{header|Wren}}: Changed to Wren S/H
imported>Maxima enthusiast
No edit summary
m (→‎{{header|Wren}}: Changed to Wren S/H)
(11 intermediate revisions by 6 users not shown)
Line 378:
Generation 7 __##_____#__________
Generation 8 __##________________
</pre>
 
=={{header|Amazing Hopper}}==
<p>Amazing Hopper flavour "BASICO", in spanish.</p>
<p>VERSION 1:</p>
<syntaxhighlight lang="c">
#include <basico.h>
 
algoritmo
tamaño de pila 65
x = 0
enlistar (0,0,1,1,1,0,0,1,1,0,1,0,1,1,0,1,1,1,0,0,\
1,1,1,1,1,1,0,1,1,1,0,1,1,1,1,1,0,1,0,0,\
1,1,0,0,0,0,0,1,0,1,0,1,1,1,1,1,1,1,0,0) mover a 'x'
x2 = x
decimales '0', token.separador ("")
iterar para ( k=1, #(k<=15), ++k )
imprimir ' #(utf8("Generación #")),k, "\t", x, NL '
iterar para ( j=2, #(j<60), ++j )
#(x2[j] = 0)
cuando ( #( (x[j-1]+x[j]+x[j+1])==2 ) ){
#(x2[j]=1)
}
siguiente
x = x2
siguiente
terminar
</syntaxhighlight>
{{out}}
<pre>
Generación #1 001110011010110111001111110111011111010011000001010111111100
Generación #2 001010011101111101001000011101110001100011000000101100000100
Generación #3 000100010111000110000000010111010001100011000000011100000000
Generación #4 000000001101000110000000001101100001100011000000010100000000
Generación #5 000000001110000110000000001111100001100011000000001000000000
Generación #6 000000001010000110000000001000100001100011000000000000000000
Generación #7 000000000100000110000000000000000001100011000000000000000000
Generación #8 000000000000000110000000000000000001100011000000000000000000
Generación #9 000000000000000110000000000000000001100011000000000000000000
Generación #10 000000000000000110000000000000000001100011000000000000000000
Generación #11 000000000000000110000000000000000001100011000000000000000000
Generación #12 000000000000000110000000000000000001100011000000000000000000
Generación #13 000000000000000110000000000000000001100011000000000000000000
Generación #14 000000000000000110000000000000000001100011000000000000000000
Generación #15 000000000000000110000000000000000001100011000000000000000000
</pre>
<p>VERSION 2:</p>
<syntaxhighlight lang="c">
#include <basico.h>
 
algoritmo
x={}
'0,0,1,1,1,0,0,1,1,0,1,0,1,1,0,1,1,1,0,0' anidar en lista 'x'
'1,1,1,1,1,1,0,1,1,1,0,1,1,1,1,1,0,1,0,0' anidar en lista 'x'
'1,1,0,0,0,0,0,1,0,1,0,1,1,1,1,1,1,1,0,0' anidar en lista 'x'
 
x2 = x, k=10
decimales '0', token.separador ("")
iterar
imprimir ' #(utf8("Generación #")), #(11-k), "\t", x, NL '
iterar para ( j=2, #(j<60), ++j )
#( x2[j] = ((x[j-1]+x[j]+x[j+1])==2) )
siguiente
x = x2
mientras ' k-- '
terminar
 
</syntaxhighlight>
{{out}}
<pre>
Generación #1 001110011010110111001111110111011111010011000001010111111100
Generación #2 001010011101111101001000011101110001100011000000101100000100
Generación #3 000100010111000110000000010111010001100011000000011100000000
Generación #4 000000001101000110000000001101100001100011000000010100000000
Generación #5 000000001110000110000000001111100001100011000000001000000000
Generación #6 000000001010000110000000001000100001100011000000000000000000
Generación #7 000000000100000110000000000000000001100011000000000000000000
Generación #8 000000000000000110000000000000000001100011000000000000000000
Generación #9 000000000000000110000000000000000001100011000000000000000000
Generación #10 000000000000000110000000000000000001100011000000000000000000
Generación #11 000000000000000110000000000000000001100011000000000000000000
 
</pre>
 
Line 596 ⟶ 678:
 
=={{header|BASIC}}==
{{works with|QBasic|1.1}}
{{works with|QuickBasic|4.5}}
{{trans|Java}}
<syntaxhighlight 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</syntaxhighlight>
{{out}}
<pre>Generation 0 : _###_##_#_#_#_#__#__
Generation 1 : _#_#####_#_#_#______
Generation 2 : __##___##_#_#_______
Generation 3 : __##___###_#________
Generation 4 : __##___#_##_________
Generation 5 : __##____###_________
Generation 6 : __##____#_#_________
Generation 7 : __##_____#__________
Generation 8 : __##________________
Generation 9 : __##________________</pre>
 
==={{header|Applesoft BASIC}}===
{{trans|Locomotive BASIC}}
Line 679 ⟶ 693:
190 NEXT
200 DATA 20,0,1,1,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1,0,0</syntaxhighlight>
 
==={{header|BASIC256}}===
<syntaxhighlight lang="basic256">arraybase 1
dim start = {0,1,1,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1,0,0}
dim sgtes(start[?]+1)
 
for k = 0 to 9
print "Generation "; k; ": ";
for j = 0 to start[?]-1
 
if start[j] then print "#"; else print "_";
if start[j-1] + start[j] + start[j+1] = 2 then sgtes[j] = 1 else sgtes[j] = 0
next j
print
for j = 0 to start[?]-1
start[j] = sgtes[j]
next j
next k</syntaxhighlight>
 
==={{header|BBC BASIC}}===
<syntaxhighlight 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%</syntaxhighlight>
{{out}}
<pre>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</pre>
 
==={{header|Chipmunk Basic}}===
Line 749 ⟶ 807:
loop
wend</syntaxhighlight>
 
==={{header|GFA Basic}}===
<syntaxhighlight lang="text">
'
' One Dimensional Cellular Automaton
'
start$="01110110101010100100"
max_cycles%=20 ! give a maximum depth
'
' Global variables hold the world, with two rows
' world! is set up with 2 extra cells width, so there is a FALSE on either side
' cur% gives the row for current world,
' new% gives the row for the next world.
'
size%=LEN(start$)
DIM world!(size%+2,2)
cur%=0
new%=1
clock%=0
'
@setup_world(start$)
OPENW 1
CLEARW 1
DO
@display_world
@update_world
EXIT IF @same_state
clock%=clock%+1
EXIT IF clock%>max_cycles% ! safety net
LOOP
~INP(2)
CLOSEW 1
'
' parse given string to set up initial states in world
' -- assumes world! is of correct size
'
PROCEDURE setup_world(defn$)
LOCAL i%
' clear out the array
ARRAYFILL world!(),FALSE
' for each 1 in string, set cell to true
FOR i%=1 TO LEN(defn$)
IF MID$(defn$,i%,1)="1"
world!(i%,0)=TRUE
ENDIF
NEXT i%
' set references to cur and new
cur%=0
new%=1
RETURN
'
' Display the world
'
PROCEDURE display_world
LOCAL i%
FOR i%=1 TO size%
IF world!(i%,cur%)
PRINT "#";
ELSE
PRINT ".";
ENDIF
NEXT i%
PRINT ""
RETURN
'
' Create new version of world
'
PROCEDURE update_world
LOCAL i%
FOR i%=1 TO size%
world!(i%,new%)=@new_state(@get_value(i%))
NEXT i%
' reverse cur/new
cur%=1-cur%
new%=1-new%
RETURN
'
' Test if cur/new states are the same
'
FUNCTION same_state
LOCAL i%
FOR i%=1 TO size%
IF world!(i%,cur%)<>world!(i%,new%)
RETURN FALSE
ENDIF
NEXT i%
RETURN TRUE
ENDFUNC
'
' Return new state of cell given value
'
FUNCTION new_state(value%)
SELECT value%
CASE 0,1,2,4,7
RETURN FALSE
CASE 3,5,6
RETURN TRUE
ENDSELECT
ENDFUNC
'
' Compute value for cell + neighbours
'
FUNCTION get_value(cell%)
LOCAL result%
result%=0
IF world!(cell%-1,cur%)
result%=result%+4
ENDIF
IF world!(cell%,cur%)
result%=result%+2
ENDIF
IF world!(cell%+1,cur%)
result%=result%+1
ENDIF
RETURN result%
ENDFUNC</syntaxhighlight>
 
==={{header|GW-BASIC}}===
The [[#Chipmunk Basic|Chipmunk Basic]] solution works without any changes.
 
==={{header|Liberty BASIC}}===
{{works with|Just BASIC}}
{{works with|Run BASIC}}
<syntaxhighlight lang="lb">' [RC] 'One-dimensional cellular automata'
 
' does not wrap so fails for some rules
rule$ ="00010110" ' Rule 22 decimal
 
state$ ="0011101101010101001000"
 
for j =1 to 20
print state$
oldState$ =state$
state$ ="0"
for k =2 to len( oldState$) -1
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
state$ =state$ +"0"
 
next j
 
end</syntaxhighlight>
 
==={{header|Locomotive Basic}}===
<syntaxhighlight 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</syntaxhighlight>
 
{{out}}
[[File:Cellular automaton locomotive basic.png]]
 
==={{header|MSX Basic}}===
The [[#Chipmunk Basic|Chipmunk Basic]] solution works without any changes.
 
==={{header|PureBasic}}===
<syntaxhighlight 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
CopyArray(nG(), cG())
Until Gen > 9
PrintN("Press any key to exit"): Repeat: Until Inkey() <> ""</syntaxhighlight>
{{out}}
<pre>Generation 0: _###_##_#_#_#_#__#__
Generation 1: _#_#####_#_#_#______
Generation 2: __##___##_#_#_______
Generation 3: __##___###_#________
Generation 4: __##___#_##_________
Generation 5: __##____###_________
Generation 6: __##____#_#_________
Generation 7: __##_____#__________
Generation 8: __##________________
Generation 9: __##________________</pre>
 
==={{header|QBasic}}===
{{works with|QBasic|1.1}}
{{works with|QuickBasic|4.5}}
{{trans|Java}}
<syntaxhighlight 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</syntaxhighlight>
{{out}}
<pre>Generation 0 : _###_##_#_#_#_#__#__
Generation 1 : _#_#####_#_#_#______
Generation 2 : __##___##_#_#_______
Generation 3 : __##___###_#________
Generation 4 : __##___#_##_________
Generation 5 : __##____###_________
Generation 6 : __##____#_#_________
Generation 7 : __##_____#__________
Generation 8 : __##________________
Generation 9 : __##________________</pre>
 
==={{header|Quite BASIC}}===
Line 789 ⟶ 1,119:
<pre>00110000000000000000 9</pre>
 
==={{header|BASIC256Visual 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.
<syntaxhighlight lang="basic256">arraybase 1
dim start = {0,1,1,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1,0,0}
dim sgtes(start[?]+1)
 
<syntaxhighlight lang="visual basic .net">Imports System.Text
for k = 0 to 9
print "Generation "; k; ": ";
for j = 0 to start[?]-1
 
Module CellularAutomata
if start[j] then print "#"; else print "_";
 
if start[j-1] + start[j] + start[j+1] = 2 then sgtes[j] = 1 else sgtes[j] = 0
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</syntaxhighlight>
 
Output:
<pre>C:\>CellularAutomata _###_##_#_#_#_#__#__
000: _###_##_#_#_#_#__#__
001: _#_#####_#_#_#______
002: __##___##_#_#_______
003: __##___###_#________
004: __##___#_##_________
005: __##____###_________
006: __##____#_#_________
007: __##_____#__________
008: __##________________
Sample stable after 8 generations.</pre>
 
==={{header|Yabasic}}===
{{trans|Locomotive_Basic}}
<syntaxhighlight lang="yabasic">10 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 "_"; END IF
50 IF x(j-1)+x(j)+x(j+1)=2 THEN x2(j)=1 ELSE x2(j)=0 END IF
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</syntaxhighlight>
 
Other solution
<syntaxhighlight lang="yabasic">start$ = "0,1,1,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1,0,0"
 
dim x$(1)
 
for k = 1 to 10
n = token(start$, x$(), ",")
redim x$(n+1)
start$ = ""
for j = 1 to n
if val(x$(j)) then print "#"; else print "_"; end if
test = abs(val(x$(j-1)) + val(x$(j)) + val(x$(j+1)) = 2)
start$ = start$ + str$(test) + ","
next j
print
for j = 0 to start[?]-1
start[j] = sgtes[j]
next j
next k</syntaxhighlight>
 
Line 878 ⟶ 1,341:
 
...The sample is now stable.</pre>
 
=={{header|BBC BASIC}}==
<syntaxhighlight 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%</syntaxhighlight>
{{out}}
<pre>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</pre>
 
=={{header|Befunge}}==
Line 1,794 ⟶ 2,231:
9 | ##
# value: " ## "</syntaxhighlight>
 
=={{header|EasyLang}}==
<syntaxhighlight lang=easylang>
map[] = [ 0 0 0 1 0 1 1 0 ]
cell[] = [ 0 1 1 1 0 1 1 0 1 0 1 0 1 0 1 0 0 1 0 0 ]
len celln[] len cell[]
proc evolve . .
for i = 2 to len cell[] - 1
ind = cell[i - 1] + 2 * cell[i] + 4 * cell[i + 1] + 1
celln[i] = map[ind]
.
swap celln[] cell[]
.
proc show . .
for v in cell[]
if v = 1
write "#"
else
write "."
.
.
print ""
.
show
for i to 9
evolve
show
.
</syntaxhighlight>
{{out}}
<pre>
.###.##.#.#.#.#..#..
.#.#####.#.#.#......
..##...##.#.#.......
..##...###.#........
..##...#.##.........
..##....###.........
..##....#.#.........
..##.....#..........
..##................
..##................
</pre>
 
=={{header|Eiffel}}==
Line 2,412 ⟶ 2,891:
Generation 8: __##________________
Generation 9: __##________________</pre>
 
=={{header|GFA Basic}}==
 
<syntaxhighlight lang="text">
'
' One Dimensional Cellular Automaton
'
start$="01110110101010100100"
max_cycles%=20 ! give a maximum depth
'
' Global variables hold the world, with two rows
' world! is set up with 2 extra cells width, so there is a FALSE on either side
' cur% gives the row for current world,
' new% gives the row for the next world.
'
size%=LEN(start$)
DIM world!(size%+2,2)
cur%=0
new%=1
clock%=0
'
@setup_world(start$)
OPENW 1
CLEARW 1
DO
@display_world
@update_world
EXIT IF @same_state
clock%=clock%+1
EXIT IF clock%>max_cycles% ! safety net
LOOP
~INP(2)
CLOSEW 1
'
' parse given string to set up initial states in world
' -- assumes world! is of correct size
'
PROCEDURE setup_world(defn$)
LOCAL i%
' clear out the array
ARRAYFILL world!(),FALSE
' for each 1 in string, set cell to true
FOR i%=1 TO LEN(defn$)
IF MID$(defn$,i%,1)="1"
world!(i%,0)=TRUE
ENDIF
NEXT i%
' set references to cur and new
cur%=0
new%=1
RETURN
'
' Display the world
'
PROCEDURE display_world
LOCAL i%
FOR i%=1 TO size%
IF world!(i%,cur%)
PRINT "#";
ELSE
PRINT ".";
ENDIF
NEXT i%
PRINT ""
RETURN
'
' Create new version of world
'
PROCEDURE update_world
LOCAL i%
FOR i%=1 TO size%
world!(i%,new%)=@new_state(@get_value(i%))
NEXT i%
' reverse cur/new
cur%=1-cur%
new%=1-new%
RETURN
'
' Test if cur/new states are the same
'
FUNCTION same_state
LOCAL i%
FOR i%=1 TO size%
IF world!(i%,cur%)<>world!(i%,new%)
RETURN FALSE
ENDIF
NEXT i%
RETURN TRUE
ENDFUNC
'
' Return new state of cell given value
'
FUNCTION new_state(value%)
SELECT value%
CASE 0,1,2,4,7
RETURN FALSE
CASE 3,5,6
RETURN TRUE
ENDSELECT
ENDFUNC
'
' Compute value for cell + neighbours
'
FUNCTION get_value(cell%)
LOCAL result%
result%=0
IF world!(cell%-1,cur%)
result%=result%+4
ENDIF
IF world!(cell%,cur%)
result%=result%+2
ENDIF
IF world!(cell%+1,cur%)
result%=result%+1
ENDIF
RETURN result%
ENDFUNC
</syntaxhighlight>
 
=={{header|Go}}==
Line 2,802 ⟶ 3,163:
00110000
-></pre>
 
=={{Header|Insitux}}==
 
<syntaxhighlight lang="insitux">
(function next cells
(... str
(map (comp str (count ["#"]) (= 2) #(% "#" "_"))
(str "_" cells)
cells
(str (skip 1 cells) "_"))))
 
(function generate n cells
(join "\n" (reductions next cells (range n))))
</syntaxhighlight>
 
{{out}}
 
Invoking <code>(generate 9 "_###_##_#_#_#_#__#__")</code>
 
<pre>
_###_##_#_#_#_#__#__
_#_#####_#_#_#______
__##___##_#_#_______
__##___###_#________
__##___#_##_________
__##____###_________
__##____#_#_________
__##_____#__________
__##________________
__##________________
</pre>
 
=={{header|J}}==
Line 3,000 ⟶ 3,392:
 
=={{header|Julia}}==
=== Julia: Implementation as a function accepting a Vector of Bool ===
This solution creates an automaton with with either empty or periodic bounds. The empty bounds case, is typical of many of the solutions here. The periodic bounds case is a typical physics approach where, in effect, the beginning and end of the list touch each other to form a circular rather than linear array. In practice, the effects of boundary conditions are subtle for long arrays.
<syntaxhighlight lang="julia">
automaton(g::Vector{Bool}) =
function next_gen(a::BitArray{1}, isperiodic=false)
bfor =i copy(a)∈ 0:9
println(join(alive ? '#' : '_' for alive ∈ g))
if isperiodic
ncntg = prepend!(a[false; g[1:end-1], [a[end]]) .+ append!(ag .+ [g[2:end],; [a[1]false]) .== 2
else
ncnt = prepend!(a[1:end-1], [false]) + append!(a[2:end], [false])
end
b[ncnt .== 0] = false
automaton([c == '#' for c ∈ "_###_##_#_#_#_#__#__"])
b[ncnt .== 2] = ~b[ncnt .== 2]
</syntaxhighlight>
return b
=== Julia: Implementation as an iterable struct ===
end
<syntaxhighlight lang="julia">
struct Automaton g₀::Vector{Bool} end
 
Base.iterate(a::Automaton, g = a.g₀) =
function show_gen(a::BitArray{1})
s =g, join([i ? "\u2588"false; g[1:end-1]] ".+ "g for.+ i in a[g[2:end],; ""false]) .== 2
s = "\u25ba"*s*"\u25c4"
end
 
Base.show(io::IO, a::Automaton) = for g in Iterators.take(a, 10)
hi = 70
println(io, join(alive ? '#' : '_' for alive ∈ g)) end
a = bitrand(hi)
 
b = falses(hi)
Automaton([c == '#' for c ∈ "_###_##_#_#_#_#__#__"])
println("A 1D Cellular Atomaton with ", hi, " cells and empty bounds.")
while any(a) && any(a .!= b)
println(" ", show_gen(a))
b = copy(a)
a = next_gen(a)
end
a = bitrand(hi)
b = falses(hi)
println()
println("A 1D Cellular Atomaton with ", hi, " cells and periodic bounds.")
while any(a) && any(a .!= b)
println(" ", show_gen(a))
b = copy(a)
a = next_gen(a, true)
end
</syntaxhighlight>
 
{{out}}
<pre>
_###_##_#_#_#_#__#__
A 1D Cellular Atomaton with 70 cells and empty bounds.
_#_#####_#_#_#______
► ███ ██ █ ██ ███ █ ███ ██ █ █ ██████ █ ██ █ █ █ █ ██ ███ ◄
__##___##_#_#_______
► █ █ ██ ███ █ ██ █ █ ██ █ █ ██ ███ █ █ ███ █ █ ◄
__##___###_#________
► █ ██ █ █ ███ █ ██ ██ █ ██ █ █ █ █ ◄
__##___#_##_________
► ██ █ █ █ ██ ██ ████ █ ◄
__##____###_________
► ██ █ ██ ██ █ █ ◄
__##____#_#_________
► ██ ██ ██ ◄
__##_____#__________
 
__##________________
A 1D Cellular Atomaton with 70 cells and periodic bounds.
__##________________
►████ ██ █ █ █ ██ ██ █ █ ████ █ ███ ███ ██ ██ ██ ◄
►█ █ ███ █ ██ ███ █ █ █ █ █ █ ████ ██████◄
►█ █ █ ██ █ ██ █ ██ █ █ ◄
► █ ██ ███ ██ ◄
► ██ █ █ ██ ◄
► ██ █ ██ ◄
► ██ ██ ◄
</pre>
 
Line 3,117 ⟶ 3,486:
_##________________
</pre>
 
=={{header|Liberty BASIC}}==
{{works with|Just BASIC}}
{{works with|Run BASIC}}
<syntaxhighlight lang="lb">' [RC] 'One-dimensional cellular automata'
 
' does not wrap so fails for some rules
rule$ ="00010110" ' Rule 22 decimal
 
state$ ="0011101101010101001000"
 
for j =1 to 20
print state$
oldState$ =state$
state$ ="0"
for k =2 to len( oldState$) -1
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
state$ =state$ +"0"
 
next j
 
end</syntaxhighlight>
 
=={{header|Locomotive Basic}}==
 
<syntaxhighlight 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</syntaxhighlight>
 
{{out}}
[[File:Cellular automaton locomotive basic.png]]
 
=={{header|Logo}}==
Line 4,281 ⟶ 4,606:
true .
</pre>
 
=={{header|PureBasic}}==
<syntaxhighlight 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
CopyArray(nG(), cG())
Until Gen > 9
PrintN("Press any key to exit"): Repeat: Until Inkey() <> ""</syntaxhighlight>
{{out}}
<pre>Generation 0: _###_##_#_#_#_#__#__
Generation 1: _#_#####_#_#_#______
Generation 2: __##___##_#_#_______
Generation 3: __##___###_#________
Generation 4: __##___#_##_________
Generation 5: __##____###_________
Generation 6: __##____#_#_________
Generation 7: __##_____#__________
Generation 8: __##________________
Generation 9: __##________________</pre>
 
=={{header|Python}}==
Line 5,401 ⟶ 5,682:
__##________________
__##________________
</pre> =={{header|Seed7}}==
A graphical cellular automaton can be found [http://seed7.sourceforge.net/algorith/graphic.htm#cellauto here].
 
> 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
 
=={{header|SequenceL}}==
Line 5,652 ⟶ 5,910:
Gen 8: ...##...................
Gen 9: ...##...................</syntaxhighlight>
 
=={{header|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.
 
<syntaxhighlight 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</syntaxhighlight>
 
Output:
<pre>C:\>CellularAutomata _###_##_#_#_#_#__#__
000: _###_##_#_#_#_#__#__
001: _#_#####_#_#_#______
002: __##___##_#_#_______
003: __##___###_#________
004: __##___#_##_________
005: __##____###_________
006: __##____#_#_________
007: __##_____#__________
008: __##________________
Sample stable after 8 generations.</pre>
 
=={{header|Wart}}==
Line 5,863 ⟶ 5,998:
=={{header|Wren}}==
{{trans|Kotlin}}
<syntaxhighlight lang="ecmascriptwren">var trans = "___#_##_"
 
var v = Fn.new { |cell, i| (cell[i] != "_") ? 1 : 0 }
Line 5,927 ⟶ 6,062:
______##________________________
</pre>
 
=={{header|Yabasic}}==
{{trans|Locomotive_Basic}}
<syntaxhighlight lang="yabasic">10 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 "_"; END IF
50 IF x(j-1)+x(j)+x(j+1)=2 THEN x2(j)=1 ELSE x2(j)=0 END IF
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</syntaxhighlight>
 
Other solution
<syntaxhighlight lang="yabasic">start$ = "0,1,1,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1,0,0"
 
dim x$(1)
 
for k = 1 to 10
n = token(start$, x$(), ",")
redim x$(n+1)
start$ = ""
for j = 1 to n
if val(x$(j)) then print "#"; else print "_"; end if
test = abs(val(x$(j-1)) + val(x$(j)) + val(x$(j+1)) = 2)
start$ = start$ + str$(test) + ","
next j
print
next k</syntaxhighlight>
 
=={{header|zkl}}==
Line 5,989 ⟶ 6,095:
__##________________
</pre>
/pre>
PureFox
9,483

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/349208...349220"