Conway's Game of Life, a new strategy

[Rod]

Conway's game of life has been programmed many times. On Liberty BASIC the traditional approach is a little slow and restricts the size of the grid that can be displayed. So I was thinking how to speed it all up and optimise the code. Traditional solutions trawl through the whole grid so a 600x600 grid gives 360,000 computations and you need to double that because you need previous and current state.

So how to optimise. Well first thing was to try and just deal with live cells. You have to look at dead cells but because they HAVE to be surrounded by a live cell you only need to check dead cells surrounding a live cell.

The rules are simple. If a live cell is to live it must be surrounded by two or three live cells. If the surrounding cell is empty it can birth a new cell, if it itself, is surrounded by exactly three live cells. So checking live cells and the eight cells surrounding each live cell is all the cells that need checked.

How to do that? Well I keep a list of live cells, a linked list. Each cell points to its previous cell and its next cell so linking the chain of cell info. To store the state I simply redim and save away the cell list thus avoiding a massive trawl again. The linked list itself optimises the computations because I just follow the list and don't need to trawl through all of the array holding the linked list. In the example here I just follow the 22 links in the array and ignore the remaining 978 elements in the array.

This code still has bugs because I want the cells to roll round if they get to the screen edge but the middle bit works and shows the potential. It will slow down with thousands of cells but it is the size of the grid that can't be beaten.

