It is currently Mon Nov 19, 2018 12:28 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 4 posts ] 
Author Message
 Post subject: Basic Genetic evolve: Smart Rockets
PostPosted: Sun Jan 28, 2018 9:19 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Thu Apr 30, 2009 5:23 pm
Posts: 287
Location: Côtes d'Azur, France
Rockets seek for the goal (blue circle).
They reproduce themself until reaching their goal.
(Fitness function can be improved, I just gave it a try)
Number of rockets, genome length and mutation rate can be ajusted.

Code:
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
#rocket=0:#target=1:#wall=2;sprites
#PopulationSize=200;number of rocket
#LifeSpan=700;length of the genome
#MutationRate=1    ;pourcent of mutation of the genes
Structure vector
   x.f
   y.f
EndStructure
Structure physic
   hit.b
   cancel.b
   pos.vector
   vel.vector
   acc.vector
   Maxfitness.f
   gene.vector[#LifeSpan]
EndStructure
Global Target.vector:target\x=ScreenWidth()/2:target\y=70
Global wall.vector
wall\x=300
wall\y=300
Global Dim rocket.physic(#PopulationSize)
Global Generation.i=1
Global Hits.i=0

;create rocket's, target's and wall's sprites
CreateSprite(#rocket,32,32,#PB_Sprite_PixelCollision)
StartDrawing(SpriteOutput(#rocket))
LineXY(10,31,15,0,#Red)
LineXY(15,0,21,31,#Red)
LineXY(21,31,10,31,#Red)
FillArea(15,15,#Red,#Red)
StopDrawing()
CreateSprite(#target,32,32,#PB_Sprite_PixelCollision)
StartDrawing(SpriteOutput(#target))
Circle(15,15,15,#Blue)
StopDrawing()
CreateSprite(#wall,150,10,#PB_Sprite_PixelCollision)
StartDrawing(SpriteOutput(#wall))
Box(0,0,150,10,#White)
StopDrawing()
Procedure.f Heading(IndexRocket.i)
   x.f=rocket(IndexRocket)\vel\x
   y.f=rocket(IndexRocket)\vel\y
      angle.f=ATan2(x,y)+#PI/2
   ProcedureReturn Degree(angle)
EndProcedure

;Populate rockets
Procedure CreatePopulation()
   For i=1 To #PopulationSize
      rocket(i)\pos\x=ScreenWidth()/2-SpriteWidth(#rocket)/2
      rocket(i)\pos\y=600-SpriteHeight(#rocket)
      ;create random DNA
      For t=0 To #LifeSpan-1
         rocket(i)\gene[t]\x=Cos(Random(2*#PI*10000)/10000)/10
         rocket(i)\gene[t]\y=Sin(Random(2*#PI*10000)/10000)/10
      Next t
   Next i
EndProcedure

;Beget
Procedure CrossOver()
   Static Dim ChildRocket.physic(#PopulationSize)
   Generation+1
   Hits=0
   Protected NewList MatingPool()
   ;fill the mating pool with as much of each rocket as their fitness value
   ;so a large fitness value rocket has much more chance to be randomly picked to be parent
   For IndexRocket=1 To #PopulationSize
      For t=0 To rocket(IndexRocket)\Maxfitness
         AddElement(MatingPool())
         MatingPool()=IndexRocket
      Next t
   Next IndexRocket
   
   For i=1 To #PopulationSize
      PickedParentA=Random(ListSize(MatingPool())-1)
      PickedParentB=Random(ListSize(MatingPool())-1)
      midpoint.i=Random(#LifeSpan-1)
      For t=0 To #LifeSpan-1
         If t<midpoint
            SelectElement(MatingPool(),PickedParentA)
         Else
            SelectElement(MatingPool(),PickedParentB)
         EndIf
         ChildRocket(i)\gene[t]=rocket(MatingPool())\gene[t]
         ;mutation
         If Random(100)<#MutationRate
            ChildRocket(i)\gene[t]\x=Cos(Random(2*#PI*10000)/10000)/10
            ChildRocket(i)\gene[t]\y=Sin(Random(2*#PI*10000)/10000)/10
         EndIf   
      Next t
      rocket(i)\pos\x=ScreenWidth()/2-SpriteWidth(#rocket)/2
      rocket(i)\pos\y=600-SpriteHeight(#rocket)
      rocket(i)\vel\x=0
      rocket(i)\vel\y=0
      rocket(i)\hit=0
      rocket(i)\Maxfitness=0
      rocket(i)\cancel=0
   Next i   
   For i=1 To #PopulationSize
      For t=0 To #LifeSpan-1
         rocket(i)\gene[t]=ChildRocket(i)\gene[t]
      Next t
     
   Next i     
   
EndProcedure   

Procedure UpdatePhysic()
   Static Frame.i=0
   For IndexRocket=1 To #PopulationSize
      If rocket(IndexRocket)\cancel:Continue:EndIf
      rocket(IndexRocket)\acc\x+rocket(IndexRocket)\gene[Frame]\x
      rocket(IndexRocket)\acc\y+rocket(IndexRocket)\gene[Frame]\y
     
      rocket(IndexRocket)\vel\x+rocket(IndexRocket)\acc\x
      rocket(IndexRocket)\vel\y+rocket(IndexRocket)\acc\y
     
      rocket(IndexRocket)\pos\x+rocket(IndexRocket)\vel\x
      rocket(IndexRocket)\pos\y+rocket(IndexRocket)\vel\y
     
      rocket(IndexRocket)\acc\x=0
      rocket(IndexRocket)\acc\y=0
      distance.f=Abs(rocket(IndexRocket)\pos\x-target\x)+Abs(rocket(IndexRocket)\pos\y-target\y)
      ;fitness between 0 and 100. 100 means it reachs accuratly the target
      fitness.f=((ScreenWidth()+ScreenHeight())-distance)/(ScreenWidth()+ScreenHeight())*100
      If fitness>rocket(IndexRocket)\Maxfitness:rocket(IndexRocket)\Maxfitness=fitness:EndIf
   Next IndexRocket
   Frame+1
   If Frame=#LifeSpan:Frame=0:CrossOver():EndIf
EndProcedure

CreatePopulation()
Repeat
   Repeat:Until WindowEvent()=0
   FlipBuffers()
   ClearScreen(#Black)
   ExamineKeyboard()
   
   UpdatePhysic()
   
   ;display rockets !
   For IndexRocket=1 To #PopulationSize
      RotateSprite(#rocket,Heading(IndexRocket),#PB_Absolute)
      DisplayTransparentSprite(#rocket,rocket(IndexRocket)\pos\x,rocket(IndexRocket)\pos\y,128)
      If rocket(IndexRocket)\hit=0 And SpritePixelCollision(#rocket,rocket(IndexRocket)\pos\x,rocket(IndexRocket)\pos\y,#target,target\x-SpriteWidth(#target)/2,target\y-SpriteHeight(#target)/2)
         rocket(IndexRocket)\hit=1
         Hits+1
         ;bonus to the rockets reaching the goal
         If Hits>MaxHits:MaxHits=Hits:EndIf
         rocket(IndexRocket)\Maxfitness*10
      EndIf   
      If SpritePixelCollision(#rocket,rocket(IndexRocket)\pos\x,rocket(IndexRocket)\pos\y,#wall,wall\x,wall\y)
         rocket(IndexRocket)\cancel=1
         If rocket(IndexRocket)\hit=0
            rocket(IndexRocket)\Maxfitness/10
         EndIf
      EndIf
   Next IndexRocket
   ;display wall
   DisplayTransparentSprite(#wall,wall\x,wall\y)

   ;display target
   DisplayTransparentSprite(#target,target\x-SpriteWidth(#target)/2,target\y-SpriteHeight(#target)/2,128)
   
   StartDrawing(ScreenOutput())
   DrawText(0,0,"Generation : "+Str(Generation))
   DrawText(0,25,"Target Hits : "+Str(Hits))
   DrawText(0,50,"Max Target Hits : "+Str(MaxHits))
   DrawText(0,75,"Press [Escape] to Quit")
   StopDrawing()
   
Until KeyboardPushed(#PB_Key_Escape)



edit: nosynch to make it faster.
edit2:error Atan => Atan2 fixed by Olliver

_________________
There are 2 methods to program bugless.
But only the third works fine.

Win10, Pb x86 5.62


Last edited by Fig on Fri Feb 02, 2018 9:12 pm, edited 2 times in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Basic Genetic evolve: Smart Rockets
PostPosted: Fri Feb 02, 2018 9:40 am 
Offline
Moderator
Moderator
User avatar

Joined: Thu Dec 31, 2009 11:05 pm
Posts: 673
Location: Berlin and Ibiza
Image

_________________
ImageImageImageImageImage


Top
 Profile  
Reply with quote  
 Post subject: Re: Basic Genetic evolve: Smart Rockets
PostPosted: Wed Nov 07, 2018 8:43 pm 
Offline
User
User
User avatar

Joined: Mon Feb 26, 2018 10:41 pm
Posts: 49
Location: Netherlands
Pretty late but here a extra speed bonus.

At the top of the code type :
Code:
DisableDebugger


Time needed to run the debugger to is turned of
Now its going even faster.

_________________
From my first self made computer till now I stil like computers.


Top
 Profile  
Reply with quote  
 Post subject: Re: Basic Genetic evolve: Smart Rockets
PostPosted: Thu Nov 08, 2018 4:28 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4309
Location: Lyon - France
Waooouuuhhh FIG !!! :shock:
A real japaneze code !!! :D

Image

Thanks to sharing 8)

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 4 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 4 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye