PureBasic

Forums PureBasic - Français
http://forums.purebasic.com/french/

Pathfinding A* tri par tas (mode console)+outils pour tas

http://forums.purebasic.com/french/viewtopic.php?t=11544

Page 1 sur 1

Pathfinding A* tri par tas (mode console)+outils pour tas

Publié : ven. 25/févr./2011 17:00
par Huitbit
Hello,

Voilà une première mouture, j'ai suivi le tutoriel du siteduzéro.
Pour les tas. Il s'agit en fait d'un tri partiel puisqu'on ne s'intéresse qu'au premier élément.
Pour simplifier les calculs, la liste à classer commence à l'index 1 au lieu de 0.
Ainsi pour un "père i", on a le "fils 2*i" et le "fils 2*i+1"
Inversement, pour des fils j, le père correspond à la division entière j / 2.

J'utilise les abréviations :
Cln : colonne
Lgn : ligne
Temp : temporaire

Pour l'instant, je ne gère pas le cas où les obstacles bouchent complètement le passage (le pc trace quand même quelque chose).

Code : Tout sélectionner

;PureBasic v.4.51
;Pathfinding
;Méthode A* avec tri par tas
;février 2011
;Auteur Huitbit

;-Déclarations 
Enumeration
  #Bordure = 11
  #Chemin 
  #ListeOuverte
  #ListeFermee
EndEnumeration

ClnDpt.b = 2
LgnDpt.b = 2
ClnArv.b =77
LgnArv.b =23
ClnTemp.b
LgnTemp.b
Index.w
IndexProvisoire.w
IndexMax.w 
IndexRR.w
IndexRT.w
ValeurF.w 
ValeurCln.b
ValeurLgn.b 

Structure carte
  f.w
  g.w
  h.w
  Tile.b
  Liste.b
  Clnparent.b
  Lgnparent.b
  PositionDansTas.w
EndStructure

Structure ListeOuverte
  Cln.b
  Lgn.b
  f.w
EndStructure

Dim carte.carte(79,24)
Dim ListeOuverte.ListeOuverte(79*24)

;-Macros
Macro H(c,l) 
(Abs(c-ClnArv)+Abs(l-LgnArv))*10 
EndMacro
 
Macro FormationTas(c,l)
IndexMax = IndexMax + 1
ListeOuverte(IndexMax)\f = carte(c,l)\f 
ListeOuverte(IndexMax)\Cln = c
ListeOuverte(IndexMax)\Lgn = l
IndexProvisoire = IndexMax

While  ListeOuverte(IndexProvisoire)\f < ListeOuverte(IndexProvisoire / 2)\f ; tant que le fils est plus petit que le père, échanger
  ValeurF = ListeOuverte(IndexProvisoire)\f 
  ValeurCln = ListeOuverte(IndexProvisoire)\Cln
  ValeurLgn = ListeOuverte(IndexProvisoire)\Lgn
  
  ListeOuverte(IndexProvisoire)\f  = ListeOuverte(IndexProvisoire / 2)\f 
  ListeOuverte(IndexProvisoire)\Cln  = ListeOuverte(IndexProvisoire / 2)\Cln 
  ListeOuverte(IndexProvisoire)\Lgn  = ListeOuverte(IndexProvisoire / 2)\Lgn 
  
  ListeOuverte(IndexProvisoire / 2)\f  = ValeurF
  ListeOuverte(IndexProvisoire / 2)\Cln  = ValeurCln
  ListeOuverte(IndexProvisoire / 2)\Lgn  = ValeurLgn
  IndexProvisoire = IndexProvisoire / 2 
Wend
EndMacro

Macro RemplacerReplacer (c,l)
For u = 0 To IndexMax
  carte(ListeOuverte(u)\Cln,ListeOuverte(u)\Lgn)\PositionDansTas = u ; correspondance des index entre la carte et la liste  
Next u 

IndexRR = carte(c,l)\PositionDansTas
ListeOuverte(IndexRR)\f = carte(c,l)\f 
ListeOuverte(IndexRR)\Cln = c
ListeOuverte(IndexRR)\Lgn = l