nomainwin
   WindowWidth = 600
   WindowHeight = 600
   open "Conway Life via Linked List" for graphics_nsb_nf as #1
   #1 "trapclose [quit]"
   #1 "down ; fill blue"

   'create grids to hold old and tested state of cells
   dim grid(600,600)
   dim dupl(600,600)

   'create a linked list of live cells in the current grid
   dim cell$(1000)'x y prev next
   cx=1
   cy=2
   prevc=3
   nextc=4

   'glider
   cell$(1)="11 10 0 2"    'x,y,prev,next
   cell$(2)="12 11 1 3"
   cell$(3)="10 12 2 4"
   cell$(4)="11 12 3 5"
   cell$(5)="12 12 4 6"

   'blinker
   cell$(6)="100 100 5 7"
   cell$(7)="101 100 6 8"
   cell$(8)="102 100 7 9"

   'toad
   cell$(9)="200 101 8 10"
   cell$(10)="201 101 9 11"
   cell$(11)="202 101 10 12"
   cell$(12)="199 102 11 13"
   cell$(13)="200 102 12 14"
   cell$(14)="201 102 13 15"

   'becon
   cell$(15)="103 203 14 16"
   cell$(16)="104 203 15 17"
   cell$(17)="103 204 16 18"
   cell$(18)="104 204 17 19"
   cell$(19)="105 205 18 20"
   cell$(20)="106 205 19 21"
   cell$(21)="105 206 20 22"
   cell$(22)="106 206 21 0"  '0 = end of chain



   'store current state to grid
   firstcell=1
   c=firstcell
   while c
       #1 "color white ; set ";val(word$(cell$(c),cx));" ";val(word$(cell$(c),cy))
       grid(val(word$(cell$(c),cx)),val(word$(cell$(c),cy))))=1
       c=val(word$(cell$(c),nextc))
   wend




   timer 56, [cycle]
   wait

   [cycle]
   c=firstcell
   redim dupl(600,600)
   while c
           x=val(word$(cell$(c),cx))
           y=val(word$(cell$(c),cy))
           p=val(word$(cell$(c),prevc))
           n=val(word$(cell$(c),nextc))
           'count surrounding live cells of this live cell
           'keep it alive if it has 2-3 neighbours else kill it
           ct=count(x,y)
           if ct<2 or ct>3 then
               'cell dies
               alive=0
               origc=c
           else
               'cell lives
               alive=1
           end if

           'now check for birthing cells around cell c's x,y
           for yy=-1 to 1
               for xx=-1 to 1
                   'if we move out of bounds roll round screen
                   scx=x+xx : if scx<0 then scx=600 : if scx >600 then scx=1
                   scy=y+yy : if scy<0 then scy=600 : if scy >600 then scy=1
                   'if it is a dead cell and we have not already checked, see if it has three neighbours
                   if grid(scx,scy)=0 and dupl(scx,scy)=0 then
                       'record in dupl() to avoid checking more than once
                       dupl(scx,scy)=1
                       'check how many live cells surround it
                       sct=count(scx,scy)
                       if sct = 3 then
                           'To keep the array compact we simply keep finding the first free slot
                           'thus reusing dead cell slots.
                           i=1
                           while i<100
                               if cell$(i)="" then exit while
                               i=i+1
                           wend
                           'new cell will be inserted after c and point to c as previous n will remain unchanged
                           'i=cell slot we we are storing info in
                           'p=previous cell slot
                           'n=next cell slot
                           'make the current cell point to i as next cells
                           cell$(c)=word$(cell$(c),cx)+" "+word$(cell$(c),cy)+" "+word$(cell$(c),prevc)+" "+str$(i)
                           'insert new cell pointing to c as previous cell and n as next cell
                           cell$(i)=str$(scx)+" "+str$(scy)+" "+str$(c)+" "+str$(n)
                           'make the next cell point to i as the previous cell
                           cell$(n)=word$(cell$(n),cx)+" "+word$(cell$(n),cy)+" "+str$(i)+" "+word$(cell$(n),nextc)
                           #1 "color white ; set ";val(word$(cell$(i),cx));" ";val(word$(cell$(i),cy))
                           'set p and c so that further cells are inserted after i, n remains unchanged
                           p=c
                           c=i
                       end if
                   end if
               next
           next
           'now that we have inserted cells kill the original cell if it died
           if alive=0 then
               'remember what n was then get new values for origc's p and n
               orign=n
               p=val(word$(cell$(origc),prevc))
               n=val(word$(cell$(origc),nextc))
               'make the previous cell point to n, not origc as the next cell
               cell$(p)=word$(cell$(p),cx)+" "+word$(cell$(p),cy)+" "+word$(cell$(p),prevc)+" "+str$(n)
               'make the next cell point to p not origc as the the previous cell
               cell$(n)=word$(cell$(n),cx)+" "+word$(cell$(n),cy)+" "+str$(p)+" "+word$(cell$(n),nextc)

               'if this was the first cell in the list set the new starting point
               if p=0 then firstcell=n

               'erase the cell on screen and in the list
               #1 "color blue ; set ";x;" ";y
               cell$(origc)=""
               n=orign
           end if
           'move to the next cell in the list
           c=n
   wend





   [savestate]
   c=firstcell
   redim grid(600,600)
   while c
       grid(val(word$(cell$(c),cx)),val(word$(cell$(c),cy))))=1
       c=val(word$(cell$(c),nextc))
   wend
   #1 "discard"
   wait

   'scan
   'goto [cycle]





   [quit]
   timer 0
   close #1
   end


function count(x,y)
x1=x-1 :if x1<1 then x1=600
x2=x+1 :if x2>600 then x2=1
y1=y-1 :if y1<1 then y1=600
y2=y+1 :if y2>600 then y2=1
   ct=ct+grid(x1,y1)
   ct=ct+grid(x ,y1)
   ct=ct+grid(x2,y1)
   ct=ct+grid(x1,y )
   'miss middle cell
   ct=ct+grid(x2,y )
   ct=ct+grid(x1,y2)
   ct=ct+grid(x ,y2)
   ct=ct+grid(x2,y2)
   count=ct
end function



[Rod]

Not sure my redim strategy is best option. I think it is stressing Liberty having to manage that memory each cycle. Probably need to think through how else to save the state efficiently.

[tenochtitlanuk]

I was first fascinated by 'Life' when JH Conway introduced it to readers of Scientific American half a century and more ago!

Sounds an interesting approach. Mind you my first coded attempts on early 8-bit machines were desperately slow compared with modern machines.

