Genetic algorithm is so-so. Fitness function is not very good (time on track) and i am not sure averaging weights when they reproduct is relevant.
Anyway, it should work after a while, a car will do all the track by itself.
You can change number of laser (it change the number of neurons as well), distance they can detect and mutationrate by constants.
Next step is backpropagation in the library.
Actually there is a small prog at the end of the lib allowing to display the neural network.
Save as Dll "NeuroNetLib"
Code: Select all
;create a new neural net with nblayer deep (inputs include as 1 layer)
ProcedureDLL CreateNeuroNet(nbLayer.i)
*net=0
size=SizeOf(*net)
*net=AllocateMemory(size+size+size*(nblayer+1))
PokeI(*net,nblayer)
PokeI(*net+size,1)
;*net => nblayer
;*net+size => next layer to fill
;*net+size*2 => pointer to the first layer *net+size*3 => pointer to the second layer etc...
ProcedureReturn *net
EndProcedure
;specify composition of each layer
ProcedureDLL AddNeuroInputs(*net,NbInputs.i)
;currentlayer start at 1 (first)
size.i=SizeOf(*net)
sizedouble.i=8
nblayer.i=PeekI(*net)
*layer=AllocateMemory(size*3+sizedouble*NbInputs)
*startOutput=*layer+size*3
PokeI(*layer,NbInputs)
PokeI(*layer+size,1)
PokeI(*layer+size*2,*startOutput)
PokeI(*net+2*size,*layer)
ProcedureReturn
EndProcedure
;specify composition of each layer
ProcedureDLL AddNeuroLayer(*net,NbNeuron.i)
size.i=SizeOf(*net)
sizedouble.i=8
nblayer.i=PeekI(*net)
currentlayer.i=PeekI(*net+size):If currentlayer>nblayer:ProcedureReturn 0:EndIf
*prevLayer=PeekI(*net+size+size*currentlayer)
NbNeuronPrevOutput.i=PeekI(*prevLayer)
output=sizedouble*NbNeuron
weight=sizedouble*NbNeuron*NbNeuronPrevOutput
bias=sizedouble*NbNeuron
*layer=AllocateMemory(size*3+output+weight+bias)
*startOutput=*layer+size*3+weight+bias
PokeI(*layer,NbNeuron)
PokeI(*layer+size,NbNeuronPrevOutput)
PokeI(*layer+size*2,*startOutput)
PokeI(*net+size,currentlayer+1)
PokeI(*net+2*size+size*currentlayer,*layer)
ProcedureReturn currentlayer
EndProcedure
;initiation weights With randoms values
ProcedureDLL InitRandomWeightNeuroNet(*net)
size=SizeOf(*net)
sizedouble.i=8
nblayer.i=PeekI(*net)
For i=1 To nblayer
*layer=PeekI(*net+2*size+size*i)
nbneuron=PeekI(*layer)
nbprevoutput=PeekI(*layer+size)
For t=0 To nbneuron*(nbprevoutput+1)
PokeD(*layer+size*3+sizedouble*t,(Random(200)-100)/100) ;write random weight between -1;+1
Next t
Next i
EndProcedure
ProcedureDLL.d ReadNeuronOutput(*net,layer.i,neuron.i)
size=SizeOf(*net)
sizedouble.i=8
*layer=PeekI(*net+2*size+size*layer)
*startoutput=PeekI(*layer+size*2)
value.d=PeekD(*startoutput+(neuron-1)*sizedouble)
ProcedureReturn value
EndProcedure
ProcedureDLL DeleteNeuroNet(*net)
size=SizeOf(*net)
nblayer=PeekI(*net)
If nblayer=0:ProcedureReturn 1:EndIf
For i=1 To nblayer
*layer=PeekI(*net+size*i)
FreeMemory(*layer)
Next i
FreeMemory(*net)
ProcedureReturn 1
EndProcedure
;list activation functions https://en.wikipedia.org/wiki/Activation_function
;here, sigmoïd
ProcedureDLL.d activation(output.d)
output.d=1/(1+Exp(-output))
ProcedureReturn output
EndProcedure
;calculate outputs
ProcedureDLL Propagate(*net)
size=SizeOf(*net)
sizedouble.i=8
nblayer.i=PeekI(*net)
For i=1 To nblayer
*layer=PeekI(*net+2*size+size*i)
nbneuron=PeekI(*layer)
nbprevoutput=PeekI(*layer+size)
*startoutput=PeekI(*layer+size*2)
*currentweight=*layer+size*3
*prevLayer=PeekI(*net+2*size+size*(i-1))
*prevstartoutput=PeekI(*prevLayer+size*2)
For j=0 To nbneuron-1
output.d=0
For k=0 To nbprevoutput
input.d=PeekD(*prevstartoutput+k*sizedouble)
;bias
If k=nbprevoutput:input=1:EndIf
weight.d=PeekD(*currentweight+k*sizedouble+j*(nbprevoutput+1)*sizedouble)
output.d=output+weight*input
Next k
PokeD(*startoutput+j*sizedouble,activation(output))
Next j
Next i
EndProcedure
;define inputs
ProcedureDLL SetInput(*net,Input.i,value.d)
size=SizeOf(*net)
sizedouble.i=8
*layer=PeekI(*net+size+size)
*startoutput=PeekI(*layer+size*2)
PokeD(*startoutput+(Input-1)*sizedouble,value)
ProcedureReturn 1
EndProcedure
; ;program To visualize the neural net
; Procedure.d distance(x1,y1,x2,y2,x0,y0)
; dist.d=Abs((y2-y1)*x0-(x2-x1)*y0+x2*y1-y2*x1)/Sqr((y2-y1)*(y2-y1)+(x2-x1)*(x2-x1))
; ProcedureReturn dist
; EndProcedure
;
; If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0 Or OpenWindow(0, 0, 0, 800, 600, "Neural Network Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)=0 Or OpenWindowedScreen(WindowID(0),0,0,800,600,0,0,0,#PB_Screen_NoSynchronization )=0
; MessageRequester("Error", "Can't open the sprite system", 0)
; End
; EndIf
; #mouse=0
; CreateSprite(#mouse,16,16)
; StartDrawing(SpriteOutput(#mouse))
; Box(0,0,16,16,#Red)
; StopDrawing()
;
; *net=CreateNeuroNet(1)
; AddNeuroInputs(*net,2)
; AddNeuroLayer(*net,2)
; InitRandomWeightNeuroNet(*net)
; SetInput(*net,1,0.1)
;
; Propagate(*net)
; Repeat
; Repeat:Until WindowEvent()=0
; FlipBuffers()
; ClearScreen(#Black)
; ExamineKeyboard()
; ExamineMouse()
; xm=MouseX()
; ym=MouseY()
;
; size=SizeOf(*net)
; StartDrawing(ScreenOutput())
; ;display inputs
; *input=PeekI(*net+size*2)
; nbinput.i=PeekI(*input)
; y.f=300-(nbinput/2)*100
; For i=1 To nbinput
; Circle(100,i*80+y,30)
; Circle(100,i*80+y,28,#Black)
; DrawText(84,i*80+y-7,StrD(readneuronoutput(*net,0,i),3))
; Next i
; nblayer=PeekI(*net)
; min.d=10000
; a1=0:a2=0:a3=0
; ;display layers
; For i=1 To nblayer
; *layer=PeekI(*net+2*size+size*i)
; nbneuron=PeekI(*layer)
; nbprevneuron=PeekI(*layer+size)
; y.f=300-(nbneuron/2)*100
; yy.f=300-(nbprevneuron/2)*100
; For j=1 To nbneuron
; For t=1 To nbprevneuron
; LineXY(100+i*100,j*80+y-7,100+(i-1)*100,t*80+yy-7)
; d.d=distance(100+i*100,j*80+y-7,100+(i-1)*100,t*80+yy-7,xm,ym)
; If d<min:min=d:a1=i:a2=j:a3=t:a4=y:a5=yy:EndIf
; Next t
; Circle(100+i*100,j*80+y,30)
; Circle(100+i*100,j*80+y,28,#Black)
; ;DrawText(84+i*100,j*80+y-7,StrD(readneuroBias(*net,i,j),3))
; DrawText(84+i*100,j*80+y-7,StrD(readneuronoutput(*net,i,j),3))
; Next j
; Next i
; LineXY(100+a1*100,a2*80+a4-7,100+(a1-1)*100,a3*80+a5-7,#Red)
; ;DrawText(xm,ym,StrD(readneuroWeight(*net,i,j),3))
;
; StopDrawing()
; DisplaySprite(#mouse,xm,ym)
;
; Until KeyboardPushed(#PB_Key_Escape)
Code: Select all
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0 Or OpenWindow(0, 0, 0, 800, 600, "Smart Rockets", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)=0 Or OpenWindowedScreen(WindowID(0),0,0,800,600,0,0,0,#PB_Screen_NoSynchronization )=0
MessageRequester("Error", "Can't open the sprite system", 0)
End
EndIf
UsePNGImageDecoder()
Import "NeuroNetLib.lib"
CreateNeuroNet(nbLayer.i)
AddNeuroInputs(*net,Nbinputs.i)
AddNeuroLayer(*net,NbNeuron.i)
InitRandomWeightNeuroNet(*net)
ReadNeuronOutput.d(*net,layer.i,neuron.i)
DeleteNeuroNet(*net)
Propagate(*net)
SetInput(*net,RowInput.i,value.d)
activation.d(output.d)
EndImport
#car=0:#track=1 ;sprites
#PopulationSize=25 ;number of cars
#laserNumber= 5 ;number of lasertelemeter per car
#rayonmax=60 ;depth of lasertelemeters
#MutationRate=10 ;mutation rate
#startx=428:#starty=275 ;starts coord
CreateSprite(#car,32,32,#PB_Sprite_PixelCollision)
LoadSprite(#track,"circuit.png",#PB_Sprite_PixelCollision)
StartDrawing(SpriteOutput(#car))
LineXY(0,5,31,10,#Red)
LineXY(31,10,31,20,#Red)
LineXY(31,20,0,25,#Red)
LineXY(0,25,0,5,#Red)
FillArea(15,15,#Red)
StopDrawing()
Structure vector
x.f
y.f
EndStructure
Structure captor
angle.i ;angle du laser en degré
x.i ;point detecté
y.i ;point detecté
dist.f ;distance mesurée
EndStructure
Structure physic
pos.vector
vel.vector
acc.vector
rotation.f
fitness.i
dead.b
couleur.i
*net
laser.captor[#lasernumber]
EndStructure
Global Dim car.physic(#PopulationSize)
Global PopulationAlive.i
Global Maxfitness.i
Global Fitness.i
Global Gen.i
Procedure Offspring(*net1,*net2,*net3)
size=SizeOf(*net1)
sizefl.i=8
nblayer.i=PeekI(*net1)
For i=1 To nblayer
*layer1=PeekI(*net1+size+size*i)
*layer2=PeekI(*net2+size+size*i)
*layer3=PeekI(*net3+size+size*i)
nbneuron=PeekI(*layer1)
nbprevoutput=PeekI(*layer1+size)
For t=0 To nbneuron*nbprevoutput-1
weight1.d=PeekD(*layer1+size*3+sizefl*t)
weight2.d=PeekD(*layer2+size*3+sizefl*t)
rand=Random(2)
If rand=0
weight3.d=weight1
ElseIf rand=1
weight3=weight2
Else
weight3=(weight1+weight2)/2
EndIf
;mutation
If Random(100)<#MutationRate:weight3=(Random(200)-100)/100:EndIf
PokeD(*layer3+size*3+sizefl*t,weight3)
Next t
Next i
EndProcedure
Procedure UpdatePhysic()
Fitness+1
For i=0 To #PopulationSize-1
If car(i)\dead:Continue:EndIf
right.d=ReadNeuronOutput(car(i)\net,2,1)
left.d=ReadNeuronOutput(car(i)\net,2,2)
center.d=ReadNeuronOutput(car(i)\net,2,3)
If left>right And left>center
car(i)\rotation+2
ElseIf right>left And right>center
car(i)\rotation-2
EndIf
car(i)\pos\x+Cos(Radian(car(i)\rotation))
car(i)\pos\y+Sin(Radian(car(i)\rotation))
x=SpriteWidth(#car)/2+car(i)\pos\x
y=SpriteHeight(#car)/2+car(i)\pos\y
;test telemeterlasers
StartDrawing(SpriteOutput(#track))
For t=0 To #laserNumber-1
rayon=0:angle.d=Radian(car(i)\laser[t]\angle+car(i)\rotation)
angle1.d=Cos(angle)
angle2.d=Sin(angle)
Repeat
xx.i=(x+rayon*angle1)
yy.i=(y+rayon*angle2)
rayon+1
Until Point(xx,yy)=RGB(32,0,150) Or rayon>#rayonmax Or xx<0 Or yy<0 Or xx>=800 Or yy>=600
car(i)\laser[t]\dist=rayon
;update neural network inputs
SetInput(car(i)\net,t+1,rayon/#rayonmax)
Next t
StopDrawing()
If SpritePixelCollision(#car,car(i)\pos\x,car(i)\pos\y,#track,0,0)
car(i)\dead=1
PopulationAlive-1
car(i)\fitness=Fitness
;Debug "collision "+Str(i)
EndIf
If fitness=150 And Abs(car(i)\pos\x-#startx)<10 And Abs(car(i)\pos\y-#starty)<10
car(i)\dead=1
PopulationAlive-1
car(i)\fitness=Fitness
;Debug "tourne en rond "+Str(i)
EndIf
If fitness>5000
car(i)\dead=1
PopulationAlive-1
car(i)\fitness=Fitness
EndIf
If PopulationAlive=0:Maxfitness=fitness:EndIf
Propagate(car(i)\net)
Next i
EndProcedure
;(r)initialise la population
Procedure ResetPopulation()
Gen+1
PopulationAlive=#PopulationSize
If car(0)\net<>0
SortStructuredArray(car(),#PB_Sort_Descending,OffsetOf(physic\fitness),TypeOf(physic\fitness))
;fill the pool
NewList pool.i()
Dim carcopy.physic(#PopulationSize)
CopyArray(car(),carcopy())
For i=0 To #PopulationSize-1
rat.d=(car(i)\fitness/Maxfitness)*100
rate.i=rat
For t=1 To rate
AddElement(pool())
pool()=i
Next t
Next i
total.i=ListSize(pool())
;keep 2 best
For son=2 To #PopulationSize-2
SelectElement(pool(),Random(total-1))
father=pool()
SelectElement(pool(),Random(total-1))
mother=pool()
Offspring(carcopy(father)\net,carcopy(mother)\net,car(son)\net)
Next son
;one totaly random
InitRandomWeightNeuroNet(car(#PopulationSize-1)\net)
EndIf
For i=0 To #PopulationSize-1
If car(i)\net=0
car(i)\net=CreateNeuroNet(2)
AddNeuroInputs(car(i)\net,#laserNumber) ;nb laser inputs
AddNeuroLayer(car(i)\net,#laserNumber) ;hidden layer nb laser neurons
AddNeuroLayer(car(i)\net,3) ;5 outputs: left, right , center
a=180/(#laserNumber+1)
b=a-90
For t=0 To #laserNumber-1
car(i)\laser[t]\angle=b
b+a
Next t
InitRandomWeightNeuroNet(car(i)\net)
EndIf
car(i)\rotation=0
If Random(1)=0
car(i)\rotation=180
EndIf
car(i)\pos\x=#startx
car(i)\pos\y=#starty
car(i)\dead=0
car(i)\fitness=0
car(i)\couleur=RGB(Random(155)+100,Random(155)+100,Random(155)+100)
Next i
Fitness=0
Maxfitness=0
EndProcedure
Repeat
Repeat:Until WindowEvent()=0
Delay(3)
FlipBuffers()
ExamineKeyboard()
DisplaySprite(#track,0,0)
If PopulationAlive=0
ResetPopulation()
EndIf
If PopulationAlive:UpdatePhysic():EndIf
For i=0 To #PopulationSize-1
If car(i)\dead=1:Continue:EndIf
StartDrawing(ScreenOutput())
For t=0 To #laserNumber-1
LineXY(SpriteWidth(#car)/2+car(i)\pos\x,SpriteHeight(#car)/2+car(i)\pos\y,SpriteWidth(#car)/2+car(i)\pos\x+car(i)\laser[t]\dist*Cos(Radian(car(i)\laser[t]\angle+car(i)\rotation)),SpriteHeight(#car)/2+car(i)\pos\y+car(i)\laser[t]\dist*Sin(Radian(car(i)\laser[t]\angle+car(i)\rotation)),RGB(120,120,120))
DrawText(0,0,"Generation : "+Str(gen))
DrawText(0,20,"Time on track (fitness) : "+Str(fitness))
DrawText(0,40,"Population alived : "+Str(PopulationAlive))
DrawText(0,60,Str(#laserNumber+3)+" neurons, "+Str(#laserNumber)+" inputs")
Next t
StopDrawing()
RotateSprite(#car,car(i)\rotation,#PB_Absolute)
DisplayTransparentSprite(#car,car(i)\pos\x,car(i)\pos\y,255,car(i)\couleur)
Next i
Until KeyboardPushed(#PB_Key_Escape)
https://www.youtube.com/watch?v=Jvrfbu0Glyo&t=
Edit: modify genetic algo
Edit2: modify Dll: add bias.