IndexProvisoire = IndexRR

While  ListeOuverte(IndexProvisoire)\f < ListeOuverte(IndexProvisoire / 2)\f ; tant que le fils est plus petit que le père, échanger
  ValeurF = ListeOuverte(IndexProvisoire)\f 
  ValeurCln = ListeOuverte(IndexProvisoire)\Cln
  ValeurLgn = ListeOuverte(IndexProvisoire)\Lgn
  
  ListeOuverte(IndexProvisoire)\f  = ListeOuverte(IndexProvisoire / 2)\f 
  ListeOuverte(IndexProvisoire)\Cln  = ListeOuverte(IndexProvisoire / 2)\Cln 
  ListeOuverte(IndexProvisoire)\Lgn  = ListeOuverte(IndexProvisoire / 2)\Lgn 
  
  ListeOuverte(IndexProvisoire / 2)\f  = ValeurF
  ListeOuverte(IndexProvisoire / 2)\Cln  = ValeurCln
  ListeOuverte(IndexProvisoire / 2)\Lgn  = ValeurLgn
  IndexProvisoire = IndexProvisoire / 2 
Wend

EndMacro 
Macro ReformerTas
  
ListeOuverte(1)\f =  ListeOuverte(IndexMax)\f
ListeOuverte(1)\Cln = ListeOuverte(IndexMax)\Cln
ListeOuverte(1)\Lgn = ListeOuverte(IndexMax)\Lgn

IndexRT = 1
IndexMax = IndexMax - 1

ValeurF = ListeOuverte(IndexRT)\f 
ValeurCln = ListeOuverte(IndexRT)\Cln
ValeurLgn = ListeOuverte(IndexRT)\Lgn

While IndexRT <= IndexMax / 2
  If Listeouverte(IndexRT)\f > Listeouverte(2*IndexRT)\f
    IndexProvisoire = 2*IndexRT
  EndIf
  
  If ListeOuverte(IndexRT)\f > Listeouverte(2*IndexRT+1)\f
    If Listeouverte(2*IndexRT+1)\f < Listeouverte(2*IndexRT)\f
      IndexProvisoire = 2*IndexRT + 1
    EndIf
  EndIf
  
  If IndexRT = IndexProvisoire
    Break
  EndIf
  
  ListeOuverte(IndexRT)\f = ListeOuverte(IndexProvisoire)\f 
  ListeOuverte(IndexRT)\Cln =ListeOuverte(IndexProvisoire)\Cln
  ListeOuverte(IndexRT)\Lgn =ListeOuverte(IndexProvisoire)\Lgn
  ListeOuverte(IndexProvisoire)\f = ValeurF
  ListeOuverte(IndexProvisoire)\Cln = ValeurCln
  ListeOuverte(IndexProvisoire)\Lgn = ValeurLgn
  IndexRT = IndexProvisoire
Wend

EndMacro

Macro exploration(dc,dl,distance)
  ; * Si la Case n'est pas dans la Liste ouverte ajoutez-là. 
  ;Définissez la case actuelle comme parent de cette case. Enregistrez le F, le G et le H de la case. 
