[DBP] - A 1-D cellular automata program

Author

Message

Neuro Fuzzy

17

Years of Service

User Offline

Joined: 11th Jun 2007

Location:

Posted: 11th Dec 2011 04:07

Link

Just something I made when I was bored. 1d Cellular automata are a great example of how simple rules can give rise to complex behaivour. What a cellular automata is is described well here: http://math.hws.edu/xJava/CA/CA.html

Rules 30, 106 and 110 are my favorites. I think that for every pattern, there's an inverse (swap all white with black), a mirror (flip about the starting node) and an inverse mirror, so even though there are 256 different rules, there are only 64 distinct ones. (don't quote me on that though)

Press up/down to change the ruleset
press right/left to change the starting row to be either random or a single point. Random is usually more interesting.

global w as integer
global h as integer
global rule as integer

rule=0

w=screen width()
h=screen height()-32
dim cells(w,h)

for x=0 to w
	for y=0 to h
		cells(x,y)=0
	next y
next x

cells(500,0)=1

isRandom=0

setFirstRowCentered()
regenerateCellsAndDraw()
do
	text 0,0,"Rule "+str$(rule)
	text 0,16,"Control w/ arrowkeys: up/down to change rule, left/right to randomize first row"
	if leftkey()=1
		setFirstRowRandom()
		regenerateCellsAndDraw()
		wait 50
	endif
	if rightkey()=1
		setFirstRowCentered()
		regenerateCellsAndDraw()
		wait 50
	endif
	if upkey()=1
		rule=rule+1
		if rule>255 then rule=0
		regenerateCellsAndDraw()
		wait 50
	endif
	if downkey()=1
		rule=rule-1
		if rule<0 then rule=255
		regenerateCellsAndDraw()
		wait 50
	endif

loop
end

function clearCells()
	for x=0 to w
		for y=1 to h
			cells(x,y)=0
		next y
	next x
endfunction

function clearFirstRow()
	for x=0 to w
		cells(x,0)=0
	next x
endfunction

function setFirstRowCentered()
	clearFirstRow()
	cells(w/2,0)=1
endfunction

function setFirstRowRandom()
	for x=0 to w
		cells(x,0)=rnd(1)
	next x
endfunction

function regenerateCellsAndDraw()
	for ch=1 to h
		for cx=0 to w
			leftblock=getBlockAt(cx-1,ch-1)
			midblock=getBlockAt(cx,ch-1)
			rightblock=getBlockAt(cx+1,ch-1)
			cells(cx,ch)=getRuleAt(leftblock,midblock,rightblock)
		next current_xpos
	next current_height
	
	cls
	lock pixels
	for x=0 to w
		for y=0 to h
			if getBlockAt(x,y)=1
				dot x,y+32
			endif
		next y
	next x
	unlock pixels
endfunction

function getRuleBit(num)
	tmp= (rule>>num)&&1
endfunction tmp

function getRuleAt(leftblock,midblock,rightblock)
	if leftblock=1
		if midblock=1
			if rightblock=1
				exitfunction getRuleBit(7) //111
			else 
				exitfunction getRuleBit(6) //110
			endif
		else
			if rightblock=1
				exitfunction getRuleBit(5) //101
			else 
				exitfunction getRuleBit(4) //100
			endif
		endif
	else
		if midblock=1
			if rightblock=1
				exitfunction getRuleBit(3) //011
			else 
				exitfunction getRuleBit(2) //010
			endif
		else
			if rightblock=1
				exitfunction getRuleBit(1) //001
			else 
				exitfunction getRuleBit(0) //000
			endif
		endif
	endif 
endfunction 0

function getBlockAt(x,y)
	if x<0 then exitfunction 0
	if y<0 then exitfunction 0
	if x>w then exitfunction 0
	if y>h then exitfunction 0
	value=cells(x,y)
endfunction value

+ Code Snippet

global w as integer
global h as integer
global rule as integer

rule=0


w=screen width()
h=screen height()-32
dim cells(w,h)

for x=0 to w
	for y=0 to h
		cells(x,y)=0
	next y
next x

cells(500,0)=1


isRandom=0

setFirstRowCentered()
regenerateCellsAndDraw()
do
	text 0,0,"Rule "+str$(rule)
	text 0,16,"Control w/ arrowkeys: up/down to change rule, left/right to randomize first row"
	if leftkey()=1
		setFirstRowRandom()
		regenerateCellsAndDraw()
		wait 50
	endif
	if rightkey()=1
		setFirstRowCentered()
		regenerateCellsAndDraw()
		wait 50
	endif
	if upkey()=1
		rule=rule+1
		if rule>255 then rule=0
		regenerateCellsAndDraw()
		wait 50
	endif
	if downkey()=1
		rule=rule-1
		if rule<0 then rule=255
		regenerateCellsAndDraw()
		wait 50
	endif


loop
end

function clearCells()
	for x=0 to w
		for y=1 to h
			cells(x,y)=0
		next y
	next x
endfunction

function clearFirstRow()
	for x=0 to w
		cells(x,0)=0
	next x
endfunction

function setFirstRowCentered()
	clearFirstRow()
	cells(w/2,0)=1
endfunction

function setFirstRowRandom()
	for x=0 to w
		cells(x,0)=rnd(1)
	next x
endfunction

function regenerateCellsAndDraw()
	for ch=1 to h
		for cx=0 to w
			leftblock=getBlockAt(cx-1,ch-1)
			midblock=getBlockAt(cx,ch-1)
			rightblock=getBlockAt(cx+1,ch-1)
			cells(cx,ch)=getRuleAt(leftblock,midblock,rightblock)
		next current_xpos
	next current_height
	
	cls
	lock pixels
	for x=0 to w
		for y=0 to h
			if getBlockAt(x,y)=1
				dot x,y+32
			endif
		next y
	next x
	unlock pixels
endfunction

function getRuleBit(num)
	tmp= (rule>>num)&&1
endfunction tmp

function getRuleAt(leftblock,midblock,rightblock)
	if leftblock=1
		if midblock=1
			if rightblock=1
				exitfunction getRuleBit(7) //111
			else 
				exitfunction getRuleBit(6) //110
			endif
		else
			if rightblock=1
				exitfunction getRuleBit(5) //101
			else 
				exitfunction getRuleBit(4) //100
			endif
		endif
	else
		if midblock=1
			if rightblock=1
				exitfunction getRuleBit(3) //011
			else 
				exitfunction getRuleBit(2) //010
			endif
		else
			if rightblock=1
				exitfunction getRuleBit(1) //001
			else 
				exitfunction getRuleBit(0) //000
			endif
		endif
	endif 
endfunction 0

function getBlockAt(x,y)
	if x<0 then exitfunction 0
	if y<0 then exitfunction 0
	if x>w then exitfunction 0
	if y>h then exitfunction 0
	value=cells(x,y)
endfunction value

Back to top

Profile PM Email

MrValentine

AGK Backer

14

Years of Service

User Offline

Joined: 5th Dec 2010

Playing: FFVII

Posted: 11th Dec 2011 18:00

Link

Neuro... remind me to show you that shopping picture I got for you

Back to top

Profile PM

Zotoaster

20

Years of Service

User Offline

Joined: 20th Dec 2004

Location: Scotland

Posted: 15th Dec 2011 00:45

Link

