Self organizing neural network

Blitz3D Forums/Blitz3D Programming/Self organizing neural network

MusicianKool

(Posted 2011) [#1]

Well, it's not a neural network yet but i'm trying out a hypothesis. basically self organizing and self optimizing network. it's full of glitches and is sloppy but it's basically a rough draft of what i want to do. I guess this is more of a preview then anything and it's not much of one.

Graphics3D 800,600,32,2
SeedRnd MilliSecs()

Type Chem
	Field X#,Y#,Z#
	Field Time,Lapps
	Field Exc
	Field r,g,b
	Field Parent.Neuron
End Type

Type Neuron
	Field x#,y#,z#
	Field ChemActive
	Field tFst.Append
	Field tNow.Append
	Field tLst.Append
	Field axonFst.Append
	Field axonNow.Append
	Field axonLst.Append
	Field dendFst.Append
	Field dendNow.Append
	Field dendLst.Append
End Type

Type Append
	Field Done
	Field Parent.Neuron
	Field Nxt.Append
	Field Fst.Chain
	Field Lst.Chain
End Type

Type Chain
	Field x#,y#,z#
	Field nxt.Chain
	Field parent.Append
	Field time
End Type

For i = 1 To 10
	n.neuron = Neuron_Create(Rand(-100,100),Rand(-100,100),0)
Next

While Not KeyHit(1)
	Cls
	Neuron_Draw()
	Neuron_Update()
	Append_Update()
	Append_Draw()
	Chem_Update()
	Chem_Draw()
	Flip
Wend

Function Neuron_Create.Neuron(x#,y#,z#)
	Local n.Neuron = New Neuron
	n\x = x
	n\y = y
	n\z = z
	Return n
End Function
Function Neuron_Draw()
	Color 255,255,255
	Local n.Neuron
	For n.Neuron = Each Neuron
		Oval 400+n\x-5,300+n\y-5,10,10,0
	Next
End Function
Function Neuron_Update()
	Local n.Neuron,c.Chem
	For n.Neuron = Each Neuron
		If n\ChemActive < 100 Then Chem_Create(n)
		For c.Chem = Each Chem
			If c\Parent <> n Then
				If Distance2D(n\x,n\y,c\X,c\Y) <= 15 Then
					;Stop
					If n\tFst = Null Then Append_Create(n,c)
					Delete c
				EndIf
			EndIf
		Next
	Next
End Function

Function Chain_Create_AppendToChem(A.Append,Ch.Chem)
	Local C.Chain = New Chain
	C\parent = A
	If C\parent\Fst = Null Then C\parent\Fst = C
	If C\parent\Lst <> Null Then 
		C\parent\Lst\nxt = C
		C\parent\Lst\time = 100
	EndIf
	C\parent\Lst = C
	C\x = Ch\X
	C\y = Ch\Y
	C\z = Ch\Z
	C\time = 100
End Function

Function Chain_Create_AppendToNeuron(a.Append,n.Neuron)
	Local C.Chain = New Chain
	C\parent = a
	If C\parent\Fst = Null Then C\parent\Fst = C
	If C\parent\Lst <> Null Then 
		C\parent\Lst\nxt = C
		tt = C\parent\Lst\time 
	EndIf
	C\parent\Lst = C
	C\x = n\x
	C\y = n\y
	C\z = n\z
	C\time = tt
End Function

Function Chain_Create_AppendToChain(a.Append,ch.Chain)
	Local c.Chain = New Chain
	c\parent = a
	If c\parent\Fst = Null Then c\parent\Fst = c
	If c\parent\Lst <> Null Then 
		c\parent\Lst\nxt = c
		tt= c\parent\Lst\time 
	EndIf
	c\parent\Lst = c
	c\time = tt
	c\x = ch\x
	c\y = ch\y
	c\z = ch\z
End Function 

Function Append_Create(n.Neuron,c.Chem)
	Local a.Append = New Append
	If n\tFst = Null Then n\tFst = a
	n\tNow = a
	If n\tLst <> Null Then n\tLst\Nxt = a
	n\tLst = a
	a\Parent = n
	Chain_Create_AppendToNeuron(a,n)
	Chain_Create_AppendToChem(a,c)
End Function
Function Append_Create2(ch.Chain,c.Chem)
	Local a.Append = New Append
	a\Parent = ch\parent\Parent
	Chain_Create_AppendToChain(a,ch)
	Chain_Create_AppendToChem(a,c)
End Function

Function Append_Draw()
	Local a.Append
	For a.Append = Each Append
		If a\Fst = Null Then Goto skipp
		Local c1.Chain = a\Fst
		Local c2.Chain = a\Fst\nxt
		While c2.Chain <> Null
			Line 400+c1\x,300+c1\y,400+c2\x,300+c2\y
			
			If c2\nxt = Null Then c2\time=c2\time-1
			If c2\time<=0 Then 
				If a\Done = 0 Then
					Delete c2
					c1\nxt = Null
					a\Lst = c1
				EndIf
			EndIf
			c1 =c2
			If c2 <> Null Then c2 = c2\nxt
		Wend
		If c1 = Null Then Goto skipp
		If c1 = a\Lst Then c1\time = c1\time-1
		If c1 <> a\Lst Then c1\time = 100
		If c1\time <=0 And a\Done = 0 Then
			a\Fst = Null
			a\Lst = Null
			Delete c1
			Delete a
		EndIf
		.skipp
	Next
End Function

Function Append_Update()
	Local a.Append,c.Chem,n.Neuron
	For a.Append = Each Append
		If Not a\Done Then
			For c.Chem = Each Chem
				If a\Parent <> c\Parent Then
					If a\Lst = Null Then 
						Delete a\Fst
						Delete a
						Exit
					EndIf
					Local ch.Chain = a\Fst
					While ch.Chain <> Null
						If Distance2D(ch\x,ch\y,c\X,c\Y)<= 10 Then
							If a\Lst <> ch Then 
								Append_Create2(ch,c)
							Else
								Chain_Create_AppendToChem(a,c)
							EndIf
							a\Parent\ChemActive=a\Parent\ChemActive-1
							Delete c
							Exit
						EndIf
						ch = ch\nxt
					Wend
				EndIf
			Next
			For n.Neuron = Each Neuron
				If Distance2D(n\x,n\y,a\Lst\x,a\Lst\y) <2 Then a\Done = True
			Next
		EndIf
	Next
End Function
					

Function Chem_Create(n.Neuron)
	Local c.Chem = New Chem
	n\ChemActive=n\ChemActive+1
	c\X = n\x
	c\Y = n\y
	c\Z = n\z
	c\Time = MilliSecs() + Rand(5000)
	c\Exc = Rand(5,10)
	c\r = Rand(255)
	c\g = Rand(255)
	c\b = Rand(255)
	c\Parent = n
End Function

Function Chem_Update()
	Local c.Chem
	For c.Chem = Each Chem
		c\X = c\X + Rnd(-c\Exc,c\Exc)
		c\Y = c\Y + Rnd(-c\Exc,c\Exc)
		c\Z = c\Z + Rnd(-c\Exc,c\Exc)
		c\Lapps = MilliSecs()
		If c\Lapps >= c\Time Then 
			c\Parent\ChemActive=c\Parent\ChemActive-1
			Delete c
		EndIf
	Next
End Function

Function Chem_Draw()
	LockBuffer BackBuffer()
	For c.chem = Each Chem
		WritePixelFast 400+c\x,300+c\y,GetRGB(c\r,c\g,c\b)
	Next
	UnlockBuffer BackBuffer()
End Function


Function GetRGB(r,g,b)
	Return b Or (g Shl 8) Or (r Shl 16)
End Function

Function GetR(RGB)
    Return RGB Shr 16 And %11111111
End Function

Function GetG(RGB)
	Return RGB Shr 8 And %11111111
End Function

Function GetB(RGB)
	Return RGB And %11111111
End Function

Function Distance2D#(x#,y#,x2#,y2#)
	Return Sqr((x#-x2#)*(x#-x2#)+(y#-y2#)*(y#-y2#))
End Function

MusicianKool

(Posted 2011) [#2]

updated some things, now works pretty good. Would like it to be faster though.
here is a video of this with some tweaks. but still with a bad frame rate.
http://www.youtube.com/watch?v=441oF-_G2KE

Graphics3D 800,600,32,2
SeedRnd MilliSecs()



Global ct = 50
Global ChemCount = 10
Global NumNeurons = 100
Global ChemStep = 20



Type Chain
	Field x#,y#,z#
	Field nxt.Chain
	Field prv.Chain
	Field parent.Append
	Field time
End Type

Type Chem
	Field X#,Y#,Z#
	Field Time,Lapps
	Field Exc
	Field r,g,b
	Field Parent.Neuron
End Type

Type Append
	Field Done
	Field Parent.Neuron
	Field Dest.Neuron
	Field ParApp.Append
	Field Nxt.Append
	Field Fst.Chain
	Field Lst.Chain
End Type

Type Neuron
	Field x#,y#,z#
	Field ChemActive
	Field tFst.Append
	Field tNow.Append
	Field tLst.Append
	Field axonFst.Append
	Field axonNow.Append
	Field axonLst.Append
	Field dendFst.Append
	Field dendNow.Append
	Field dendLst.Append
End Type

For i = 1 To NumNeurons
	n.neuron = Neuron_Create(Rand(-400,400),Rand(-300,300),0);50*(i-NumNeurons/2.0),0,0);
Next

While Not KeyHit(1)
	Cls
	Neuron_Draw()
	Neuron_Update()
	Append_Update()
	Chain_Update()
	Append_Draw()
	Chem_Update()
	;Chem_Draw()
	Flip
Wend


Function GetRGB(r,g,b)
	Return b Or (g Shl 8) Or (r Shl 16)
End Function

Function GetR(RGB)
    Return RGB Shr 16 And %11111111
End Function

Function GetG(RGB)
	Return RGB Shr 8 And %11111111
End Function

Function GetB(RGB)
	Return RGB And %11111111
End Function

Function Distance2D#(x#,y#,x2#,y2#)
	Return Sqr((x#-x2#)*(x#-x2#)+(y#-y2#)*(y#-y2#))
End Function


Function Chain_Create_AppendToChem(A.Append,Ch.Chem)
	Local C.Chain = New Chain
	C\parent = A
	If C\parent\Fst = Null Then C\parent\Fst = C
	If C\parent\Lst <> Null Then 
		C\parent\Lst\nxt = C
		C\parent\Lst\time = ct
	EndIf
	C\prv = C\parent\Lst
	C\parent\Lst = C
	C\x = Ch\X
	C\y = Ch\Y
	C\z = Ch\Z
	C\time = ct
End Function

Function Chain_Create_AppendToNeuron(a.Append,n.Neuron)
	Local C.Chain = New Chain
	C\parent = a
	If C\parent\Fst = Null Then C\parent\Fst = C
	If C\parent\Lst <> Null Then 
		C\parent\Lst\nxt = C
		C\parent\Lst\time = ct
	EndIf
	C\prv = C\parent\Lst
	C\parent\Lst = C
	C\x = n\x
	C\y = n\y
	C\z = n\z
	C\time = ct
End Function

Function Chain_Create_AppendToChain(a.Append,ch.Chain)
	Local c.Chain = New Chain
	c\parent = a
	If c\parent\Fst = Null Then c\parent\Fst = c
	If c\parent\Lst <> Null Then 
		c\parent\Lst\nxt = c
		tt= c\parent\Lst\time 
	EndIf
	c\prv = c\parent\Lst
	c\parent\Lst = c
	c\time = tt
	c\x = ch\x
	c\y = ch\y
	c\z = ch\z
End Function 

Function Chain_Update()
	Local c.Chain
	For c = Each Chain
		If c\parent = Null Then Delete c:Goto skip2
		If c\parent\Done = 0 Then 
			If c\parent\Lst <> Null Then
				If c\parent\Lst = c Then c\time=c\time-1
			EndIf
		Else
			c\time = ct
		EndIf
		If c\time <= 0 Then 
			If c\nxt <> Null And c\prv <> Null Then c\prv\nxt = c\nxt
			If c\nxt <> Null And c\prv <> Null Then c\nxt\prv = c\prv
			If c = c\parent\Lst Then 
				If c\prv <> Null Then c\parent\Lst = c\prv
				If c\parent\Lst = c\parent\Fst Then
					c\parent\Lst = Null
					c\parent\Fst = Null
					Delete c\parent
				EndIf
			EndIf
			Delete c
		EndIf
		.skip2
	Next
End Function

Function Chain_Copy_Parenta_to_Parentb(a.Append,b.Append,ch.Chain)
	
	Local tch.Chain = a\Fst,t.Chain,tt.Chain
	
	While tch <> ch
		t = Chain_Copy(tch,b)
		tch = tch\nxt
	Wend
End Function

Function Chain_Copy.Chain(ch.Chain,parent.Append)
	Local c.Chain = New Chain
	c\x = ch\x
	c\y = ch\y
	c\z = ch\z
	c\time = ct
	c\parent = parent
	If parent\Fst = Null Then 
		parent\Fst = c
	Else
		c\prv = parent\Lst:parent\Lst\nxt =c
	EndIf
	parent\Lst = c
End Function


Function Chem_Create(n.Neuron)
	Local c.Chem = New Chem
	n\ChemActive=n\ChemActive+1
	c\X = n\x
	c\Y = n\y
	c\Z = n\z
	c\Time = Rand(200)
	c\Exc = Rand(ChemStep)
	c\r = Rand(255)
	c\g = Rand(255)
	c\b = Rand(255)
	c\Parent = n
End Function

Function Chem_Update()
	Local c.Chem
	For c.Chem = Each Chem
		c\X = c\X + Rnd(-c\Exc,c\Exc)
		c\Y = c\Y + Rnd(-c\Exc,c\Exc)
		c\Z = c\Z + Rnd(-c\Exc,c\Exc)
		c\Time=c\Time-1
		If c\Time <= 0 Then
			c\Parent\ChemActive=c\Parent\ChemActive-1
			Delete c
		EndIf
	Next
End Function

Function Chem_Draw()
	LockBuffer BackBuffer()
	For c.chem = Each Chem
		WritePixelFast 400+c\x,300+c\y,GetRGB(c\r,c\g,c\b)
	Next
	UnlockBuffer BackBuffer()
End Function



Function Append_Create(n.Neuron,c.Chem)
	Local a.Append = New Append
	If n\tFst = Null Then n\tFst = a
	n\tNow = a
	If n\tLst <> Null Then n\tLst\Nxt = a
	n\tLst = a
	a\Parent = n
	Chain_Create_AppendToNeuron(a,n)
	Chain_Create_AppendToChem(a,c)
End Function

Function Append_Create2(ch.Chain,c.Chem)
	Local a.Append = New Append
	a\Parent = ch\parent\Parent
	a\ParApp = ch\parent
	Local ta.Append = a
	Chain_Copy_Parenta_to_Parentb(ta\ParApp,a,ch.Chain)
	Chain_Create_AppendToChain(a,ch)
	Chain_Create_AppendToChem(a,c)
End Function

Function Append_Draw()
	Local a.Append
	For a.Append = Each Append
		If a\Fst = Null Then Goto skipp
		Local c1.Chain = a\Fst
		Local c2.Chain = a\Fst\nxt
		While c2.Chain <> Null
			Line 400+c1\x,300+c1\y,400+c2\x,300+c2\y
			c1 =c2
			If c2 <> Null Then c2 = c2\nxt
		Wend
		If c1 = Null Then Goto skipp
		.skipp
	Next
End Function

Function Append_delete(a.Append)
	Local t1.Chain = a\Fst,t2.Chain
	While t1 <> Null
		t2 = t1
		t1 = t2\nxt
		Delete t2
	Wend
	Delete a
End Function

Function Append_Update()
	Local a.Append,c.Chem,n.Neuron
	For a = Each Append
		If a\ParApp = Null And a\Parent = Null Then Append_delete(a):Goto skip1
		If a <> Null And a\Lst <> Null Then
			For n.Neuron = Each Neuron
				If Distance2D(n\x,n\y,a\Lst\x,a\Lst\y) <2 Then 
					a\Done = True
					a\Dest = n
					For a1.append = Each Append
						If a1 <> a Then
							If a1\parent = a\Parent And a1\dest = a\Dest Then Append_delete(a):Goto skip1
						EndIf
					Next
				EndIf
			Next
		EndIf
		If a\Done = 0 Then
			For c = Each Chem
				If a\Parent <> c\Parent Then
					If a\Lst = Null Then 
						Append_delete a
						Exit
					EndIf
					Local ch.Chain = a\Fst
					While ch.Chain <> Null
						If Distance2D(ch\x,ch\y,c\X,c\Y)<= 10 Then
							If a\Lst <> ch Then 
								Append_Create2(ch,c)
							Else
								Chain_Create_AppendToChem(a,c)
							EndIf
							c\Parent\ChemActive=c\Parent\ChemActive-1
							Delete c
							Exit
						EndIf
						ch = ch\nxt
					Wend
				EndIf
			Next
		EndIf
		.skip1
	Next
End Function



Function Neuron_Create.Neuron(x#,y#,z#)
	Local n.Neuron = New Neuron
	n\x = x
	n\y = y
	n\z = z
	Return n
End Function

Function Neuron_Draw()
	Color 255,255,255
	Local n.Neuron
	For n.Neuron = Each Neuron
		Oval 400+n\x-5,300+n\y-5,10,10,0
	Next
End Function

Function Neuron_Update()
	Local n.Neuron,c.Chem
	For n.Neuron = Each Neuron
		If n\ChemActive < ChemCount Then Chem_Create(n)
		For c.Chem = Each Chem
			If c\Parent <> n Then
				If Distance2D(n\x,n\y,c\X,c\Y) <= 15 Then
					Append_Create(n,c)
					c\Parent\ChemActive=c\Parent\ChemActive-1
					Delete c
				EndIf
			EndIf
		Next
	Next
End Function

Last edited 2011

Rroff

(Posted 2011) [#3]

Ah thats quite cool when you work out what its doing (at first just seemed purely random) and watch it making chains :D

Adam Novagen

(Posted 2011) [#4]

Looks very nice so far, Kool, but this really would be better in the code archives than the forum, unless you have a question to ask about it. Or perhaps a worklog.

MusicianKool

(Posted 2011) [#5]

I mostly started this for help speeding it up, it was already slow, and got slower the better it got. There are some miner speed increases with the distance calls but other then that I was looking for possible better ways of doing this.

Mr Snidesmin

(Posted 2011) [#6]

Interesting. Reminds of the random stuff I used to do.

Much of the speed issues are likely related to 2-d drawing. Try to avoid using functions like Line and Oval to render large numbers of objects.

Each call to line, oval, locks and then unlocks the graphics buffer. Ideally you want to lock a buffer just once and then perform all rendering then unlock and display. You could try using 3d entities to render or using custom functions with writepixelfast etc to render.

Another option that you can do simply is to skip rendering in the loop. For example, just call the draw functions once every 5 or 10 cycles. Of course it will be a lower frame rate, but in this kind of program that doesn't really matter - just needs to refresh every second or two really.

Last edited 2011