Pathfinding , nouvelle version

comtois · Message par **comtois** » ven. 15/juil./2005 12:29

J'utilise enfin un tas pour retrouver le F le plus petit , ça faisait un moment que je remettais , ben voila c'est fait :

C'est bien sûr nettement plus rapide avec cette méthode .

Il y a encore pas mal d'améliorations à apporter , ça sera pour une autre fois , ou si vous avez des suggestions à faire , je suis preneur.

Code : Tout sélectionner

; ***********************************************************
; ** Comtois le 16/07/05 - Pathfinding pour Purebasic V0.4 **
; ***********************************************************
; v4.51

; **********************************************************************
; ************************** Mode d'emploi *****************************
; **********************************************************************
; ** Touche [F1] pour Afficher les cases Closed / Open **
; ** Touche [F2] pour Afficher le chemin **
; ** Touche [F3] Sauve la Map : Permet de faire différents tests avec la même map **
; ** Touche [F4] Charge la Map  **
; ** Touche [F5] Affiche une Grille **
; ** Touche [F6] Efface la Map **
; ** Touche [F7] Sans/Avec Diagonale **
; ** Bouton Gauche de la souris ajoute un mur **
; ** Bouton Droit de la souris efface un mur **
; ** Bouton Gauche de la souris + la Touche [Shift] Déplace la cible **
; ** Bouton Droit de la souris + la touche [Shift] Déplace le départ **
; **********************************************************************


; --- Initialisation ---
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
  MessageRequester("Erreur", "Impossible d'initialiser DirectX 7 Ou plus", 0)
  End
EndIf

; --- Plein écran ---
#ScreenWidth = 800
#ScreenHeight = 600
#ScreenDepth = 16
If OpenScreen(#ScreenWidth,#ScreenHeight,#ScreenDepth,"Essai Pathfinding") = 0
  MessageRequester("Erreur", "Impossible d'ouvrir l'écran ", 0)
  End
EndIf

; --- Variables globales ---
Global ciblex,cibley,departx,departy, AffOpenClosed,affPath,AffGrille,diagonale
affPath=1
AffGrille=1
; --- dimension du tableau et taille d'une case ---
#max_x=48
#max_y=48
#max_x1=#max_x+1

#taille=12


; --- positionne la cible sur la grille ---
ciblex=1+Random(#max_x-2)
cibley=1+Random(#max_y-2)

; --- positionne le départ sur la grille ---
departx=1+Random(#max_x-2)
departy=1+Random(#max_y-2)

Structure Noeud
  Id.l
  x.l
  y.l
  f.l
  G.l
  H.l
  Open.l
  Closed.l
EndStructure   

; --- pour la recherche du chemin ---
Global Dim Map(#max_x,#max_y)
Global Dim parent.point(#max_x,#max_y)
Global Dim Tas((#max_x+1)*(#max_y+1))
Global Dim Noeud.Noeud((#max_x+1)*(#max_y+1))

; ************************************************************************************
; *** LES SPRITES ***
; ************************************************************************************
Enumeration
  #depart
  #cible
  #Souris
EndEnumeration

;/Départ
CreateSprite(#depart, #taille, #taille)
StartDrawing(SpriteOutput(#depart))
Circle(#taille/2,#taille/2,(#taille/2),RGB(255,255,255))
StopDrawing()
;/Cible
CreateSprite(#cible, #taille, #taille)
StartDrawing(SpriteOutput(#cible))
Circle(#taille/2,#taille/2,(#taille/2),RGB(255,55,18))
StopDrawing()
;/ Souris
CreateSprite(#Souris, #taille, #taille)
StartDrawing(SpriteOutput(#Souris))
DrawingMode(4)
Box(1,1,#taille-1,#taille-1,RGB(100,200,255))
StopDrawing()

; ************************************************************************************
; *** LES PROCEDURES ***
; ************************************************************************************
Procedure SauveMap()
  If CreateFile(0,"PathFindingMap.map")
    For y=0 To #max_y
      For x=0 To #max_x
        WriteLong(0, Map(x,y))
      Next x
    Next y
    CloseFile(0)
  EndIf   
EndProcedure
Procedure ChargeMap()
  If OpenFile(0,"PathFindingMap.map")
    For y=0 To #max_y
      For x=0 To #max_x
        Map(x,y) = ReadLong(0)
      Next x
    Next y
    CloseFile(0)
  EndIf   
EndProcedure
Procedure mur()
  Couleur=RGB(100,100,255)
  StartDrawing(ScreenOutput())
  For y=0 To #max_y
    For x=0 To #max_x
      If Map(x,y)
        Box(x*#taille + 1,y*#taille + 1,#taille - 1,#taille - 1,Couleur)
      EndIf
    Next x
  Next y
  DrawingMode(1)
  FrontColor(RGB(255,255,255))
  Col=0
  lig + 20
  DrawText(#taille*(#max_x+1),lig,"[F1] Sans/Avec open et closed")
  
  lig + 20
  DrawText(#taille*(#max_x+1),lig,"[F2] Sans/Avec Recherche")
  
  lig + 20
  DrawText(#taille*(#max_x+1),lig,"[F3] Sauve la Map")
  
  lig + 20
  DrawText(#taille*(#max_x+1),lig,"[F4] Charge la Map")
  
  
  lig + 20
  DrawText(#taille*(#max_x+1),lig,"[F5] Sans/Avec Grille")
  
  lig + 20
  DrawText(#taille*(#max_x+1),lig,"[F6] Efface la Map")
  
  lig + 20
  DrawText(#taille*(#max_x+1),lig,"[F7] Sans/Avec Diagonale")
  
  lig + 20
  DrawText(#taille*(#max_x+1),lig,"[Bouton Gauche] Ajoute un mur")
  
  lig + 20
  DrawText(#taille*(#max_x+1),lig,"[Bouton Droit] Efface un mur")
  
  lig + 20
  DrawText(#taille*(#max_x+1),lig,"[Bouton Gauche] + [Shift] Cible")
  
  lig + 20
  DrawText(#taille*(#max_x+1),lig,"[Bouton Droit] + [Shift] Départ")
  
  lig + 20
  DrawText(#taille*(#max_x+1),lig,"Position : " + Str(MouseX()/#taille) + " / " + Str(MouseY()/#taille))   
  
  StopDrawing()
EndProcedure
Procedure EffaceMur()
  
  For y=0 To #max_y
    For x=0 To #max_x
      Map(x,y)=0
    Next x
  Next y
  
EndProcedure

Procedure AffGrille()
  Couleur=RGB(100,100,100)
  StartDrawing(ScreenOutput())
  For x=0 To #max_x
    Line(x*#taille,0,0,(#max_y+1)*#taille,Couleur)
  Next x 
  For y=0 To #max_y
    Line(0,y*#taille,(#max_x+1)* #taille,0,Couleur)
  Next y         
  StopDrawing()
EndProcedure

Procedure RetasseTas(Pos)
  M=Pos
  While M <> 1
    If Noeud(Tas(M))\f <= Noeud(Tas(M/2))\f
      temp = Tas(M/2)
      Tas(M/2) = Tas(M)
      Tas(M) = temp
      M = M/2
    Else
      Break
    EndIf
  Wend
EndProcedure

Procedure.w ChercheChemin()
  ; C'est mon interprétation du fameux A*
  
  ;Initialise le tableau Noeud
  Dim Noeud.Noeud((#max_x+1)*(#max_y+1))
  
  ;Si on est déjà arrivé pas la peine d'aller plus loin
  If departx=ciblex And departy=cibley
    ProcedureReturn 0
  EndIf
  
  ;Calcul Un ID unique pour le Noeud en cours
  NoeudID = departx + #max_x1 * departy
  
  ; --- on met le point de départ dans le tas ---
  ;Un tas c'est un arbre , habituellement binaire.
  ;Il permet de retrouver rapidement le f le plus petit ,sans avoir à trier l'ensemble des Noeuds.
  
  Taille_Tas = 1
  Tas(Taille_Tas)=NoeudID
  Noeud(NoeudID)\x=departx
  Noeud(NoeudID)\y=departy
  Noeud(NoeudID)\Open=1
  
  ; --- tant que la liste open n'est pas vide et tant qu'on a pas trouvé la cible
  While fin = 0
    ; --- il n'y a pas de chemin ---
    If Taille_Tas = 0
      fin = 2
      Break
    Else
      
      ; --- on récupère la Case la plus avantageuse ( avec F le plus bas) ===
      NoeudID=Tas(1)
      x=Noeud(NoeudID)\x
      y=Noeud(NoeudID)\y
      Noeud(NoeudID)\Closed=1
      
      ;Supprime un noeud du tas
      Tas(1) = Tas(Taille_Tas)
      Taille_Tas - 1
      
      ;Retasse le tas après une suppression
      v = 1
      
      Repeat
        u = v
        If 2*u+1 <= Taille_Tas
          If Noeud(Tas(u))\f >= Noeud(Tas(2*u))\f : v = 2*u   : EndIf
          If Noeud(Tas(v))\f >= Noeud(Tas(2*u+1))\f : v = 2*u+1 : EndIf
        ElseIf 2*u <= Taille_Tas
          If Noeud(Tas(u))\f >= Noeud(Tas(2*u))\f : v = 2*u : EndIf
        EndIf
        
        If u <> v
          temp = Tas(u)
          Tas(u) = Tas(v)
          Tas(v) = temp
        Else
          Break ; la propriété du tas est rétablie , on peut quitter
        EndIf
      ForEver
      
    EndIf
    
    ; --- on teste les cases autour de la case sélectionnée ===
    For a = x - 1 To x + 1
      For b = y - 1 To y + 1
        ; ---- si la Case est libre et n'a pas encore été traitée
        If a >= 0 And a <= #max_x And b >= 0 And b <= #max_y And (diagonale=1 Or a = x Or b = y)
          
          ;Calcul un ID unique
          TempID = a + #max_x1 * b
          
          If Map(a,b) = 0 And Noeud(TempID)\Closed = 0
            
            If a = x Or b =y Or Map(a,y)=0 Or Map(x,b)=0
              
              ; calcule G pour la Case en cours de test ( à adapter selon le jeu)
              ; si la distance n'a pas d'importance , on peut se contenter de calculer
              ; le nombre de cases , donc de faire G = G(x,y) + 1
              
              If a <> x And b <> y
                G = 17 + Noeud(NoeudID)\G ;
              Else
                G = 10 + Noeud(NoeudID)\G ;
              EndIf
              
              
              ; si la Case n'est pas dans la liste open
              If Noeud(TempID)\Open = 0 Or G < Noeud(TempID)\G
                
                parent(a,b)\x = x
                parent(a,b)\y = y
                Noeud(TempID)\G = G
                distance = (Abs(ciblex-a) + Abs(cibley-b))*10
                Noeud(TempID)\f = Noeud(TempID)\G + distance
                
                If Noeud(TempID)\Open = 0
                  
                  ;Ajoute le Noeud dans le tas
                  Taille_Tas + 1
                  Tas(Taille_Tas) = TempID
                  Noeud(TempID)\x = a
                  Noeud(TempID)\y = b
                  Noeud(TempID)\Open = 1
                  RetasseTas(Taille_Tas)
                  
                Else
                  
                  ;Retasse le tas à partir du Noeud en cours
                  For i = 1 To Taille_Tas
                    If Tas(i)=TempID
                      RetasseTas(i)
                      Break
                    EndIf
                  Next i
                  
                EndIf   
               
                ; --- la cible est trouvée ---
                If a = ciblex And b = cibley
                  fin = 1
                  Break 2
                EndIf
              EndIf
            EndIf
          EndIf
        EndIf
      Next b
    Next a
    
  Wend
  ProcedureReturn fin
EndProcedure
Procedure souris(ToucheShift)
  If ExamineMouse()
    SX = MouseX() / #taille
    SY = MouseY() / #taille
    If SX >= 0 And SX <= #max_x And SY >= 0 And SY <= #max_y
      If ToucheShift = 0
        If MouseButton(1)
          Map(SX,SY)=1 ;place un mur
        ElseIf MouseButton(2)
          Map(SX,SY)=0 ; supprime un Mur
        EndIf
      Else
        If MouseButton(1)
          ciblex = SX : cibley = SY ; place la cible
        ElseIf MouseButton(2)
          departx = SX : departy = SY ; place le départ
        EndIf
      EndIf
    EndIf
  EndIf
EndProcedure
Procedure AffOpenClosed()
  CoulOpen=RGB(200,255,200)
  CoulClosed=RGB(255,200,200)
  StartDrawing(ScreenOutput())
  For y=0 To #max_y
    For x=0 To #max_x
      xa=x*#taille
      ya=y*#taille
      Id = x + #max_x1 * y
      If Noeud(Id)\Closed
        Box(xa + 1,ya + 1,#taille - 1,#taille - 1,CoulClosed)
      ElseIf Noeud(Id)\Open
        Box(xa + 1,ya + 1,#taille - 1,#taille - 1,CoulOpen)
      EndIf
    Next x
  Next y
  StopDrawing()
EndProcedure
Procedure affPath()
  If ChercheChemin()=1
    a=-1
    b=-1
    cx=ciblex
    cy=cibley
    Couleur=RGB(255,255,100)
    StartDrawing(ScreenOutput())
    While a <> departx Or b <> departy
      a = parent(cx,cy)\x
      b = parent(cx,cy)\y
      xa=(cx*#taille)+#taille/2
      ya=(cy*#taille)+#taille/2
      xb=(a*#taille)+#taille/2
      yb=(b*#taille)+#taille/2
      LineXY(xa,ya,xb,yb,Couleur)
      cx = a
      cy = b
    Wend
    StopDrawing()
  EndIf
EndProcedure
Procedure AffCadre()
  Couleur=RGB(255,255,255)
  StartDrawing(ScreenOutput())
  DrawingMode(4)
  Box(0,0,#taille*(#max_x+1),#taille*(#max_y+1),Couleur)
  StopDrawing()
EndProcedure
; ************************************************************************************
; *** BOUCLE PRINCIPALE ***
; ************************************************************************************
Repeat
  ClearScreen(0)
  ;/ état du clavier
  If ExamineKeyboard()
    If KeyboardReleased(#PB_Key_F1)
      AffOpenClosed=1-AffOpenClosed
    EndIf
    If KeyboardReleased(#PB_Key_F2)
      affPath=1-affPath
    EndIf
    If KeyboardReleased(#PB_Key_F3)
      SauveMap()
    EndIf
    If KeyboardReleased(#PB_Key_F4)
      ChargeMap()
    EndIf
    If KeyboardReleased(#PB_Key_F5)
      AffGrille=1-AffGrille
    EndIf
    If KeyboardReleased(#PB_Key_F6)
      EffaceMur()
    EndIf
    If KeyboardReleased(#PB_Key_F7)
      diagonale=1-diagonale
    EndIf
    ToucheShift = KeyboardPushed(#PB_Key_LeftShift) Or KeyboardPushed(#PB_Key_RightShift)
  EndIf
  ;/ Gestion de la souris
  souris(ToucheShift)
  ;/affiche le fond
  mur()
  If AffGrille
    AffGrille()
  EndIf
  AffCadre()
  
  If AffOpenClosed
    AffOpenClosed()
  EndIf
  ;/Lance la recherche
  If affPath
    affPath()
  EndIf
  
  ;/Affiche les sprites
  DisplayTransparentSprite(#Souris,MouseX() - #taille / 2,MouseY() - #taille / 2)
  DisplayTransparentSprite(#cible,ciblex * #taille,cibley * #taille)
  DisplayTransparentSprite(#depart,departx * #taille,departy * #taille)
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

End

Dr. Dri · Message par **Dr. Dri** » ven. 15/juil./2005 12:41

J'ai pas regardé le code mais en tout cas ca fonctionne vraiment bien!

Dri

Progi1984 · Message par **Progi1984** » ven. 15/juil./2005 13:38

Quelle type d'amélioration manque t il selon toi ?

comtois · Message par **comtois** » ven. 15/juil./2005 13:55

Progi1984 a écrit :Quelle type d'amélioration manque t il selon toi ?

ajouter des options :
- Sans/Avec Déplacement en diagonal
- Sans/Avec Recherche du point le plus proche si la cible n'est pas accessible

Ensuite gérer la recherche dans un Thread ,ce qu'avait commencé à faire Cederavic.

voir pour simplifier le calcul de l'ID
Actuellement Je fais ID = x + max_x* y
tout ça dans la boucle ça fait bcp de calculs peut-être inutile ?
je pourrais peut-être me contenter d'incrémenter un ID , mais je n'ai pas encore analysé les conséquences sur le reste du code .

Et puis reprendre le code d'une façon générale , ça ne me semble pas net , je ne sais pas encore dire pourquoi , mais j'aime pas , je pense qu'il y a une meilleure organisation à mettre en place

Ah oui ,dernier point , je voudrais tester différentes heuristiques .

Progi1984 · Message par **Progi1984** » ven. 15/juil./2005 15:26

Les différentes heuristiques : Pour le calcul de H ? tu utileses la méthode de Manhattan ?

comtois · Message par **comtois** » ven. 15/juil./2005 15:59

oui c'est ça

Bon j'ai mis à jour le listing plus haut , rien de bien nouveau , j'ai juste ajouté une grille , la sauvegarde de la map , ça va me permettre de faire des essais avec la même map .Je vais aussi ajouter un chrono pour voir le temps que met l'algo pour trouver le chemin.

Pour voir quelque chose , je crois qu'il va falloir que je fasse une map de 150*150 minimum , sinon j'ai bien peur d'avoir toujours 0ms dans le chrono

comtois · Message par **comtois** » ven. 15/juil./2005 16:59

je viens de faire quelques tests pour comparer les résultats avec l'ancienne méthode et la nouvelle .

Y'a pas photo !!

Avec l'ancienne méthode :
Avec une map de 100x100 j'arrive à bloquer la souris tellement c'est lent(si je calcule le chemin en permanence).
ça met plus d'une seconde pour calculer le chemin !

Avec la nouvelle méthode:
En prenant la même map, ça ne met que quelques millisecondes pour calculer le chemin .Et je suis sûr que c'est encore perfectible.

erix14 · Message par **erix14** » ven. 15/juil./2005 18:23

Bravo

très beau code

c'est vrai qu'il y a encore quelques améliorations à faire, comme celle-ci :
Au lieu d'écrire

Code : Tout sélectionner

If Abs(a - x) > 0 And Abs(b - y) > 0

pour aller plus vite il vaut mieux écrire

Code : Tout sélectionner

If (a - x) <> 0 And (b - y) <> 0

Une optimisation en Pure & Assembleur serait pas mal !

Anonyme2 · Message par **Anonyme2** » ven. 15/juil./2005 18:39

Très bon,

on pourrait se baser sur ce code pour un éditeur d'icônes

Dr. Dri · Message par **Dr. Dri** » ven. 15/juil./2005 18:56

@Denis
Un éditeur d"icônes ???
Je suis pas sûr de comprendre

@erix14
On peut aussi faire ca nan ???

Code : Tout sélectionner

If a <> x And b <> y

Dri

Anonyme2 · Message par **Anonyme2** » ven. 15/juil./2005 19:04

Dr. Dri a écrit :@Denis
Un éditeur d"icônes ???
Je suis pas sûr de comprendre
Dri

lorsque je vois ce quadrillage, je pense aux éditeurs d'icônes (peut-être parce que j'ai travaillé des icônes ces jours-ci

(celui d'axialis est très bon enfin pour moi)

comtois · Message par **comtois** » ven. 15/juil./2005 19:45

erix14 a écrit :Bravo très beau code
c'est vrai qu'il y a encore quelques améliorations à faire, comme celle-ci :
Au lieu d'écrire
Code : Tout sélectionner
If Abs(a - x) > 0 And Abs(b - y) > 0
pour aller plus vite il vaut mieux écrire
Code : Tout sélectionner
If (a - x) <> 0 And (b - y) <> 0
Une optimisation en Pure & Assembleur serait pas mal !

je vais changer le code, merci

J'ai testé 4 solutions

Code : Tout sélectionner

OpenConsole()
boucle=100000000
a = 1
x = -1
b = 0
y = 1

tps=ElapsedMilliseconds()
For i=1 To boucle
    If Abs(a - x) > 0 And Abs(b - y) > 0
        G = 14 
    EndIf    
Next i
Total1=ElapsedMilliseconds()-tps

tps=ElapsedMilliseconds()
For i=1 To boucle
    If a - x <> 0 And b - y <> 0
        G = 14 
    EndIf    
Next i
Total2=ElapsedMilliseconds()-tps

tps=ElapsedMilliseconds()
For i=1 To boucle
    If a <> x And b <> y
        G = 14 
    EndIf    
Next i
Total3=ElapsedMilliseconds()-tps

tps=ElapsedMilliseconds()
For i=1 To boucle
    If a = x Or b = y
        G = 14 
    EndIf    
Next i
Total4=ElapsedMilliseconds()-tps

PrintN(Str(Total1))
PrintN(Str(Total2))
PrintN(Str(Total3))
PrintN(Str(Total4))
Input()
CloseConsole()

C'est le père Dri qui gagne , je vais adopter sa solution

Si vous voyez d'autres améliorations comme ça , je suis preneur.

J'ai vu que j'affectais Noeud(ID)\H alors que je pourrais m'en passer
idem pour distance , si je supprime cette affectation , ça devient :

Code : Tout sélectionner

Noeud(TempID)\f = Noeud(TempID)\G 
Noeud(TempID)\f + (Abs(ciblex-a) + Abs(cibley-b))*10

ça supprime deux affectations .

erix14 · Message par **erix14** » ven. 15/juil./2005 21:34

@erix14
On peut aussi faire ca nan ???
Code:
If a <> x And b <> y

Bien vu Dr. Dri

fweil · Message par **fweil** » sam. 16/juil./2005 7:33

...,

Pour l'optimisation ASM :

Code : Tout sélectionner

tps = ElapsedMilliseconds()
For i = 1 To boucle
  !  MOV     eax, dword [v_a] ; If a <> x And b <> y : G = 14 : EndIf
  !  MOV     ebx, dword [v_b]
  !  MOV     ecx, dword [v_x]
  !  CMP      eax, ecx
  !  JE         _Test_a_EQ_x_OR_b_EQ_x
  !  CMP      ebx, ecx
  !  JE         _Test_a_EQ_x_OR_b_EQ_x
  !  MOV     dword [v_G], 14
! _Test_a_EQ_x_OR_b_EQ_x:
Next
Total5 = ElapsedMilliseconds() - tps

tps = ElapsedMilliseconds()
For i = 1 To boucle
  !  MOV     eax, dword [v_a] ; If a = x And b = y : G = 14 : EndIf
  !  MOV     ebx, dword [v_b]
  !  MOV     ecx, dword [v_x]
  !  CMP      eax, ecx
  !  JNE       _Test_a_NE_x_OR_b_NE_x
  !  CMP      ebx, ecx
  !  JE         _Test_a_NE_x_OR_b_NE_x
  !  MOV     dword [v_G], 14
! _Test_a_NE_x_OR_b_NE_x:
Next
Total6 = ElapsedMilliseconds() - tps

En principe il n'y a pas de différence réelle entre JE et JNE.

Attention à ne pas faire les mesures avec le Debugger ON. Il y a aussi des différences de résultats selon l'état du PC au moment du test (en temps réel, il peut y avoir des allocations de processes qui décrochent parce que le système à besoin du processeur).

Sur mon PC, j'exécute à peu près 250M passes dans la boucle avec 9 instructions machine, ce qui correspond + ou - à la fréquence processeur.

comtois · Message par **comtois** » sam. 16/juil./2005 7:59

purebasic (PureASM) me sort ça pour le dernier test:

Code : Tout sélectionner

; tps=ElapsedMilliseconds()
CALL	 _PB_ElapsedMilliseconds@0
MOV	 dword [v_tps],eax
; For i=1 To boucle
MOV	 dword [v_i],1
_For13:
MOV	 eax,dword [v_boucle]
CMP	 eax,dword [v_i]
JL	 _Next14
; If a = x Or b = y
MOV	 ebx,dword [v_a]
CMP	 ebx,dword [v_x]
JE	 _AO_Ok3
MOV	 ebx,dword [v_b]
CMP	 ebx,dword [v_y]
JE	 _AO_Ok3
JMP	 _AO_No3
_AO_Ok3:
MOV	 eax,1
JMP	 _AO3
_AO_No3:
XOR	 eax,eax
_AO3:
And	 eax,eax
JE	 _EndIf16
; G = 14
MOV	 dword [v_G],14
; EndIf   
_EndIf16:
; Next i
_NextContinue14:
INC	 dword [v_i]
JMP	 _For13
_Next14:

Bon je vois qu'il y a une petite différence dans la façon de tester les égalités entre ta solution et celle du compilateur , je vais tester ça , merci