One-dimensional cellular automata: Difference between revisions

==={{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|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|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|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|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|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) + ","