For fun I set my old Life going last night on a 600x600 grid late last night, and it generated 200 images which I made into an animated GIF. My interest in a sense is the other way round- I set up a random dense grid to see just how much would be left; what percentage in the standard static, oscillator or other known simple patterns. For fun I also included a 'desert' with nothing in it, to see whether anything glided into it. Plus a lone glider starting in that strip but headed into the populated area. At one pixel per cell it's hard to see- so I think I may move to trying to move a magnifying glass over areas where an interesting pattern is developing.

Here's a part of the 'big picture' showing some known static and oscillators.

For the cell density I start at I don't think your approach would help- but haven't really thought it through. I was also surprised by the large fraction of time taken in my program actually setting the pixels.

[Rod]

Cool, storing the images is by far the best way to view the evolution. I find that there is a big trade off with larger grids. For the cells to survive at all you need huge numbers of starting cells. so for a 600x600 grid you can seed it with known repeaters but to get it to seed itself you need to start with tens of thousands of cells.

This is a half way house, I must still have a bug because there is a bias towards the top of the screen.

The dim 600,600 was stressing Liberty. The simple string is much faster and less of a struggle for Liberty.

nomainwin
   WindowWidth = 600
   WindowHeight = 600
   open "Conway Life via Linked List" for graphics_nsb_nf as #1
   #1 "trapclose [quit]"
   #1 "down ; fill blue "

   global grid$

   'create a linked list of live cells in the current grid
   dim cell$(5000)'x y prev next
   cx=1
   cy=2
   prevc=3
   nextc=4

   cell$(1)=str$(int(rnd(0)*100+1))+" "+str$(int(rnd(0)*100+1))+" "+str$(0)+" "+str$(2)
   for n=2 to 500
   cell$(n)=str$(int(rnd(0)*100+1))+" "+str$(int(rnd(0)*100+1))+" "+str$(n-1)+" "+str$(n+1)
   next
   cell$(n)=str$(int(rnd(0)*100+1))+" "+str$(int(rnd(0)*100+1))+" "+str$(n-1)+" "+str$(0)


   'store current state to grid$
   firstcell=1
   c=firstcell
   while c
       xp=val(word$(cell$(c),cx))
       yp=val(word$(cell$(c),cy))
       #1 "color white ; place ";xp*6;" ";yp*6;" ; boxfilled ";xp*6+6;" ";yp*6+6
       grid$=grid$+"X"+word$(cell$(c),cx)+"Y"+word$(cell$(c),cy)
       c=val(word$(cell$(c),nextc))
   wend




   'timer 56, [cycle]
   'wait

   [cycle]
   c=firstcell
   dupl$=""
   while c
           x=val(word$(cell$(c),cx))
           y=val(word$(cell$(c),cy))
           p=val(word$(cell$(c),prevc))
           n=val(word$(cell$(c),nextc))
           'count surrounding live cells of this live cell
           'keep it alive if it has 2-3 neighbours else kill it
           ct=count(x,y)
           if ct<2 or ct>3 then
               'cell dies
               alive=0
               origc=c
           else
               'cell lives
               alive=1
           end if

           'now check for birthing cells around cell c's x,y
           for yy=-1 to 1
               for xx=-1 to 1
                   'if we move out of bounds roll round screen
                   scx=x+xx
                   if scx<1 then scx=100
                   if scx >100 then scx=1
                   scy=y+yy
                   if scy<1 then scy=100
                   if scy >100 then scy=1
                   xy$="X"+str$(scx)+"Y"+str$(scy)

                   'if it is a dead cell and we have not already checked, see if it has three neighbours
                   if instr(grid$,xy$,1)=0 and instr(dupl$,xy$,1)=0 then
                       'record in dupl() to avoid checking more than once
                       dupl$=dupl$+xy$

                       'check how many live cells surround it
                       sct=count(scx,scy)
                       if sct = 3 then
                           'To keep the array compact we simply keep finding the first free slot
                           'thus reusing dead cell slots.
                           i=1
                           while i<5000
                               if cell$(i)="" then exit while
                               i=i+1
                           wend
                           'new cell will be inserted after c and point to c as previous n will remain unchanged
                           'i=cell slot we we are storing info in
                           'p=previous cell slot
                           'n=next cell slot
                           'make the current cell point to i as next cells
                           cell$(c)=word$(cell$(c),cx)+" "+word$(cell$(c),cy)+" "+word$(cell$(c),prevc)+" "+str$(i)
                           'insert new cell pointing to c as previous cell and n as next cell
                           cell$(i)=str$(scx)+" "+str$(scy)+" "+str$(c)+" "+str$(n)
                           'make the next cell point to i as the previous cell
                           cell$(n)=word$(cell$(n),cx)+" "+word$(cell$(n),cy)+" "+str$(i)+" "+word$(cell$(n),nextc)
                           #1 "backcolor white ; color white ; place ";scx*6;" ";scy*6;" ; boxfilled ";scx*6+6;" ";scy*6+6
                           'set p and c so that further cells are inserted after i, n remains unchanged
                           p=c
                           c=i
                       end if
                   end if
               next
           next
           'now that we have inserted surrounding cells kill the original cell if it died
           if alive=0 then
               'remember what n was then get new values for origc's p and n
               orign=n
               p=val(word$(cell$(origc),prevc))
               n=val(word$(cell$(origc),nextc))
               'make the previous cell point to n, not origc as the next cell
               cell$(p)=word$(cell$(p),cx)+" "+word$(cell$(p),cy)+" "+word$(cell$(p),prevc)+" "+str$(n)
               'make the next cell point to p not origc as the the previous cell
               cell$(n)=word$(cell$(n),cx)+" "+word$(cell$(n),cy)+" "+str$(p)+" "+word$(cell$(n),nextc)

               'if this was the first cell in the list set the new starting point
               if p=0 then firstcell=n

               'if this is the last cell on the list set the ending 0 in prev
               if n=0 then cell$(p)=word$(cell$(p),cx)+" "+word$(cell$(p),cy)+" "+word$(cell$(p),prevc)+" "+str$(0)

               'erase the cell on screen and in the list

               #1 "backcolor blue ; color blue ; place ";x*6;" ";y*6;" ; boxfilled ";x*6+6;" ";y*6+6
               cell$(origc)=""
               n=orign
           end if
           'move to the next cell in the list
           c=n
   wend





   [savestate]
   c=firstcell
   grid$=""
   while c
       grid$=grid$+"X"+word$(cell$(c),cx)+"Y"+word$(cell$(c),cy)
       c=val(word$(cell$(c),nextc))
   wend
   #1 "discard"
   'wait
   scan
   goto [cycle]





   [quit]
   timer 0
   close #1
   end