If carte(ClnTemp + dc,LgnTemp + dl)\Tile = 0  
  
  If carte(ClnTemp + dc,LgnTemp + dl)\Liste = 0
    carte(ClnTemp + dc,LgnTemp + dl)\Liste = #ListeOuverte
    carte(ClnTemp + dc,LgnTemp + dl)\Clnparent = ClnTemp
    carte(ClnTemp + dc,LgnTemp + dl)\Lgnparent = LgnTemp
    carte(ClnTemp + dc,LgnTemp + dl)\g = carte(ClnTemp,LgnTemp)\g  + distance
    carte(ClnTemp + dc,LgnTemp + dl)\f = carte(ClnTemp + dc,LgnTemp + dl)\g  + H(ClnTemp + dc,LgnTemp  + dl)
    FormationTas(ClnTemp + dc,LgnTemp + dl) ; on ajoute une valeur au tas, il faut la ranger correctement
  EndIf
  
  ; * Si elle est déjà sur la Liste ouverte, vérifiez si un nouveau G sera plus faible. 
  ;   Si il est plus faible changez le parent de cette Case pour la Case courante et recalculez les scores F et G. 
  
  If carte(ClnTemp + dc,LgnTemp + dl)\Liste = #ListeOuverte
    If carte(ClnTemp,LgnTemp)\g  + distance < carte(ClnTemp + dc,LgnTemp + dl)\g 
      carte(ClnTemp + dc,LgnTemp + dl)\g = carte(ClnTemp,LgnTemp)\g  + distance
      carte(ClnTemp + dc,LgnTemp + dl)\f = carte(ClnTemp + dc,LgnTemp + dl)\g  + H(ClnTemp + dc,LgnTemp  + dl)
      carte(ClnTemp + dc,LgnTemp + dl)\Clnparent = ClnTemp
      carte(ClnTemp + dc,LgnTemp + dl)\Lgnparent = LgnTemp
      RemplacerReplacer(ClnTemp + dc,LgnTemp + dl) ; on modifie une valeur de f, il faut modifier le tas
    EndIf    
  EndIf
  
EndIf

EndMacro
;-décor
For Cln = 0 To 79
  For Lgn = 0 To 24
    If (Cln = 0) Or (Cln = 79) Or (Lgn = 0) Or (Lgn = 24)  
      carte(Cln,Lgn)\Tile = #Bordure
    Else
      carte(Cln,Lgn)\Tile = Random(10)
    EndIf
  Next Lgn
Next Cln

For Cln = 0 To 79
  For Lgn = 0 To 24
    If carte(Cln,Lgn)\Tile <> #Bordure And carte(Cln,Lgn)\Tile <> 1 
      carte(Cln,Lgn)\Tile = 0
    EndIf
  Next Lgn
Next Cln

;-ajout d'éléments dans le décor
For Cln = 1 To 78
  For Lgn = 3 To 23
    If Cln = 5 : carte(Cln,24-Lgn)\Tile = 1 : EndIf
    If Cln = 15 :carte(Cln,Lgn)\Tile = 1 : EndIf
    If Cln = 25 : carte(Cln,24-Lgn)\Tile = 1 : EndIf
    If Cln = 35 : carte(Cln,Lgn)\Tile = 1 : EndIf
    If Cln = 45 : carte(Cln,24-Lgn)\Tile = 1 : EndIf
    If Cln = 55 : carte(Cln,Lgn)\Tile = 1 : EndIf
  Next Lgn
Next Cln

carte(ClnArv,LgnArv)\Tile = 0 ;spécifique au mode console !
carte(ClnDpt,LgnDpt )\Tile = 0 ;spécifique au mode console !

  ;-étape n°1 ajout de la case de départ à la Liste ouverte 
ListeOuverte(1)\Cln = ClnDpt
ListeOuverte(1)\Lgn = LgnDpt
ListeOuverte(1)\f = H(ClnDpt,LgnDpt)
carte(ClnDpt,LgnDpt)\Liste = #ListeOuverte
carte(ClnDpt,LgnDpt)\PositionDansTas = 1
IndexMax = 1
  ;-étape n°2 boucle de recherche 
Repeat 
  ;-étape n°2.a choix case en cours 
  ;Repérer la Case avec le cout F le plus petit dans la Liste ouverte. Ce sera la Case actuelle. 
  ClnTemp =  ListeOuverte(1)\Cln
  LgnTemp =  ListeOuverte(1)\Lgn  
  ;-étape n°2.b passage de la case en cours à la Liste fermée 
  ;La mettre dans la Liste fermée. 
  carte(ClnTemp,LgnTemp)\Liste = #ListeFermee
  ReformerTas ; on a supprimé la "racine" du tas, il faut le réarranger
  
  
  ;-étape n°2.c  exploration des huit cases adjacentes 
  ;Pour chacune des huit cases adjacentes à la Case actuelle ... 
  
  exploration(1,0,10) ;case Est
  exploration(1,-1,14) ;case Nord-Est
  exploration(0,-1,10) ;case Nord
  exploration(-1,-1,14) ;case Nord-Ouest
  exploration(-1,0,10) ;case Ouest
  exploration(-1,1,14) ;case Sud-Ouest
  exploration(0,1,10) ;case Sud
  exploration(1,1,14) ;case Sud-Est
  
  ; Arrêtez-vous si : 
  ; * Vous ajoutez la Case d'arrivée à la Liste fermée ou si  la Liste ouverte est vide (dans ce cas il n'y a pas de solution). 
