How not to be bored with...

finite machines...

Introduction

Cellular Automata, are automated machines that has a finite number of states, input/output symbols and transition functions.

A Handful of Automata

I really recommend you to acquire Wolfram's Mathematica. Plotting is the least you can do with it. You can also use it to explore the behavior of different automata.

(* ========================================================================= ) ( CELLULAR AUTOMATA COMPENDIUM IN WOLFRAM MATHEMATICA ) ( Exploring Elementary, Totalistic, 2D (Game of Life), Cyclic, ) ( Probabilistic (Forest Fire), and Turmites / Langton's Ant with Plots ) ( ========================================================================= *) (* STREAMING_CHUNK:Configuring notebook environment and display styling ) ClearAll["Global`"]; (* Global aesthetic styling parameters for ArrayPlot and visualizations *) $DefaultColorSchemes = <| "Elementary" -> "SunsetColors", "Monochrome" -> "Monochrome", "GameOfLife" -> "DeepSeaColors", "Cyclic" -> "Rainbow", "ForestFire" -> {0 -> Black, 1 -> Darker[Green, 0.2], 2 -> Orange}, "Ant" -> {0 -> White, 1 -> GrayLevel[0.85], 2 -> Red} |>; (* STREAMING_CHUNK:Defining Elementary Cellular Automata (ECA) generator ) ( 1. ELEMENTARY CELLULAR AUTOMATA (ECA) Wolfram 1D system: 2 states (0, 1), nearest-neighbor radius r=1. Rules 0 to 255. Demonstrates Classes 1 through 4 (e.g. 30, 90, 110, 184). *) plotECA[rule_Integer, steps_Integer: 150, init_ : "Center", opts : OptionsPattern[]] := Module[{initialCondition, evolution, plot}, initialCondition = Switch[init, "Center", CenterList[2 * steps + 1], "Random", RandomInteger[{0, 1}, 2 * steps + 1], _, init ]; (* Compute evolution matrix: steps x (2*steps + 1) *) evolution = CellularAutomaton[rule, initialCondition, steps]; plot = ArrayPlot[evolution, ColorRules -> {0 -> White, 1 -> Darker[Blue, 0.4]}, Frame -> True, FrameLabel -> {"Cell Index", "Time Step (t :2193)"}, PlotLabel -> Style[StringForm["Elementary Cellular Automaton: Rule ( steps)", rule, steps], Bold, 13], ImageSize -> Medium, opts ]; Return[<|"Evolution" -> evolution, "Plot" -> plot|>] ]; CenterList[size_Integer] := ReplacePart[ConstantArray[0, size], Ceiling[size / 2] -> 1]; (* STREAMING_CHUNK:Rendering iconic ECA rules gallery and 3D space-time plots ) ( Gallery of representative ECA rules: Rule 30 (Class 3: Chaotic pseudo-random generator) Rule 90 (Additive: Sierpinski triangle fractal) Rule 110 (Class 4: Universal Turing-complete computation) Rule 184 (Traffic flow model / surface growth) *) iconicRules = {30, 90, 110, 184}; ecaPlots = Table[ plotECA[r, 100, "Center"]["Plot"], {r, iconicRules} ]; ecaGallery = GraphicsGrid[ Partition[ecaPlots, 2], ImageSize -> Large, PlotLabel -> Style["Wolfram Elementary Cellular Automata Gallery", Bold, 15] ]; (* 3D Space-Time Pyramid representation of Rule 30 *) plotECA3D[rule_Integer: 30, steps_Integer: 80] := Module[{data, height, width}, data = CellularAutomaton[rule, CenterList[2 * steps + 1], steps]; {height, width} = Dimensions[data]; ListPlot3D[data, Mesh -> None, ColorFunction -> "DarkRainbow", BoxRatios -> {1, 1, 0.35}, PlotRange -> All, AxesLabel -> {"Cell Coordinate", "Time Step", "State"}, PlotLabel -> Style[StringForm["3D Space-Time Landscape: Rule ``", rule], Bold, 13], ImageSize -> Medium ] ]; (* STREAMING_CHUNK:Implementing 1D Totalistic and multi-state cellular automata ) ( 2. TOTALISTIC 1D CELLULAR AUTOMATA Next state depends solely on the sum of neighbor values. 3 states {0, 1, 2}, radius r=1. Rule space ranges from 0 to 3^7 - 1 = 2186. *) plotTotalistic1D[code_Integer: 777, steps_Integer: 120] := Module[{ruleSpec, evolution}, ruleSpec = {code, {3, 1}}; (* 3 states, radius 1 totalistic *) evolution = CellularAutomaton[ruleSpec, CenterList[2 * steps + 1], steps]; ArrayPlot[evolution, ColorFunction -> "Viridis", ColorFunctionScaling -> True, FrameLabel -> {"Cell Position", "Time (t)"}, PlotLabel -> Style[StringForm["1D Totalistic CA: Code `` (k=3, r=1)", code], Bold, 13], ImageSize -> Medium ] ]; (* STREAMING_CHUNK:Constructing 2D Cellular Automata and Conway's Game of Life ) ( 3. 2D CELLULAR AUTOMATA (Outer-Totalistic Life-like CA) Conway's Game of Life rule: B3/S23 (Birth on 3, Survival on 2 or 3). Implemented both via built-in CellularAutomaton and via ListCorrelate kernel. *) lifeRuleSpecification = {224, {2, {{2, 2, 2}, {2, 1, 2}, {2, 2, 2}}}, {1, 1}}; (* Common initial pattern generators *) glider = {{0, 1, 0}, {0, 0, 1}, {1, 1, 1}}; rPentomino = {{0, 1, 1}, {1, 1, 0}, {0, 1, 0}}; pulsar = { {0,0,1,1,1,0,0,0,1,1,1,0,0}, {0,0,0,0,0,0,0,0,0,0,0,0,0}, {1,0,0,0,0,1,0,1,0,0,0,0,1}, {1,0,0,0,0,1,0,1,0,0,0,0,1}, {1,0,0,0,0,1,0,1,0,0,0,0,1}, {0,0,1,1,1,0,0,0,1,1,1,0,0}, {0,0,0,0,0,0,0,0,0,0,0,0,0}, {0,0,1,1,1,0,0,0,1,1,1,0,0}, {1,0,0,0,0,1,0,1,0,0,0,0,1}, {1,0,0,0,0,1,0,1,0,0,0,0,1}, {1,0,0,0,0,1,0,1,0,0,0,0,1}, {0,0,0,0,0,0,0,0,0,0,0,0,0}, {0,0,1,1,1,0,0,0,1,1,1,0,0} }; embedInGrid[pattern_List, gridSize_Integer: 50] := Module[{canvas, pH, pW, rStart, cStart}, canvas = ConstantArray[0, {gridSize, gridSize}]; {pH, pW} = Dimensions[pattern]; rStart = Floor[(gridSize - pH)/2] + 1; cStart = Floor[(gridSize - pW)/2] + 1; canvas[[rStart ;; rStart + pH - 1, cStart ;; cStart + pW - 1]] = pattern; canvas ]; simulateGameOfLife[initialGrid_List, steps_Integer: 100] := CellularAutomaton[lifeRuleSpecification, initialGrid, steps]; plotGameOfLifeSnapshot[grid_List, stepNum_Integer: 0] := ArrayPlot[grid, ColorRules -> {0 -> GrayLevel[0.05], 1 -> RGBColor[0.2, 0.9, 0.6]}, Mesh -> True, MeshStyle -> Directive[GrayLevel[0.15], AbsoluteThickness[0.5]], PlotLabel -> Style[StringForm["Conway's Game of Life (Step ``)", stepNum], Bold, 13], ImageSize -> Medium ]; (* STREAMING_CHUNK:Building Cyclic Cellular Automata (CCA) simulation engine ) ( 4. CYCLIC CELLULAR AUTOMATA (CCA) Self-organizing spiral waves simulating excitable chemical media (e.g. BZ reaction). States: 0 to N-1. Cell advances from s to (s + 1) mod N if threshold neighbors have state (s + 1) mod N. *) stepCyclicCA[grid_List, numStates_Integer, threshold_Integer, kernel_List] := Module[{nextStates, neighborCounts, mask}, nextStates = Mod[grid + 1, numStates]; (* Count for each cell how many neighbors have the next cycle state *) neighborCounts = Total[ Map[ Function[offset, Unitize[Clip[UnitStep[RotateRight[grid, offset] - nextStates] * UnitStep[nextStates - RotateRight[grid, offset]], {0, 1}]] ], kernel ] ]; (* Cells transition if neighboring target count meets threshold *) mask = UnitStep[neighborCounts - threshold]; Mod[grid + mask, numStates] ]; runCyclicCA[gridSize_Integer: 80, steps_Integer: 120, numStates_Integer: 8, threshold_Integer: 1] := Module[{initialGrid, mooreKernel, history, current}, initialGrid = RandomInteger[{0, numStates - 1}, {gridSize, gridSize}]; (* Moore neighborhood coordinate offsets excluding origin (0,0) *) mooreKernel = DeleteCases[Tuples[{-1, 0, 1}, 2], {0, 0}]; current = initialGrid; history = Reap[ Sow[current]; Do[ current = stepCyclicCA[current, numStates, threshold, mooreKernel]; Sow[current], {steps} ] ][[2, 1]]; history ]; plotCyclicCA[grid_List, stepIdx_Integer] := ArrayPlot[grid, ColorFunction -> "Rainbow", ColorFunctionScaling -> True, PlotLabel -> Style[StringForm["Cyclic CA: Spiral Morphogenesis (t = ``)", stepIdx], Bold, 13], ImageSize -> Medium ]; (* STREAMING_CHUNK:Developing Stochastic Forest Fire Cellular Automaton ) ( 5. PROBABILISTIC / STOCHASTIC CELLULAR AUTOMATON (Forest Fire Model) States: 0 = Empty ground 1 = Tree 2 = Burning tree Transitions: - Burning tree becomes empty ground. - Tree ignites with prob 1 if >= 1 neighbor is burning, or spontaneously by lightning prob f. - Empty ground grows tree with prob p. *) stepForestFire[grid_List, pGrow_Real, pLightning_Real] := Module[{dim, vonNeumannOffsets, burningNeighbors, randGrow, randLight, newGrid}, dim = Dimensions[grid]; vonNeumannOffsets = {{-1, 0}, {1, 0}, {0, -1}, {0, 1}}; (* Check for burning neighbors (cells where state == 2) *) burningNeighbors = Unitize[Total[ Map[Unitize[Clip[RotateRight[grid, #] - 1, {0, 1}] * UnitStep[2 - RotateRight[grid, #]]] &, vonNeumannOffsets] ]]; randGrow = RandomReal[{0, 1}, dim]; randLight = RandomReal[{0, 1}, dim]; newGrid = MapIndexed[ Function[{val, pos}, Switch[val, 2, 0, (* Burning becomes empty *) 1, If[burningNeighbors[[Sequence @@ pos]] > 0 || randLight[[Sequence @@ pos]] < pLightning, 2, 1], 0, If[randGrow[[Sequence @@ pos]] < pGrow, 1, 0] ] ], grid, {2} ]; newGrid ]; runForestFire[gridSize_Integer: 60, steps_Integer: 80, pGrow_: 0.03, pLightning_: 0.0005] := Module[{grid, states = {}}, grid = RandomChoice[{0.6, 0.4, 0.0} -> {0, 1, 2}, {gridSize, gridSize}]; Do[ grid = stepForestFire[grid, pGrow, pLightning]; AppendTo[states, grid], {steps} ]; states ]; plotForestFire[grid_List, t_Integer] := ArrayPlot[grid, ColorRules -> {0 -> GrayLevel[0.1], 1 -> Darker[Green, 0.3], 2 -> RGBColor[1, 0.3, 0.0]}, Frame -> True, PlotLabel -> Style[StringForm["Forest Fire Simulation (Step ``)", t], Bold, 13], ImageSize -> Medium ]; (* STREAMING_CHUNK:Implementing Turmites and Langton's Ant Automaton ) ( 6. TURMITES / LANGTON'S ANT 2D Turing machine moving on a grid: On white (0): turn 90 deg clockwise, flip color to black (1), move forward. On black (1): turn 90 deg counter-clockwise, flip color to white (0), move forward. Produces chaotic highway behavior after ~10,000 steps. *) simulateLangtonsAnt[steps_Integer: 11000, gridSize_Integer: 100] := Module[{grid, antPos, antDir, directions, historySnapshots, x, y, state}, grid = ConstantArray[0, {gridSize, gridSize}]; antPos = {Floor[gridSize / 2], Floor[gridSize / 2]}; (* Directions: 1: North, 2: East, 3: South, 4: West *) antDir = 1; directions = {{-1, 0}, {0, 1}, {1, 0}, {0, -1}}; historySnapshots = <||>; Do[ {x, y} = antPos; state = grid[[x, y]]; If[state == 0, (* Turn 90 deg right, flip to 1 ) antDir = Mod[antDir, 4] + 1; grid[[x, y]] = 1;, ( Turn 90 deg left, flip to 0 *) antDir = Mod[antDir - 2, 4] + 1; grid[[x, y]] = 0; ]; (* Advance forward with toroidal periodic boundary *) antPos = { Mod[x + directions[[antDir, 1]] - 1, gridSize] + 1, Mod[y + directions[[antDir, 2]] - 1, gridSize] + 1 }; If[MemberQ[{500, 5000, 10500, steps}, s], historySnapshots[s] = {grid, antPos} ], {s, 1, steps} ]; historySnapshots ]; plotLangtonsAnt[data_List, stepCount_Integer] := Module[{grid = data[[1]], antPos = data[[2]], displayGrid}, displayGrid = grid; displayGrid[[antPos[[1]], antPos[[2]]]] = 2; (* Highlight Ant in red *) ArrayPlot[displayGrid, ColorRules -> {0 -> White, 1 -> GrayLevel[0.2], 2 -> Red}, PlotLabel -> Style[StringForm["Langton's Ant Highway Formation (Step ``)", stepCount], Bold, 13], ImageSize -> Medium ] ]; (* STREAMING_CHUNK:Constructing interactive Manipulate exploration dashboard ) ( 7. INTERACTIVE MATHEMATICA EXPLORATION SUITE Allows live parametric exploration of rules, neighborhoods, and rendering schemes. *) interactiveCADashboard[] := Manipulate[ Switch[automatonType, "Elementary 1D", ArrayPlot[CellularAutomaton[ruleNumber, CenterList[2 * ecaSteps + 1], ecaSteps], ColorRules -> {0 -> White, 1 -> Darker[Blue, 0.4]}, PlotLabel -> Style[StringForm["ECA Rule `` Evolution", ruleNumber], Bold, 14], ImageSize -> {500, 350} ], "Totalistic 1D", ArrayPlot[CellularAutomaton[{totalisticCode, {3, 1}}, CenterList[2 * ecaSteps + 1], ecaSteps], ColorFunction -> "ThermalColors", PlotLabel -> Style[StringForm["Totalistic Code `` (k=3, r=1)", totalisticCode], Bold, 14], ImageSize -> {500, 350} ], "Game of Life 2D", Module[{history, selectedSeed}, selectedSeed = Switch[lifePattern, "R-Pentomino", rPentomino, "Glider", glider, "Pulsar", pulsar ]; history = simulateGameOfLife[embedInGrid[selectedSeed, 45], lifeStep]; ArrayPlot[history[[lifeStep + 1]], ColorRules -> {0 -> GrayLevel[0.05], 1 -> RGBColor[0.2, 0.9, 0.6]}, PlotLabel -> Style[StringForm["Life: (t =)", lifePattern, lifeStep], Bold, 14], ImageSize -> {450, 450} ] ] ], Delimiter, Style["Automaton Family Selection", Bold, 12], {{automatonType, "Elementary 1D", "Type:"}, {"Elementary 1D", "Totalistic 1D", "Game of Life 2D"}}, Delimiter, Style["1D Parameters", Bold, 12], {{ruleNumber, 30, "ECA Rule (0-255):"}, 0, 255, 1, Visible -> Dynamic[automatonType == "Elementary 1D"]}, {{totalisticCode, 777, "Totalistic Code:"}, 0, 2186, 1, Visible -> Dynamic[automatonType == "Totalistic 1D"]}, {{ecaSteps, 80, "Evolution Steps:"}, 20, 200, 1, Visible -> Dynamic[automatonType != "Game of Life 2D"]}, Delimiter, Style["2D Life Parameters", Bold, 12], {{lifePattern, "R-Pentomino", "Seed Pattern:"}, {"R-Pentomino", "Glider", "Pulsar"}, Visible -> Dynamic[automatonType == "Game of Life 2D"]}, {{lifeStep, 35, "Step Slider:"}, 0, 80, 1, Visible -> Dynamic[automatonType == "Game of Life 2D"]}, ControlPlacement -> Left, SaveDefinitions -> True ]; (* STREAMING_CHUNK:Executing demonstration pipeline and sample outputs ) ( Print the gallery and run snapshots of diverse CA classes *) Print["Evaluating Cellular Automata Compendium..."]; (* 1. Display ECA Gallery *) ecaGallery (* 2. Display 3D Space-Time Pyramid for Rule 30 *) plotECA3D[30, 60] (* 3. Display 1D Totalistic CA *) plotTotalistic1D[777, 100] (* 4. Conway's Game of Life: R-Pentomino dynamic evolution snapshot *) Module[{lifeEvol = simulateGameOfLife[embedInGrid[rPentomino, 50], 40]}, plotGameOfLifeSnapshot[lifeEvol[[41]], 40] ] (* 5. Cyclic Cellular Automaton Spiral Formation Snapshot *) Module[{ccaHistory = runCyclicCA[60, 50, 8, 1]}, plotCyclicCA[ccaHistory[[50]], 50] ] (* 6. Stochastic Forest Fire Snapshot *) Module[{fireHistory = runForestFire[50, 40, 0.04, 0.001]}, plotForestFire[fireHistory[[40]], 40] ] (* 7. Langton's Ant Highway Snapshot *) Module[{antData = simulateLangtonsAnt[10500, 80]}, plotLangtonsAnt[antData[10500], 10500] ] (* 8. Launch Interactive Dashboard *) interactiveCADashboard[]