function count(x,y)
x$="X"+str$(x)
y$="Y"+str$(y)
x1=x-1 :if x1<1 then x1=100
x1$="X"+str$(x1)
x2=x+1 :if x2>100 then x2=1
x2$="X"+str$(x2)
y1=y-1 :if y1<1 then y1=100
y1$="Y"+str$(y1)
y2=y+1 :if y2>100 then y2=1
y2$="Y"+str$(y2)
   ct=ct+(instr(grid$,x1$+y1$,1)>0)
   ct=ct+(instr(grid$,x$+y1$,1)>0)
   ct=ct+(instr(grid$,x2$+y1$,1)>0)
   ct=ct+(instr(grid$,x1$+y$,1)>0)
   'miss middle cell
   ct=ct+(instr(grid$,x2$+y$,1)>0)
   ct=ct+(instr(grid$,x1$+y2$,1)>0)
   ct=ct+(instr(grid$,x$+y2$,1)>0)
   ct=ct+(instr(grid$,x2$+y2$,1)>0)
   count=ct
end function




[tsh73]

I looked at it, running glider through walls.
It passes left or right but somehow breaks up and down
I was not able to get - why

[Rod]

This is my final version. I simplified it and got rid of the linked list. But I do keep just a list. So instead of trawling through an array(x,y) i just keep a list of live cells. I then work the list and check if surrounding cells are in the list. So the basic algorithm has not changed the rules are maintained but I don't need to check every cell in the matrix and copying the matrix is as easy as a$=b$.

When this runs it creates 600 random cells in a 100x100 matrix. Now first cycle it spends a lot of time eliminating 90% of the initial cells. After that it speeds up quite considerably. It seems to work and while it isn't super fast it is just about real time life. Far short of my 600x600 ambitions.