Until    carte(ClnArv,LgnArv)\Liste = #ListeFermee Or ListeOuverte(1)\f = 0 

;-3. enregistrement du Chemin(cas où il y a un Chemin) 
Repeat
  carte(ClnTemp,LgnTemp)\Tile = #Chemin
  ClnParent = carte(ClnTemp,LgnTemp)\Clnparent
  LgnParent = carte(ClnTemp,LgnTemp)\Lgnparent
  ClnTemp = ClnParent
  LgnTemp = LgnParent
Until   ClnTemp = ClnDpt And   LgnTemp = LgnDpt

carte(ClnArv,LgnArv)\Tile = 0;spécifique au mode console !
carte(ClnArv,LgnArv)\Liste = 0;spécifique au mode console !
carte(ClnDpt,LgnDpt )\Liste = 0;spécifique au mode console !

;-AFFICHAGE
If OpenConsole() ;(79*24)
  EnableGraphicalConsole(1)
  
  For Cln = 0 To 79
    For Lgn = 0 To 24
      ConsoleLocate(Cln,Lgn)   
      
      If   carte(Cln,Lgn)\Tile = 1 : ConsoleColor(6,0) : Print(Chr(79)) : EndIf
      If carte(Cln,Lgn)\Tile = #Bordure : ConsoleColor(8,0) : Print(Chr(35)) : EndIf
      If carte(Cln,Lgn)\Tile = #Chemin : ConsoleColor(14,0) : Print(Chr(42)) : EndIf
      If carte(Cln,Lgn)\Liste = #ListeOuverte : ConsoleColor(13,0) : Print(Chr(42)) : EndIf
      If carte(Cln,Lgn)\Liste = #ListeFermee : ConsoleColor(4,0) : Print(Chr(42)) : EndIf
      If (Cln = ClnDpt) And (Lgn = LgnDpt) : ConsoleColor(12,0) : Print(Chr(68)) : EndIf
      If (Cln = ClnArv) And (Lgn = LgnArv) : ConsoleColor(2,0) : Print(Chr(65)) : EndIf
      
    Next Lgn
  Next Cln
  
  ConsoleLocate(24, 0)
  PrintN("Appuyez sur [Entree] pour quitter ")
  Input()
EndIf

;-RECAPITULATIF
; 1) Ajouter la Case de départ à la Liste ouverte. 
; 
; 2) Répéter ce qui va suivre: 
; 
; a) Repérer la Case avec le cout F le plus petit dans la Liste ouverte. Ce sera la Case actuelle. 
; 
; b) La mettre dans la Liste fermée. 
; 
; c) Pour chacune des huit cases adjacentes à la Case actuelle ... 
; 
; * Si la Case est un obstacle ou est dans la Liste fermée ignorez-là. Sinon, faites ce qui suit. 
; * Si la Case n'est pas dans la Liste ouverte ajoutez-là. Définissez la case actuelle comme parent de cette case. Enregistrez le F, le G et le H de la case. 
; * Si elle est déjà sur la Liste ouverte, vérifiez si un nouveau G sera plus faible. 
;   Si il est plus faible changez le parent de cette Case pour la Case courante et recalculez les scores F et G. 
; 
; d) Arrêtez-vous si : 
; 
; * Vous ajoutez la Case d'arrivée à la Liste fermée ou si, 
; * La Liste ouverte est vide (dans ce cas il n'y a pas de solution). 
; 
; 3) Reconstituez le Chemin à partir des parents 
; --------------------------------------------------------------------------------
Il y a de quoi optimiser mais c'est déjà très rapide !
Exemple :
Comme j'en avais assez de transpirer avec les indices, j'ai choisi une méthode radicale. Comme c'est le seul moment où j'en avais besoin, je n'ai pas fait dans la finesse :mrgreen: !

