Code archives/Algorithms/Generalized Cellular Automata Handler
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
Rundown of the different classes involved: Automata : contains a grid of cells, a buffer, and a reference to a Ruleset object. Ruleset : contains general details like neighborhood and composition of borders, and an actual set of Rulesetrule objects. Rulesetrule: contains things like the original cell and the result, and a set of Rulesetrulereq objects that have to all be met for the result to take the original's place. Rulesetrulereq: defined in a format where the requirement is satisfied if the number of neighbors of a specified kind is at least X and/or/nand/nor no more than Y. The example is fabulously thorough and everything is pretty well-commented, so it shouldn't be too difficult to figure out. | |||||
' --+-----------------------------------------------------------------------------------------+-- ' | This code was originally written by Sophie Kirschner (sophiek@pineapplemachine.com) | ' | It is released as public domain. Please don't interpret that as liberty to claim credit | ' | that isn't yours, or to sell this code when it could otherwise be obtained for free | ' | because that would be a really shitty thing of you to do. | ' --+-----------------------------------------------------------------------------------------+-- SuperStrict Import brl.retro ' Only used for tostring() methods, feel free to get rid of them if you don't need to use them. ' Example program Rem ' Controls: ' LMB draws "on" cells, RMB draws "off". ' Number keys 1-5 choose ruleset: Conway's Life, HighLife, Fredkin's Automata, Seeds, Brian's Brain ' X clears the grid ' Pressing period or holding space simulates a generation ' Consts for relating the cell grid to the graphics window Const gw%=512,gh%=512 Const cw%=8,ch%=8 ' Define some general rules that'll be used in the various example rulesets Global B1rule :rulesetrule=rulesetrule.Create(0,1,[rulesetrulereq.Create(1,1,1,rulesetrulereq.CONDITIONAND)]) ' Turn on with 1 on neighbor Global B2rule :rulesetrule=rulesetrule.Create(0,1,[rulesetrulereq.Create(1,2,2,rulesetrulereq.CONDITIONAND)]) ' Turn on with 2 on neighbors Global B3rule :rulesetrule=rulesetrule.Create(0,1,[rulesetrulereq.Create(1,3,3,rulesetrulereq.CONDITIONAND)]) ' Turn on with 3 on neighbors Global B5rule :rulesetrule=rulesetrule.Create(0,1,[rulesetrulereq.Create(1,5,5,rulesetrulereq.CONDITIONAND)]) ' Turn on with 5 on neighbors Global B6rule :rulesetrule=rulesetrule.Create(0,1,[rulesetrulereq.Create(1,6,6,rulesetrulereq.CONDITIONAND)]) ' Turn on with 6 on neighbors Global B7rule :rulesetrule=rulesetrule.Create(0,1,[rulesetrulereq.Create(1,7,7,rulesetrulereq.CONDITIONAND)]) ' Turn on with 7 on neighbors Global S23rule :rulesetrule=rulesetrule.Create(1,0,[rulesetrulereq.Create(1,2,3,rulesetrulereq.CONDITIONNAND)]) ' Turn off with anything but 2 or 3 neighbors Global Srule :rulesetrule=rulesetrule.Create(1,0,Null) ' Turn off regardless of neighbors Global border0%[]=[0,0,0,0] ' John Conway's Game of Life - http://en.wikipedia.org/wiki/Conway's_Game_of_Life Global ConwaysGOL:ruleset=ruleset.Create(2,border0,ruleset.MooresNeighborhood) ' B3-S23 ConwaysGOL.addrule(B3rule) ConwaysGOL.addrule(S23rule) ' HighLife - http://en.wikipedia.org/wiki/HighLife Global HighLife:ruleset=ruleset.Create(2,border0,ruleset.MooresNeighborhood) ' B36-S23 HighLife.addrule(B3rule);HighLife.addrule(B6rule) HighLife.addrule(S23rule) ' Fredkin's Automata - http://www.rennard.org/alife/english/acintrogb01.html Global FredkinsAutomata:ruleset=ruleset.Create(2,border0,ruleset.MooresNeighborhood) ' B1357-S02468 FredkinsAutomata.addrule(B1rule);FredkinsAutomata.addrule(B3rule);FredkinsAutomata.addrule(B5rule);FredkinsAutomata.addrule(B7rule) FredkinsAutomata.addrule(rulesetrule.Create(1,0,[ rulesetrulereq.Create(1,0,0,rulesetrulereq.CONDITIONNAND), .. ' Turn off with anything but 0, 2, 4, 6, or 8 neighbors rulesetrulereq.Create(1,2,2,rulesetrulereq.CONDITIONNAND), .. rulesetrulereq.Create(1,4,4,rulesetrulereq.CONDITIONNAND), .. rulesetrulereq.Create(1,6,6,rulesetrulereq.CONDITIONNAND), .. rulesetrulereq.Create(1,8,8,rulesetrulereq.CONDITIONNAND) ])) ' Seeds - http://en.wikipedia.org/wiki/Seeds_(cellular_automaton) Global Seeds:ruleset=ruleset.Create(2,border0,ruleset.MooresNeighborhood) ' B2-S Seeds.addrule(B2rule) Seeds.addrule(Srule) ' Brian's Brain - http://en.wikipedia.org/wiki/Brian's_Brain Global BriansBrain:ruleset=ruleset.Create(3,border0,ruleset.MooresNeighborhood) ' B2-S with a third "refractory" state BriansBrain.addrule(B2rule) BriansBrain.addrule(rulesetrule.Create(1,2,Null)) ' Turn on to refractory unconditionally BriansBrain.addrule(rulesetrule.Create(2,0,Null)) ' Turn refractory to off unconditionally ' graphics window Graphics gw,gh ' render the cells with these colors Global cellcolors%[][]=[[0,0,0],[255,255,255],[0,0,255]] ' cellular automata object containing a grid of cells Global cells:automata=automata.Create(gw/cw,gh/ch,ConwaysGOL) ' main loop Repeat Cls ' draw on grid with mouse - left mouse turns on, right mouse turns off Local mx%=MouseX()/cw,my%=MouseY()/ch mx=Max(0,Min(cells.width-1,mx));my=Max(0,Min(cells.height-1,my)) If MouseDown(1) Then cells.setcell(mx,my,1) ElseIf MouseDown(2) cells.setcell(mx,my,0) EndIf ' clear grid on pressing x If KeyHit(key_x) Then cells.clearcells ' switch ruleset with number keys If KeyHit(key_1) Then cells.rules=ConwaysGOL If KeyHit(key_2) Then cells.rules=HighLife If KeyHit(key_3) Then cells.rules=FredkinsAutomata If KeyHit(key_4) Then cells.rules=Seeds If KeyHit(key_5) Then cells.rules=BriansBrain ' draw it SetColor 255,255,0 For Local i%=0 Until cells.width For Local j%=0 Until cells.height Local c%=cells.getcell(i,j) SetColor cellcolors[c][0],cellcolors[c][1],cellcolors[c][2] DrawRect i*cw,j*ch,cw,ch Next Next ' update when pressing period or holding down space If KeyDown(key_space) Or KeyHit(key_period) Then cells.update Flip If KeyDown(27) Or AppTerminate() Then End Forever EndRem ' Cellular automata grid type Type automata Field width%,height% ' Dimensions of the cell grid Field grid%[][] ' Actual cell grid Field buffer%[][] ' Buffer for the cell grid, gets important when updating Field rules:ruleset ' Defines the actual ruleset to be used ' Create a new automata object Function Create:automata(w%,h%,rules:ruleset) Local n:automata=New automata n.setsize w,h n.rules=rules Return n End Function ' Set cell grid size Method setsize(w%,h%) width=w;height=h grid=New Int[][w] buffer=New Int[][w] For Local i%=0 Until w grid[i]=New Int[h] buffer[i]=New Int[h] Next End Method ' Get the cell at a coord Method getcell%(x%,y%) Assert grid Assert x>=0 And y>=0 And x<width And y<height Return grid[x][y] End Method ' Set the cell at a coord Method setcell(x%,y%,element%) Assert grid Assert x>=0 And y>=0 And x<width And y<height grid[x][y]=element End Method ' Clear all cells to a value Method clearcells(element%=0) Assert grid For Local i%=0 Until width For Local j%=0 Until height grid[i][j]=element Next Next End Method ' Update the simulation Method update() Assert grid And buffer ' Iterate through all cells For Local i%=0 Until width Assert i<grid.length For Local j%=0 Until height Assert j<grid[i].length Assert grid[i][j]<rules.rules.length Local rulesarray:rulesetrule[]=rules.rules[grid[i][j]] buffer[i][j]=grid[i][j] ' Do nothing if no rules apply directly to this cell state If rulesarray And rulesarray.length Then Local neighbors%[rules.elements] Assert rules.neighborhood ' Iterate through all the cells in this one's neighborhood and tally up the numbers of each cell state For Local coord%[]=EachIn rules.neighborhood Local nx%=i+coord[0] Local ny%=j+coord[1] If nx<0 neighbors[rules.border[rules.BORDERWEST]]:+1 ElseIf nx>=width neighbors[rules.border[rules.BORDEREAST]]:+1 ElseIf ny<0 neighbors[rules.border[rules.BORDERNORTH]]:+1 ElseIf ny>=height neighbors[rules.border[rules.BORDERSOUTH]]:+1 Else neighbors[grid[nx][ny]]:+1 EndIf Next ' Iterate through all rules which apply to this cell state For Local r:rulesetrule=EachIn rulesarray Local allreqs%=1 Assert r.reqs ' Iterate through all the rule's rulereqs For Local req:rulesetrulereq=EachIn r.reqs Local atleast%=(req.at_least=-1) Or (neighbors[req.element]>=req.at_least) Local atmost%=(req.at_most=-1) Or (neighbors[req.element]<=req.at_most) If Not ((req.condition=rulesetrulereq.CONDITIONAND And (atleast And atmost)) Or .. ' AND conditional (req.condition=rulesetrulereq.CONDITIONNAND And Not (atleast And atmost)) Or .. ' NAND conditional (req.condition=rulesetrulereq.CONDITIONOR And (atleast Or atmost)) Or .. ' OR conditional (req.condition=rulesetrulereq.CONDITIONNOR And Not (atleast Or atmost)) Or .. ' NOR conditional (req.condition=rulesetrulereq.UNCONDITIONAL)) Then ' unconditional allreqs=0;Exit EndIf Next ' Only apply the rule (change the cell to the result) if all of the rulereqs are satisfied If allreqs Then buffer[i][j]=r.result Exit EndIf Next EndIf Next Next ' Swap the main grid of cells for the new one that just got put in the buffer Local t%[][]=grid grid=buffer;buffer=t End Method End Type ' Cellular automata ruleset type Type ruleset ' Frequently-used neighborhoods for convenience Global VonNeumannNeighborhood%[][]=[[-1,0],[1,0],[0,-1],[0,1]] Global MooresNeighborhood%[][]=[[-1,-1],[-1,0],[-1,1],[0,-1],[0,1],[1,-1],[1,0],[1,1]] Field elements%=2 ' Number of elements the ruleset deals with Field border%[] ' Composition of borders when they get considered as neighbors Field neighborhood%[][] ' Neighborhood; see this type's globals for examples Field rules:rulesetrule[][] ' Array containing an actual set of rules Const BORDEREAST%=0,BORDERSOUTH%=1,BORDERWEST%=2,BORDERNORTH%=3 ' Constants for use with the border[] array ' Create a new ruleset object Function Create:ruleset(elements%,border%[],neighborhood%[][]) Local n:ruleset=New ruleset n.elements=elements n.border=border n.neighborhood=neighborhood n.rules=New rulesetrule[][n.elements] Return n End Function ' Add a rulesetrule to the ruleset's array of rules Method addrule(r:rulesetrule) Local length% If Not rules[r.element] Then length=0 rules[r.element]=New rulesetrule[1] Else length=rules[r.element].length rules[r.element]=rules[r.element][..length+1] EndIf rules[r.element][length]=r End Method ' Useful for debugging, since rulesets can be a little esoteric Method tostring$() Local str$="" For Local rulesarray:rulesetrule[]=EachIn rules Local rstr$="" For Local rule:rulesetrule=EachIn rulesarray rstr:+rule.tostring()+"; " Next rstr=Left(rstr,rstr.length-2) If rstr Then str:+rstr+"~n" Next Return Left(str,str.length-1) End Method End Type ' Cellular automata rule type; rulesets contain these Type rulesetrule Field element% ' Cell state that the rule gets applied to Field result% ' State that the cell becomes if all the rule's requirements ("reqs") are met Field reqs:rulesetrulereq[] ' Array containing a set of requirements ("reqs") to be met ' Creates a new rulesetrule object Function Create:rulesetrule(element%,result%,reqs:rulesetrulereq[]) Local n:rulesetrule=New rulesetrule n.element=element n.result=result n.reqs=reqs Return n End Function ' Useful for debugging, since rulesets can be a little esoteric Method tostring$() Local str$="Element: "+element+", Result: "+result+": " For Local req:rulesetrulereq=EachIn reqs str:+"("+req.tostring()+") AND " Next If reqs.length Then str=Left(str,str.length-5) Return str End Method End Type ' Cellular automata rule requirement type; rulesetrules contain these, and for a rule to take effect all of its rulereqs must be satisfied Type rulesetrulereq Field element% ' Which cell state is being counted from one cell's neighbors Field at_least%=-1 ' The minimum number of neighboring cells of the specified state; -1 is analogous to "At least zero" Field at_most%=-1 ' The maximum number of neighboring cells of the specified state; -1 is analogous to "At most [highest possible number of neighbors]" Field condition%=CONDITIONAND ' Important! Logical operators for whether the min AND max should be met, min OR max, min NAND max, min NOR max, or whether the requirement is just bollocks and "UNCONDITIONAL" Const CONDITIONAND%=0,CONDITIONOR%=1,CONDITIONNAND%=2,CONDITIONNOR%=3,UNCONDITIONAL%=4 ' Creates a new rulesetrulereq object Function Create:rulesetrulereq(element%,at_least%=-1,at_most%=-1,condition%=CONDITIONAND) Local n:rulesetrulereq=New rulesetrulereq n.element=element n.at_least=at_least n.at_most=at_most n.condition=condition Return n End Function ' Useful for debugging, since rulesets can be a little esoteric Method tostring$() If condition=UNCONDITIONAL Then Return "UNCONDITIONAL" Local cond$[]=["AND","OR","NAND","NOR"] Local least$="[1]" If at_least>=0 Then least="At least "+at_least Local most$="[1]" If at_most>=0 Then most="At most "+at_most Return least+" "+cond[condition]+" "+most End Method End Type |
Comments
None.
Code Archives Forum