I'm done for now unless it inspires someone.

nomainwin
   WindowWidth = 600
   WindowHeight = 600
   open "Conway Life via Linked List" for graphics_nsb_nf as #1
   #1 "trapclose [quit]"
   #1 "down ; fill blue ;size 6"

   global oldgrid$

   'create a random list of cells in oldgrid$
   oldgrid$=""
   oldpointer=1
   for n=1 to 600
       x$=rnd$(100)
       y$=rnd$(100)
       if instr(oldgrid$,x$+y$,1)=0 then 'no duplicates
           oldgrid$=oldgrid$+x$+y$+","
           #1 "backcolor white ; color white ; set ";val(x$)*6;" ";val(y$)*6
       end if
   next

   [cycle]
   newgrid$=""
   dupl$=""
   oldpointer=1
   c$="?"
   while c$<>""
       c$=word$(oldgrid$,oldpointer,",")
       x=val(mid$(c$,1,4))
       y=val(mid$(c$,5,4))
       'count surrounding live cells of this live cell
       'keep it alive if it has 2-3 neighbours else kill it
       ct=count(x,y)
       if ct<2 or ct>3 then
           #1 "backcolor blue ; color blue ; set ";x*6;" ";y*6
       else
           newgrid$=newgrid$+c$+","
       end if
       'now check for birthing cells around cell c's x,y
       for yy=-1 to 1
           for xx=-1 to 1
               'if we move out of bounds roll round screen
               scx=x+xx
               if scx<1 then scx=100
               if scx >100 then scx=1
               scy=y+yy
               if scy<1 then scy=100
               if scy >100 then scy=1
               xy$=right$("0000"+str$(scx),4)+right$("0000"+str$(scy),4)
               'if it is a dead cell and we have not already checked, see if it has three neighbours
               if instr(oldgrid$,xy$,1)=0 and instr(dupl$,xy$,1)=0 then
                   'record in dupl$ to avoid checking more than once
                   dupl$=dupl$+xy$+","
                   'check how many live cells surround it
                   sct=count(scx,scy)
                   if sct = 3 then
                       newgrid$=newgrid$+xy$+","
                       #1 "backcolor white ; color white ; set ";scx*6;" ";scy*6
                   end if
                   scan
               end if
           next
       next
       'move to the next cell in the list
       oldpointer=oldpointer+1
   wend

   [savestate]
   oldgrid$=newgrid$
   #1 "discard"

   goto [cycle]







   [quit]
   close #1
   end


function rnd$(r)
   r$=str$(int(rnd(0)*r)+1)
   rnd$=right$("0000"+r$,4)
end function

function count(x,y)
   x$=right$("0000"+str$(x),4)
   y$=right$("0000"+str$(y),4)
   x1=x-1
   if x1<1 then x1=100
   x1$=right$("0000"+str$(x1),4)
   x2=x+1
   if x2>100 then x2=1
   x2$=right$("0000"+str$(x2),4)
   y1=y-1
   if y1<1 then y1=100
   y1$=right$("0000"+str$(y1),4)
   y2=y+1
   if y2>100 then y2=1
   y2$=right$("0000"+str$(y2),4)
   ct=ct+(instr(oldgrid$,x1$+y1$,1)>0)
   ct=ct+(instr(oldgrid$,x$+y1$,1)>0)
   ct=ct+(instr(oldgrid$,x2$+y1$,1)>0)
   ct=ct+(instr(oldgrid$,x1$+y$,1)>0)
   'miss middle cell
   ct=ct+(instr(oldgrid$,x2$+y$,1)>0)
   ct=ct+(instr(oldgrid$,x1$+y2$,1)>0)
   ct=ct+(instr(oldgrid$,x$+y2$,1)>0)
   ct=ct+(instr(oldgrid$,x2$+y2$,1)>0)
   count=ct
end function





[tenochtitlanuk]

Left my LB running Life for an hour or two and look what popped up!

Season's Greetings to all the community- and Carl particularly!