Evolution génétique: Fusées malines

Programmation avancée de jeux en PureBasic
Avatar de l’utilisateur
Fig
Messages : 1176
Inscription : jeu. 14/oct./2004 19:48

Evolution génétique: Fusées malines

Message par Fig »

Les fusées essaient d'atteindre leur but (le cercle bleu) en faisant évoluer leur population.
La fonction de fitness doit être amélioré. La longueur du génome, le nombre de fusée et le taux de mutation peut être ajusté.

Code : Tout sélectionner

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)

Dernière modification par Fig le ven. 02/févr./2018 21:11, modifié 3 fois.
Il y a deux méthodes pour écrire des programmes sans erreurs. Mais il n’y a que la troisième qui marche.
Version de PB : 6.00LTS - 64 bits
Avatar de l’utilisateur
SPH
Messages : 4722
Inscription : mer. 09/nov./2005 9:53

Re: Evolution génétique: Fusées malines

Message par SPH »

Drole de code :P
J'ai pour ma part rien capté :|
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.00 - 64 bits
Avatar de l’utilisateur
Cool Dji
Messages : 1126
Inscription : ven. 05/sept./2008 11:42
Localisation : Besançon
Contact :

Re: Evolution génétique: Fusées malines

Message par Cool Dji »

Joli,

Ah, les algorithmes génétiques :D , le concept est aussi simple que génial...
Only PureBasic makes it possible
Ollivier
Messages : 4190
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: Evolution génétique: Fusées malines

Message par Ollivier »

Il y a une petite erreur d'unité dans ta procédure "Heading()".
(les -90 et +90 doivent être -#pi/2 et +#pi/2).

Toute la procédure peut être remplacée par une macro axée sur la fonction Atan2(x, y).
Avatar de l’utilisateur
Fig
Messages : 1176
Inscription : jeu. 14/oct./2004 19:48

Re: Evolution génétique: Fusées malines

Message par Fig »

j'avais fait la même erreur sur ma fonction d'éclairage... Atan2 ça ne rentre pas... :wink:
Merci, c'est modifié.
Il y a deux méthodes pour écrire des programmes sans erreurs. Mais il n’y a que la troisième qui marche.
Version de PB : 6.00LTS - 64 bits
Répondre