PureBasic

Forums PureBasic
Nous sommes le Jeu 24/Oct/2019 2:53

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 5 messages ] 
Auteur Message
 Sujet du message: Evolution génétique: Fusées malines
MessagePosté: Dim 28/Jan/2018 21:27 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 14/Oct/2004 19:48
Messages: 1121
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:
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)


_________________
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 : 5.45LTS - 32 bits


Dernière édition par Fig le Ven 02/Fév/2018 21:11, édité 3 fois.

Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Evolution génétique: Fusées malines
MessagePosté: Dim 28/Jan/2018 23:07 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 4067
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 ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.70LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Evolution génétique: Fusées malines
MessagePosté: Lun 29/Jan/2018 11:55 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 05/Sep/2008 11:42
Messages: 1120
Localisation: Besançon
Joli,

Ah, les algorithmes génétiques :D , le concept est aussi simple que génial...

_________________
Only PureBasic makes it possible


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Evolution génétique: Fusées malines
MessagePosté: Ven 02/Fév/2018 1:18 
Hors ligne

Inscription: Ven 29/Juin/2007 17:50
Messages: 3508
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).


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Evolution génétique: Fusées malines
MessagePosté: Ven 02/Fév/2018 19:15 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 14/Oct/2004 19:48
Messages: 1121
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 : 5.45LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 5 messages ] 

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 0 invités


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  
cron

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye