simple cellar automaton

New to FreeBASIC? Post your questions here.
Post Reply
jonp
Posts: 3
Joined: May 18, 2022 22:07

simple cellar automaton

Post by jonp »

Here is a simple cellular automaton.
I would welcome any suggestions to improve my coding.

Code: Select all

'a cellular automaton (from Scientific American 1998)
' create rectangle on screen of pixels with random colors 
' from  1 to numberOfColors using "pset"
'to run it;
' repeat same operation many times as follows 
' each iteration goes across all pixels, using a nested for/next loop
'this is the predator
'the predator looks at all 8 surrounding pixels, which are prey, 
'and gets pixel color of the prey using "point"
'the prey pixel color will change to the predator color number if
'1. the predator color number is bigger than the prey color number by one
'2. the predator is 1 and the prey is the max number ie numberOfColors
'it is a "circle"
'it starts with random colors then deleops lines etc
'need to run hundreds, thousands of iterations

screen 13
screenres 1200, 600',12 
dim shared as integer maxX, maxY, predX, predY,preyX, preyY, n,preyN,predN,iters,ppDiff,anyInt, numberOfColors
dim shared as integer oneMinusNumberOfColors
declare sub LoadScreen
declare sub LoadVariables
declare sub DoOneIter
'run it
LoadVariables
LoadScreen
'iters = iterations
for iters = 1 to 50000
    locate 1,110
    print iters
DoOneIter

next
'after all the iters, inform user it has finished running
locate 200,0: print  "done"
sleep

sub DoOneIter
for predX = 1 to maxX
        for predY = 1 to maxY  'go through all pixels
            predN= point (predX,predY) 'get predator color number predN
                for preyX = predX - 1 to predX + 1
                    for preyY = predY- 1 to predY+1
                        preyN = point(preyX,preyY)'use point to get prey color number preyN
                        ppDiff= predN-preyN ' difference between predator and prey color number
                        select case  ppDiff 
                        case 1,oneMinusNumberOfColors'oneMinusNumberOfColors to make it that number one "eats" the biggest number
                            pset (preyX,preyY),predN
                        end select
                        select case inkey$
                        case "q"' stop it
                            end
                        case "s"
                            sleep' temporary stop to look at it
                        
                        end select
                        'if inkey$= "q"then
                        'end
                        'end if
                        
next 
next
next
next
end sub
sub LoadVariables
randomize 77796 '46159  
maxX= 500' sixe of box of pixels used
maxY =400
numberOfColors = 12
oneMinusNumberOfColors = 1- numberOfColors' done here for speed
end sub
sub LoadScreen'put random color pixels on screen
    for preyX = 1 to maxX
        for preyY = 1 to maxY
            n = 1+(int (numberOfColors * rnd)) 
            'print n
         pset (preyX,preyY),n
     next
     next
    
end sub  
'


sleep
' Explicit end of program
End
badidea
Posts: 2593
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: simple cellar automaton

Post by badidea »

The make it a bit faster, you can remove the "select case inkey$ ... end select" from the inner loop.
E.g. (wth some other minor changes):

Code: Select all

'a cellular automaton (from Scientific American 1998)
' create rectangle on screen of pixels with random colors 
' from  1 to numberOfColors using "pset"
'to run it;
' repeat same operation many times as follows 
' each iteration goes across all pixels, using a nested for/next loop
'this is the predator
'the predator looks at all 8 surrounding pixels, which are prey, 
'and gets pixel color of the prey using "point"
'the prey pixel color will change to the predator color number if
'1. the predator color number is bigger than the prey color number by one
'2. the predator is 1 and the prey is the max number ie numberOfColors
'it is a "circle"
'it starts with random colors then deleops lines etc
'need to run hundreds, thousands of iterations

'screen 13
screenres 1200, 600, 8 '8-bit (256 colors)
dim shared as integer maxX, maxY, predX, predY,preyX, preyY, n,preyN,predN,iters,ppDiff,anyInt, numberOfColors
dim shared as integer oneMinusNumberOfColors
declare sub LoadScreen
declare sub LoadVariables
declare sub DoOneIter

'run it
LoadVariables
LoadScreen
'iters = iterations
for iters = 1 to 50000
    locate 1,110
    print iters
    DoOneIter
    sleep 1 'to give to cpu a short break
next
'after all the iters, inform user it has finished running
locate 200,0: print  "done"
sleep
' Explicit end of program
End

sub DoOneIter
    for predX = 1 to maxX
        for predY = 1 to maxY  'go through all pixels
            predN = point (predX,predY) 'get predator color number predN
            for preyX = predX - 1 to predX + 1
                for preyY = predY- 1 to predY+1
                    preyN = point(preyX, preyY) 'use point to get prey color number preyN
                    ppDiff= predN-preyN ' difference between predator and prey color number
                    select case ppDiff 
                    case 1,oneMinusNumberOfColors'oneMinusNumberOfColors to make it that number one "eats" the biggest number
                        pset (preyX,preyY),predN
                    end select
                next 
            next
            'removed from inner loop to speed thing up
            select case inkey$
            case "q"' stop it
                end
            case "s"
                sleep' temporary stop to look at it
            end select
        next
    next
