Basic Genetic evolve: Smart Rockets

Advanced game related topics
User avatar
Fig
Enthusiast
Enthusiast
Posts: 351
Joined: Thu Apr 30, 2009 5:23 pm
Location: Côtes d'Azur, France

Basic Genetic evolve: Smart Rockets

Post by Fig »

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: 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
#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
Last edited by Fig on Fri Feb 02, 2018 9:12 pm, edited 2 times in total.
There are 2 methods to program bugless.
But only the third works fine.

Win10, Pb x64 5.71 LTS
User avatar
RSBasic
Moderator
Moderator
Posts: 1218
Joined: Thu Dec 31, 2009 11:05 pm
Location: Gernsbach (Germany)
Contact:

Re: Basic Genetic evolve: Smart Rockets

Post by RSBasic »

Image
Image
Image
User avatar
bfernhout
Enthusiast
Enthusiast
Posts: 123
Joined: Mon Feb 26, 2018 10:41 pm
Location: Netherlands
Contact:

Re: Basic Genetic evolve: Smart Rockets

Post by bfernhout »

Pretty late but here a extra speed bonus.

At the top of the code type :

Code: Select all

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.
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Basic Genetic evolve: Smart Rockets

Post by Kwai chang caine »

Waooouuuhhh FIG !!! :shock:
A real japaneze code !!! :D

Image

Thanks to sharing 8)
ImageThe happiness is a road...
Not a destination
Post Reply