I saw Stephen Wolfram talk about these at a TED conference once. He pointed out that if you look at rule 30 (at least it's 30 in this case), without randomising the first row, you get what appears to be an irregular pattern, unlike all the others. This pattern's been found all over nature, it's quite an interesting subject.

"everyone forgets a semi-colon sometimes." - Phaelax

Back to top

Profile PM Email

Neuro Fuzzy

17

Years of Service

User Offline

Joined: 11th Jun 2007

Location:

Posted: 15th Dec 2011 02:11

Link

Yeah, one of his talks inspired me to make this program. I'm pretty sure that rule 30 is just one of the ones that exhibits an irregular pattern. Wikipedia says that rule 110 is turing complete, so it's capable of universal computation. eg you can have a computer running using the rules of wolfram rule 110 (slowly of course xD). So some of the patterns exhibit regularity (and so can be reduced, as is apparent with the sierpinski triangle looking automata), and some of them (like rule 30 and 110) cannot be reduced, eg the only way to find a given row is to compute every row beforehand.

It makes me want to study theoretical computer science

Back to top

Profile PM Email

Libervurto

18

Years of Service

User Offline

Joined: 30th Jun 2006

Location: On Toast

Posted: 4th Feb 2012 18:56

Link

I managed to simplify it a bit. (PUN!)

set display mode 1024,768,32

global w as integer
global h as integer
global rule as integer
w=screen width()
h=screen height()-32
rule=0

dim cells(w,h)
clearcells()
setFirstRowCentered()
regenerateCellsAndDraw()

rem === Main ===
do
    rem Store input
    lk = leftkey() : rk = rightkey() : uk = upkey() : dk = downkey()
    
    if lk = 1 then setFirstRowRandom()
    if rk = 1 then setFirstRowCentered()
    if uk + dk > 0
        rule = rule + uk - dk
        if rule > 255 then rule = 0
        if rule < 0 then rule = 255
    endif
    
    if uk+rk+dk+lk > 0 then regenerateCellsAndDraw()
    
    text 0,0,"Rule "+str$(rule)
    text 0,16,"Control w/ arrowkeys: up/down to change rule, left/right to randomize first row"
loop
end

rem === Functions ===
function clearCells()
    for x=0 to w
        for y=1 to h
            cells(x,y)=0
        next y
    next x
endfunction

function clearFirstRow()
    for x=0 to w
        cells(x,0)=0
    next x
endfunction

function setFirstRowCentered()
    clearFirstRow()
    cells(w/2,0)=1
endfunction

function setFirstRowRandom()
    for x = 0 to w
        cells(x,0)=rnd(1)
    next x
endfunction

function regenerateCellsAndDraw()
    for ch = 1 to h
        for cx = 0 to w
            leftblock = GetCellAt(cx-1,ch-1)
            midblock = GetCellAt(cx,ch-1)
            rightblock = GetCellAt(cx+1,ch-1)
            cells(cx,ch) = getRuleBit(leftblock*4 + midblock*2 + rightblock)
        next current_xpos
    next current_height
    
    cls
    lock pixels
    for x = 0 to w
        for y = 0 to h
            if GetCellAt(x,y) = 1
                dot x,y+32
            endif
        next y
    next x
    unlock pixels
endfunction

function getRuleBit(num)
    tmp= (rule>>num)&&1
endfunction tmp

function GetCellAt(x,y)
    if x<0 then exitfunction 0
    if y<0 then exitfunction 0
    if x>w then exitfunction 0
    if y>h then exitfunction 0
    value = cells(x,y)
endfunction value

+ Code Snippet

set display mode 1024,768,32

global w as integer
global h as integer
global rule as integer
w=screen width()
h=screen height()-32
rule=0

dim cells(w,h)
clearcells()
setFirstRowCentered()
regenerateCellsAndDraw()

rem === Main ===
do
    rem Store input
    lk = leftkey() : rk = rightkey() : uk = upkey() : dk = downkey()
    
    if lk = 1 then setFirstRowRandom()
    if rk = 1 then setFirstRowCentered()
    if uk + dk > 0
        rule = rule + uk - dk
        if rule > 255 then rule = 0
        if rule < 0 then rule = 255
    endif
    
    if uk+rk+dk+lk > 0 then regenerateCellsAndDraw()
    
    text 0,0,"Rule "+str$(rule)
    text 0,16,"Control w/ arrowkeys: up/down to change rule, left/right to randomize first row"
loop
end

rem === Functions ===
function clearCells()
    for x=0 to w
        for y=1 to h
            cells(x,y)=0
        next y
    next x
endfunction

function clearFirstRow()
    for x=0 to w
        cells(x,0)=0
    next x
endfunction

function setFirstRowCentered()
    clearFirstRow()
    cells(w/2,0)=1
endfunction

function setFirstRowRandom()
    for x = 0 to w
        cells(x,0)=rnd(1)
    next x
endfunction

function regenerateCellsAndDraw()
    for ch = 1 to h
        for cx = 0 to w
            leftblock = GetCellAt(cx-1,ch-1)
            midblock = GetCellAt(cx,ch-1)
            rightblock = GetCellAt(cx+1,ch-1)
            cells(cx,ch) = getRuleBit(leftblock*4 + midblock*2 + rightblock)
        next current_xpos
    next current_height
    
    cls
    lock pixels
    for x = 0 to w
        for y = 0 to h
            if GetCellAt(x,y) = 1
                dot x,y+32
            endif
        next y
    next x
    unlock pixels
endfunction

function getRuleBit(num)
    tmp= (rule>>num)&&1
endfunction tmp

function GetCellAt(x,y)
    if x<0 then exitfunction 0
    if y<0 then exitfunction 0
    if x>w then exitfunction 0
    if y>h then exitfunction 0
    value = cells(x,y)
endfunction value

Nice code, really interesting

Join DNG today! We are a game development team open to all. Visit our Headquarters to learn more.

Back to top

Profile PM Email

Sorry your browser is not supported!

Code Snippets / [DBP] - A 1-D cellular automata program