It is currently Sat May 26, 2018 6:35 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 2 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: 243
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.


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: 532
Location: Berlin and Ibiza
Image

_________________
ImageImageImageImage


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 2 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