Code : Tout sélectionner

For u = 0 To IndexMax
  carte(ListeOuverte(u)\Cln,ListeOuverte(u)\Lgn)\PositionDansTas = u ; correspondance des index entre la carte et la liste  
Next u
Si ça intéresse, je peux poster les petits codes de test que je me suis bricolé pour les opérations sur les tas.
[EDIT] "Ma caisse à outils" pour les tas ! [EDIT]

Code : Tout sélectionner

;auteur Huitbit
;février 2011
;pb 4.51
;Opérations sur un tas de dix éléments, père plus petit
Nombre.w
NouveauNombre.w
Index.b = 0
IndexProvisoire.b
IndexMax.b = 10
Dim Arbre.w (IndexMax)

OpenConsole()

;-Formation du tas
For i = 1 To IndexMax
  
  Index = Index + 1
  Arbre(Index) = 1 + Random(99) ; tirage au sort d'un Nombre entre 1 et 100
  IndexProvisoire = Index
  
  While  Arbre(IndexProvisoire) < Arbre(IndexProvisoire / 2) ; tant que le fils est plus petit que le père, échanger (la valeur "remonte" vers la racine)
    
    ;échange des valeurs fils-père, Nombre sert de variable d'échange
    Nombre = Arbre(IndexProvisoire)
    Arbre(IndexProvisoire) = Arbre(IndexProvisoire / 2)
    Arbre(IndexProvisoire / 2) = Nombre
    
    IndexProvisoire = IndexProvisoire / 2 
    
  Wend
  
  ; Affichage
  For j = 1 To IndexMax
    Print(Str(Arbre(j)) + " / ")
  Next j
  PrintN("")
  
Next i
PrintN("Fin de la formation du tas")
PrintN("********************************")

;-Reformer  le tas après suppression du père
PrintN("Reformer le tas apres suppression de la racine " + Str(Arbre(1)))
Arbre(1) = Arbre (IndexMax) ;on "écrase" la racine avec la dernière branche de l'Arbre
IndexMax = IndexMax - 1 ; On ne tient plus compte de la case de l'ex-dernière branche
Index = 1 ; nouvel Index provisoire  de l'ex-dernière branche

While Index  <= Indexmax / 2 ;tant que Arbre(index)  a un fils, 
  
  If Arbre(Index) > Arbre(2*Index)
    IndexProvisoire = 2*Index
  EndIf
  
  If Arbre(Index) > Arbre(2*Index+1)
    
    If Arbre(2*Index+1) < Arbre(2*Index)
      
      IndexProvisoire = 2*Index + 1
    EndIf
  EndIf
  If Index = IndexProvisoire ; s'il n'y a aucun changement, en sort de la boucle
    Break
  EndIf
  
  Nombre = Arbre(Index) 
  Arbre(Index) = Arbre(IndexProvisoire) 
  Arbre(IndexProvisoire) = Nombre
  Index = IndexProvisoire
  
Wend

; Affichage
PrintN("Tas reforme")
For j = 1 To IndexMax
  Print(Str(Arbre(j))+ " / ")
Next j
PrintN("")
PrintN("********************************")
;-Remplacer puis replacer une valeur inférieure au bon endroit dans le tas précédent
NouveauNombre =Arbre(5) / (2 + Random(1))
Print("On remplace Arbre(5)=" + Str(Arbre(5))+" par "+Str(NouveauNombre))
Arbre(5) = NouveauNombre

IndexProvisoire = 5

While  Arbre(IndexProvisoire) < Arbre(IndexProvisoire / 2) ; tant que le fils est plus petit que le père, échanger
  Nombre = Arbre(IndexProvisoire)
  Arbre(IndexProvisoire) = Arbre(IndexProvisoire / 2)
  Arbre(IndexProvisoire / 2) = Nombre
  IndexProvisoire = IndexProvisoire / 2 
Wend

;Affichage
PrintN("")
For j = 1 To IndexMax
  Print(Str(Arbre(j))+" / ")
Next j
PrintN("")


Input()
  
CloseConsole()
End


Hasta la vista !
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru