yet another Life

[tsh73]

I tried to get as fast as JB could.
(still brute force, checking every pixel)
100x100 makes 3 fps on slow machine, 9 of fast one (I really expected 4x faster but got only 3x)

I got really surprised then changing inner loop IF thing
if n(i,j)<2 or n(i,j)>3 then
   a(i,j)=0
else
   if n(i,j)=3 then a(i,j)=1
   'else does not change
end if
to math
a(i,j)=(n(i,j)=3) + (n(i,j)=2)*a(i,j)
made it run 1.5 x faster.

'speed of Life
'tsh73 Dec 2022
'Brute-force JB Life
'big speed ups
' 1) using sprite engine BG to draw
' 2) change inner loop IF to trick formula
'sorry I'm afraid is as fast as JB could do
'If need more processing power look into Julia language - they get calculated 1e9 life cells in a second

nomainwin

cellSz=5 'single point size
' cellSz=6
sz=100 '100x100 makes 3 fps on slow machine, 9 of fast one
'time ~ sz^2, so 50x50 go 4x faster, 200x200 4x slower

if cellSz*sz > DisplayHeight then
notice "Size error ";chr$(13); _
"Sorry! ";sz; " cells of ";cellSz; "pixels ";chr$(13); _
"will need more screen estate then JB reports you have!"
end
end if

if sz mod 4 <>0 then
newSz=(int(sz/4)+(sz mod 4 <>0))*4
msg$="Sorry " ;chr$(13); _
"image width should be divisable by 4"; chr$(13); _
"Ok to increase it to "; newSz;"?"
confirm msg$; ans$
if ans$="yes" then
sz= newSz
else
end 'did not opened window yet
end if
end if    

WindowWidth = sz*cellSz+10
WindowHeight = sz*cellSz+40

UpperLeftX=(DisplayWidth-WindowWidth)/2
UpperLeftY=(DisplayHeight-WindowHeight)/2

'UpperLeftX=1
'UpperLeftY=1

graphicbox #m.gr, 2, 2, sz*cellSz, sz*cellSz
open "Conway's life ";sz;"x";sz for window_nf as #m
#m "trapclose [quit]"
#m.gr "down"

fname$="wrk256.bmp"    
gosub [mkBitmap] 'create right header for size

sz1=sz-1
dim a(sz,sz)
for i = 0 to sz1
   for j =0 to sz1
       a(i,j)=int(rnd(0)*2)    '{0,1}
   next
next

[again]
t0=time$("ms")
K=100
'K=30
for k = 1 to K 'iterations
'--------------------------------------
'life loop part. a(i,j) 0..sz-1
dim n(sz,sz)'neighbour count, clear

   for i = 0 to sz1
i1=(i+sz1) mod sz
i2=(i+1) mod sz
       for j =0 to sz1
j1=(j+sz1) mod sz
j2=(j+1) mod sz
           n(i,j) = a(i1,j1)+a(i,j1)+a(i2,j1) _
                   +a(i1,j)            +a(i2,j) _
                   +a(i1,j2)+a(i,j2)+a(i2,j2)
       next
   next

   open fname$ for binary as #1
   seek #1, 1078
'lines in BMP are reverced
   for i = sz1 to 0 step -1
       a$=""
       for j =0 to sz1
a(i,j)=(n(i,j)=3) + (n(i,j)=2)*a(i,j)
           a$=a$+chr$(a(i,j))  
       next
       print #1,a$
   next
   close #1

   loadbmp "bmp", fname$
   #m.gr "background bmp"
   #m.gr "drawsprites"
   scan
next
t1=time$("ms")
notice "Speed of Life" ;chr$(13); _
using("####",(t1-t0)/K); " ms per frame" ;chr$(13); _
using("##.#",1000*K/(t1-t0));" fps"

goto [again] 'cheap I know

wait

[quit]
timer 0
close #m
end

function FileExists(path$, file$)
dim info$(1,1)
files path$, file$, info$()
FileExists = val(info$(0,0))
end function

function long4b$(n)
long4b$=""
for i = 1 to 4
long4b$=long4b$+chr$(n mod 256)
n=int(n/256)
next
end function

[mkBitmap] 'make a header for 256colr bmp sz x sz
if FileExists(DefaultDir$, fname$) then kill fname$
#m.gr "getbmp bmp 1 1 32 16" 'needs at least 1078 bytes
bmpsave "bmp", fname$
open fname$ for binary as #1
seek #1, 10
print #1, long4b$(1078); 'offset
seek #1, 18
print #1, long4b$(sz); 'width
print #1, long4b$(sz); 'height
seek #1, 28
print #1, chr$(8); 'bpp
seek #1, 30
print #1, long4b$(0); 'compress-none
seek #1, 34
print #1, long4b$(sz*sz); 'imagebytes
seek #1, 46
print #1, long4b$(256); 'colors in palette
seek #1, 50
print #1, long4b$(256); 'color used

'BGRempty
'0 th color: white
print #1, chr$(255)+chr$(255)+chr$(255)+chr$(0);
'1 st color: black
print #1, chr$(0)+chr$(0)+chr$(0)+chr$(0);
'there are 254 colors left unused
close #1
return


[Rod]

Cool, it runs many times faster and handles more cells than the list method.

[tsh73]

There should be limit of active cells number there list method works better.
Like, extreme case - lonely glider flying through empty 1000x1000 ;)