end sub

sub LoadVariables
    randomize 77796 '46159  
    maxX = 500' sixe of box of pixels used
    maxY = 400
    numberOfColors = 12
    oneMinusNumberOfColors = 1 - numberOfColors' done here for speed
end sub

sub LoadScreen'put random color pixels on screen
    for preyX = 1 to maxX
        for preyY = 1 to maxY
            n = 1+(int (numberOfColors * rnd)) 
            'print n
            pset (preyX,preyY),n
        next
    next
end sub  
Edit: i now realize it was in the inner loop on purpose to monitor each step.

Even faster version by using a screen pointer instead of the slow point function:

Code: Select all

'a cellular automaton (from Scientific American 1998)
' create rectangle on screen of pixels with random colors 
' from  1 to numberOfColors using "pset"
'to run it;
' repeat same operation many times as follows 
' each iteration goes across all pixels, using a nested for/next loop
'this is the predator
'the predator looks at all 8 surrounding pixels, which are prey, 
'and gets pixel color of the prey using "point"
'the prey pixel color will change to the predator color number if
'1. the predator color number is bigger than the prey color number by one
'2. the predator is 1 and the prey is the max number ie numberOfColors
'it is a "circle"
'it starts with random colors then deleops lines etc
'need to run hundreds, thousands of iterations

'screen 13
screenres 1200, 600, 8 '8-bit (256 colors)
dim shared as integer maxX, maxY, predX, predY,preyX, preyY, n,preyN,predN,iters,ppDiff,anyInt, numberOfColors
dim shared as integer oneMinusNumberOfColors
declare sub LoadScreen
declare sub LoadVariables
declare sub DoOneIter

'run it
LoadVariables
LoadScreen
'iters = iterations
for iters = 1 to 50000
    locate 1,110
    print iters
    DoOneIter
    'removed sub al together
    select case inkey$
    case "q"' stop it
        end
    case "s"
        sleep' temporary stop to look at it
    end select
    sleep 1 'to give to cpu a short break
next
'after all the iters, inform user it has finished running
locate 200,0: print  "done"
sleep
' Explicit end of program
End

sub DoOneIter
    dim as ubyte ptr pScr = screenptr() 'direct pointer to grapics buffer
    dim as long w, h, bbp, pitch
    screeninfo w, h,, bbp, pitch 'get grapics buffer information
    if bbp <> 1 then end 'Abort, not 1 byte per pixel
    for predX = 1 to maxX
        for predY = 1 to maxY  'go through all pixels
            'predN = point (predX,predY) 'get predator color number predN
            predN = pScr[predY * pitch + predX] 'pointer magic
            for preyX = predX - 1 to predX + 1
                for preyY = predY- 1 to predY+1
                    'preyN = point(preyX, preyY) 'use point to get prey color number preyN
                    preyN = pScr[preyY * pitch + preyX] 'pointer magic
                    ppDiff= predN-preyN ' difference between predator and prey color number
                    select case ppDiff
                    case 1,oneMinusNumberOfColors'oneMinusNumberOfColors to make it that number one "eats" the biggest number
                        pset (preyX,preyY),predN
                    end select
                next 
            next
        next
    next
end sub

sub LoadVariables
    randomize 77796 '46159  
    maxX = 500' sixe of box of pixels used
    maxY = 400
    numberOfColors = 12
    oneMinusNumberOfColors = 1 - numberOfColors' done here for speed
end sub

sub LoadScreen'put random color pixels on screen
    for preyX = 1 to maxX
        for preyY = 1 to maxY
            n = 1+(int (numberOfColors * rnd)) 
            'print n
            pset (preyX,preyY),n
        next
    next
end sub  
jonp
Posts: 3
Joined: May 18, 2022 22:07

Re: simple cellar automaton

Post by jonp »

Thank you for the suggestion.
Jon in Ottawa.
jonp
Posts: 3
Joined: May 18, 2022 22:07

Re: simple cellar automaton

Post by jonp »

Thank you again for your help.
My knowledge is very rudimentary . I didn't know what a ubyte was!
The screen buffer is, I presume a store of the screen pixels but not on the screen so it is therefore quicker to access.
Could you explain a bit the following lines you wrote ?
1.
dim as ubyte ptr pScr = screenptr()
what is the syntax of this? I don't know that version of "dim". I don't know why it has no commas.
does this make ptr the holder of info from the screen buffer?

2.
predN = pScr[predY * pitch + predX]
I can sort of understand "pitch" but I cant see how this would access a specific pixel in the graphics bubber.

3. why does the CPR need a rest?

Jonp In Ottawa
Post Reply