1-D Cellular Automaton 0.1.3

1次元のセルオートマトン (CA) は $x$ 方向だけに広がるセル（小さな正方形）に白か黒を置き、ルールに従って次の世代の白黒を決めます。あるセル $c_i$ とその両隣のセル $c_{i-1}$ と $c_{i+1}$ がどうなっているかによって、次の世代の $c_i$ を決めるので、ルールは256通り存在します。

ルールの番号を2進表示した8桁の並びがそれぞれ $c_{i-1} \ c_i \ c_{i+1}$ の組 $111 \ 110 \ 101 \ 100 \ 011 \ 010 \ 001 \ 000$ に対応した次の世代の $c_i$ を表します。例えばルール0は、前の世代がどのような値でも次の世代は $0$ になり、逆にルール255は、前の世代がどのような値でも次の世代は $1$ になります。ルール50の場合は、2進表示が $00110010$ なので、前の世代が $101 \ 100 \ 001$ のときに $1$ になります。

実行結果

Small Basic オンラインで実行したスクリーンショットを以下に示します。ここではルール18を採用しています。18はその2進表示が $000100010$ なので、 $100$ と $001$ のときだけ $1$ になるというルールです。 $0$ を白、$1$ を黒で表示しています。

一番上の行が世代0で、その次の行が世代1と、下に行くほど世代が新しくなります。世代0は中央のセルのみ $1$ にしています。

下図はルール18の内容を示したものです。世代 $t$ のセル $c_{i-1} \ c_i \ c_{i+1}$ とそのパターンに対する世代 $t+1$ のセル $c_i$ を表示しています。

世代0の初期値をランダムに設定するとまた違った結果になります。下図はルール8の内容を示したものです。結果が均一になり、クラス1の CA に分類されます。

下図はルール200の内容を示したものです。結果が周期的になり、クラス2の CA に分類されます。

下図はルール129の内容を示したものです。結果がカオス的になり、クラス3の CA に分類されます。

結果が複雑になるクラス4の CA もあるのですが、視覚的な判定が難しいので今回は省略します。

ソース

1DCA_0_1_3.txt

元のプログラム XMC184 は連続して全てのルールを表示するようにしていたのですが、 Small Basic オンラインの表示速度がとても遅いので、ルール番号を入力するようにしました。ルール番号を入力して [Draw] ボタンを押すと、そのルールのセルオートマトンを表示します。

7行目：世代0の初期値は random = "False" のときは中央のセルのみ 1 にします。 "True" のときはランダムに設定します。
13行目：Init という初期化サブルーチンのなかで、[Draw] ボタンのイベントを設定しています。
15行目：サブルーチン CA でセルオートマトンを計算しながら描画します。
17行目：サブルーチン Clear でセルを白に戻します。
18行目：サブルーチン Gen0 で世代0の中央のセルを $1$ にします。
19行目：サブルーチン DrawCells でそれを描画します。
21行目：サブルーチン CalcNextCells で次の世代のセルを計算します。
23行目：サブルーチン DrawCells それを描画します。
59行目：[Draw] ボタンを連打すると、前の描画が終わらないうちに次の描画が始り、次の描画が終わった後（変数 row が行数 rows 以上になった状態）で前の描画の続きが始まることがあるようで、セルの最終行よりも下に描画される現象が発生したため、セルの範囲を超えた描画はしないように判定を加えました。
124行目：以前の版ではルールの番号に対応する前の世代の並びを $000 \ 001 \ 010 \ 011 \ 100 \ 101 \ 110 \ 111$ としていたのですが、世の中の定義と逆だったので、直しました。
135～139行目：単に [Draw] を押し続ければ次のルールを描画するように、ルール番号に 1 を足してテキストボックスに戻しています。

' 1-D Cellular Automaton
' Version 0.1.3
' Copyright © 2020 Nonki Takahashi.  The MIT License.
' Program ID XMC184-3

title = "1-D Cellular Automaton"
random = "False"
wait = 500 ' ms
cellSize = 4
cols = 100
rows = 100
yOffset = 34
Init()

Sub CA
    Shapes.SetText(shTitle, title + " | rule = " + rule)
    Clear()
    Gen0()
    DrawCells()
    For row = 1 To rows - 1
        CalcNextCells()
        cell = next
        DrawCells()
    EndFor
EndSub

Sub CalcNextCells
    ' param cell[] - current generation 
    ' param row - for next generation
    ' return next[] - next generation
    next = ""
    For col = 0 To cols - 1
        c3 = 0
        If cell[col - 1] Then
            c3 = c3 + 4
        EndIf
        If cell[col] Then
            c3 = c3 + 2
        EndIf
        If cell[col + 1] Then
            c3 = c3 + 1
        EndIf
        If ruleset[rule][c3] = 1 Then
            next[col] = "True"
        EndIf
    EndFor
EndSub

Sub Clear
    GraphicsWindow.BrushColor = "White"
    GraphicsWindow.FillRectangle(0, yOffset, gw, gh)
EndSub

Sub DrawCells
    ' param row - generation to draw (0 origin)
    ' param cell[] - current generation
    GraphicsWindow.BrushColor = "Black"
    For col = 0 To cols - 1
        If rows - 1 < row Then
            col = cols - 1  ' exit For to avoid over run
        ElseIf cell[col] Then
            x = col * cellSize
            y = row * cellSize
            GraphicsWindow.FillRectangle(x, y + yOffset, cellSize, cellSize)
        EndIf
    EndFor
EndSub

Sub DrawGrid
    ' param gw, gh - window size [px]
    ' param cellSize - cell size [px]
    GraphicsWindow.PenWidth = 0
    GraphicsWindow.BrushColor = "LightGray"
    For x = 0 To gw Step cellSize
        line = Shapes.AddRectangle(1, gh)
        Shapes.Move(line, x, yOffset)
    EndFor
    For y = 0 To gh Step cellSize
        line = Shapes.AddRectangle(gw, 1)
        Shapes.Move(line, 0, y + yOffset)
    EndFor
EndSub

Sub Gen0
    ' initialize generation 0 for top line
    row = 0
    If random Then
        For col = 0 To cols - 1
            If Math.GetRandomNumber(2) - 1 = 1 Then
                cell[col] = "True"
            Else
                cell[col] = "False"
            EndIf
        EndFor
    Else
        For col = 0 To cols - 1
            If col = Math.Round(cols / 2) Then
                cell[col] = "True"
            Else
                cell[col] = "False"
            EndIf
        EndFor
    EndIf
EndSub

Sub Init
    gw = cols * cellSize
    gh = rows * cellSize
    GraphicsWindow.BrushColor = "Black"
    GraphicsWindow.FontName = "Arial"
    shTitle = Shapes.AddText(title)
    Shapes.Move(shTitle, 10, 8)
    GraphicsWindow.DrawText(250, 8, "rule")
    tbox = Controls.AddTextBox(280, 4)
    Controls.SetSize(tbox, 40, yOffset - 14)
    Controls.SetTextBoxText(tbox, 0)
    btn = Controls.AddButton("Draw", gw - 60, 2)
    Controls.SetSize(btn, 50, yOffset - 4)
    DrawGrid()
    ' initialize ruleset
    For i = 0 To 255
        n = i
        p = ""
        For d = 0 To 7
            p[d] = Math.Remainder(n, 2)
            n = Math.Floor(n / 2)
        EndFor
        ruleset[i] = p
    EndFor
    Controls.ButtonClicked = OnButtonClicked
EndSub

Sub OnButtonClicked
    rule = Controls.GetTextBoxText(tbox)
    _rule = rule + 1
    If 255 < _rule Then
        _rule = 0
    EndIf
    Controls.SetTextBoxText(tbox, _rule)
    CA()
EndSub

RuleViewer.txt

ルールに対する世代 $t$ と世代 $t+1$ の関係を示すプログラムです。ルール番号を入力して [Draw] ボタンを押すと、そのルールの関係を表示します。

9行目：Init という初期化サブルーチンのなかで、[Draw] ボタンのイベントを設定しています。
11行目：サブルーチン DrawCells では世代 $t$ のセルと世代 $t+1$ のセルの枠を描画します。
61行目：イベントハンドラ OnButtonClick で世代 $t$ のセルを描画します。

' 1DCA Rule Viewer
' Version 0.1.0
' Copyright © 2020 Nonki Takahashi.  The MIT License.
' Last update 2020-09-19

title = "1DCA Rule Viewer"
yOffset = 34
cellSize = 14
Init()

Sub DrawCells
    _y = y + 2 * yOffset + 8
    GraphicsWindow.PenColor = "Gray"
    For j = 0 To 7
        n = 7 - j
        For i = 2 To 0 Step -1
            If Math.Remainder(n, 2) = 1 Then
                GraphicsWindow.BrushColor = "Black"
            Else
                GraphicsWindow.BrushColor = "White"
            EndIf
            n = Math.Floor(n / 2)
            _x = x + 120 + j * cellSize * 4 + i * cellSize
            cell = Shapes.AddRectangle(cellSize, cellSize)
            Shapes.Move(cell, _x, _y)
            If i = 1 Then
                GraphicsWindow.BrushColor = "#00000000"
                cell = Shapes.AddRectangle(cellSize, cellSize)
                Shapes.Move(cell, _x, _y + yOffset)
            EndIf
        EndFor
    EndFor
EndSub

Sub Init
    gw = GraphicsWindow.Width
    gh = GraphicsWindow.Height
    fw = 600
    fh = 200
    GraphicsWindow.BackgroundColor = "LightGray"
    x = (gw - fw) / 2
    y = (gh - fh) / 2
    GraphicsWindow.BrushColor = "White"
    GraphicsWindow.FillRectangle(x, y, fw, fh)
    GraphicsWindow.BrushColor = "Black"
    GraphicsWindow.FontName = "Arial"
    shTitle = Shapes.AddText(title)
    Shapes.Move(shTitle, x + 10, y + 8)
    GraphicsWindow.DrawText(x + fw - 170, y + 8, "rule")
    tbox = Controls.AddTextBox(x + fw - 130, y + 4)
    Controls.SetSize(tbox, 40, yOffset - 14)
    Controls.SetTextBoxText(tbox, 0)
    btn = Controls.AddButton("Draw", x + fw - 60, y + 2)
    Controls.SetSize(btn, 50, yOffset - 4)
    GraphicsWindow.DrawText(x + 10, y + 2 * yOffset + 8, "Generation t")
    GraphicsWindow.DrawText(x + 10, y + 3 * yOffset + 8, "Generation t+1")
    DrawCells()
    Controls.ButtonClicked = OnButtonClicked
EndSub

Sub OnButtonClicked
    rule = Controls.GetTextBoxText(tbox)
    Shapes.SetText(shTitle, title + " | rule = " + rule)
    _rule = rule + 1
    If 255 < _rule Then
        _rule = 0
    EndIf
    Controls.SetTextBoxText(tbox, _rule)  
    _y = y + 3 * yOffset + 8
    For j = 7 To 0 Step -1
        If Math.Remainder(rule, 2) = 1 Then
            GraphicsWindow.BrushColor = "Black"
        Else
            GraphicsWindow.BrushColor = "White"
        EndIf
        _x = x + 120 + (4 * j + 1) * cellSize
        GraphicsWindow.FillRectangle(_x, _y, cellSize, cellSize)
        rule = Math.Floor(rule / 2)
    EndFor
EndSub