PureBasic

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

Anomalies Pathfinding sur pavage Hexagonal i _ i

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

Page 1 sur 1

Anomalies Pathfinding sur pavage Hexagonal i _ i

Publié : dim. 22/juin/2008 20:03
par Ouaf-Ouaf
Lut !

Alors voualà, j'essaye toujours d'adapter un code de Huitbit pour le pavage Hexagonal.. Resultat... Le chemin est parfois totalement erroné !

J'arrive pas a comprendre le principe du "bug"

J'ai commencé par creer une macro pour l'explo des cases adjacentes, c'est là que le problème devrait se situer ? Où alors l'heuristique Manathan ne correspond tout simplement pas à un pavage Hexa ?

Au fond ce doit pas être bien sorcier.. Le truc c'est que quand une ligne est sur un Y impaire, la ligne est decalée d'une "case" en X.

Dans certains cas ça marche.. Dans d'autres, d'une case X à sa case adjacente, le chemin monte jusqu'aux bords de la map.. Pour redescendre vers son but.. o.o

J'vais essayer de faire des tests pas à pas ... Mais vraiment c'est rilou... Je sais pas si quelqu'un d'avisé dans la manipulation des chiffres comprendrait simplement le problème ? Moi je suis dans le flou


L'explo des cases adjacentes est appelée donc 6 fois des lignes 196 à 214.

ReMap() sert à reinitialiser la carte (supprimer le chemin quoi) et à placer les cases occupées par les unitées.

Pour les Tiles, ce fichier doit être placé à côté de la source sous "Tilez.png" :

Image




Code : Tout sélectionner

InitSprite():InitKeyboard():InitMouse()


If OpenWindow(0,0,0,1024,768,"Ankhmatov",#PB_Window_MinimizeGadget | #PB_Window_ScreenCentered) 
If OpenWindowedScreen(WindowID(0),0,0,1024,768,1,0,0)

UsePNGImageDecoder()

LoadSprite(70,"tilez.png")  :  TransparentSpriteColor(-1,RGB(0,0,0))

CopySprite(70,71)
CopySprite(70,72)
CopySprite(70,73)
CopySprite(70,0)

ClipSprite(70,0,0,66,32)  : #Unite = 70
ClipSprite(71,0,32,66,32) : #Mur   = 71
ClipSprite(72,0,64,66,32) : #Actif = 72
ClipSprite(73,0,96,66,32) : #Chemin = 73
ClipSprite(0,0,128,44,44)




LoadSprite(0,"Interface\Mouse.bmp")  :  TransparentSpriteColor(0,RGB(255,0,255))

LoadFont (0, "Myriad", 12, #PB_Font_Bold   )
LoadFont (1, "Myriad",  8, #PB_Font_Bold   )
LoadFont (2, "Lucida", 42, #PB_Font_Italic )
LoadFont (3, "Myriad", 8)


Else : MessageRequester("Erreur", "Impossible d'ouvrir une fenetre") : End : EndIf
Else : MessageRequester("Erreur", "Impossible d'ouvrir une fenetre") : End : EndIf 






;{ Structures
Structure Struc
Unite.w[2]
sol.b[2]
mur.b
id.w
parent.w
f.w
g.w
list.b
EndStructure

Structure liste
  id.w
  f.w
EndStructure
;}

 Define.w k, position
 
#List_Unit   = 5
#list_chemin = 4
#list_open   = 1
#list_closed = 2
#list_mur    = 3

Enumeration
  #spr_ecran
  #spr_decor
  #spr_mur
  #spr_depart
  #spr_arrivee
  #spr_souris
EndEnumeration

#x_max=16
#y_max=29


  
Macro Explo_Hexa( x_temp, y_temp, i, j )

        VarG.f = 1  
               
        If map(x_temp+i + DecalX ,y_temp+j)\list    = 0
           map(x_temp+i + DecalX ,y_temp+j)\parent  = map(x_temp,y_temp)\id
           map(x_temp+i + DecalX ,y_temp+j)\g       = map(x_temp,y_temp)\g + VarG 
           map(x_temp+i + DecalX ,y_temp+j)\f       = manhattan(x_temp+i+ DecalX,y_temp+j)+map(x_temp+i+ DecalX,y_temp+j)\g
           map(x_temp+i + DecalX ,y_temp+j)\list    = #list_open
           
            position=position+1
            
           liste_ouverte(position)\f      = map(x_temp+i + DecalX,y_temp+j)\f
           liste_ouverte(position)\id     = map(x_temp+i + DecalX,y_temp+j)\id
           
            ajout_dans_liste_ouverte(position)
           
        ElseIf map(x_temp+i + DecalX ,y_temp+j)\list = #list_open
        
             If map(x_temp+i + DecalX, y_temp+j)\g      > map(x_temp,y_temp)\g + VarG ;+ Abs((i+DecalX)*j)*4 
                map(x_temp+i + DecalX, y_temp+j)\parent = map(x_temp,y_temp)\id
                map(x_temp+i + DecalX, y_temp+j)\g      = map(x_temp,y_temp)\g + VarG 
                map(x_temp+i + DecalX, y_temp+j)\f      = manhattan(x_temp+i+DecalX, y_temp+j) + map(x_temp+i + DecalX, y_temp+j)\g
             EndIf
           
        EndIf         

EndMacro

Macro Manhattan( x, y )
  resultat_manhattan.w = ( Abs(x - x_arrivee) + Abs(y - y_arrivee) ) *10
  ;resultat_manhattan.w = Round( Sqr( Pow( x - x_arrivee,2 ) + Pow( y - y_arrivee,2 ) ), 1 )            
EndMacro

;construction du tas****************
Macro ajout_dans_liste_ouverte(p)
  k.w=p
  f_a_placer.w =liste_ouverte(p)\f
  id.w=liste_ouverte(p)\id
  While k>=(position_premier_element+1)   And f_a_placer< liste_ouverte(Int(k*0.5))\f
  
    liste_ouverte(k)\f   = liste_ouverte(Int(k*0.5))\f
    liste_ouverte(k)\id  = liste_ouverte(Int(k*0.5))\id
   
    k=Int(k*0.5)
  Wend
  liste_ouverte(k)\f=f_a_placer
  liste_ouverte(k)\id=id
 
EndMacro

;remaniement du tas après suppression de la racine************************
Macro reformer_tas(p)
  travail.b  = 0; 0 : en cours, 1 : effectué
  k.w        = position_premier_element
 
  f_a_replacer.w = liste_ouverte(position_premier_element)\f
  id.w           = liste_ouverte(position_premier_element)\id
  While travail=0 And 2*k<=p
    If 2*k =p
      indice_grand.w=p
    Else
      If liste_ouverte(2*k)\f<=liste_ouverte(2*k+1)\f
        indice_grand=2*k
      Else
        indice_grand=2*k+1
      EndIf
    EndIf   
   
    If f_a_replacer       > liste_ouverte(indice_grand)\f
      liste_ouverte(k)\f  = liste_ouverte(indice_grand)\f   
      liste_ouverte(k)\id = liste_ouverte(indice_grand)\id
      k=indice_grand
    Else
      travail=1
    EndIf
  Wend
  liste_ouverte(k)\f  = f_a_replacer
  liste_ouverte(k)\id = id 
EndMacro

  ;recherche du chemin*******************************
Macro pathfinding( x,y )

  f_min.w    = manhattan(x,y) ; Distance minimum si aucun chemin n'est trouvé
  id_f_min.w = map(x,y)\id
 
  ;étape n°1 ajout de la case de départ à la liste ouverte
  liste_ouverte(1)\id = map(x,y)\id
  liste_ouverte(1)\f  = manhattan(x,y)
  map(x,y)\list       = #list_open
 
  ;étape n°2 boucle de recherche
  position.w               = 1
  position_premier_element = 1
 
  Repeat
   
    ;étape n°2.a choix case en cours   
    x_temp.b = liste_ouverte(position_premier_element)\id       % #x_max
    y_temp.b = Int( liste_ouverte(position_premier_element )\id / #x_max )
    
   
    ;étape n°2.b passage de la case en cours à la liste fermée
    map(x_temp,y_temp)\list                   = #list_closed
    liste_ouverte(position_premier_element)\f = 0       
    position_premier_element                  = position_premier_element+1
       
    Swap liste_ouverte(position_premier_element)\f , liste_ouverte(position)\f
    Swap liste_ouverte(position_premier_element)\id, liste_ouverte(position)\id
    
    reformer_tas(position)
   
   
    ;étape n°2.c  exploration des six cases adjacentes 
    
;Y = 0
DecalX = 0
For i = -1 To 1
Explo_Hexa(x_temp,y_temp, i, 0)  
Next
   

    If y_temp %2 ;Impaire
    DecalX = - 1
    Else
    DecalX = 0
    EndIf

    For i = 0 To 1
    Explo_Hexa( x_temp,y_temp, i, -1 )  
    Explo_Hexa( x_temp,y_temp, i,  1 )  
    Next i   
 
 
    
    ;sauvegarde du f_min de la carte au cas où il n'y ait pas de chemin possible
    If  map(x_temp,y_temp)\f<f_min And map(x_temp,y_temp)\f<>0
      f_min   = map(x_temp,y_temp)\f
      id_f_min= map(x_temp,y_temp)\id   
    EndIf
    
  Until     map( x_arrivee, y_arrivee )\list=#list_closed Or liste_ouverte(position_premier_element)\f=0 
 
  ;3. enregistrement du chemin
  x_parent.b=0
  y_parent.b=0
  
  ;3.a. cas où il y a un chemin
  If x_temp = x_arrivee And y_temp = y_arrivee
      
    Repeat
      map(x_temp,y_temp)\list = #list_chemin 
      
      Chemun(VarW,1) = y_temp
      Chemun(VarW,0) = x_temp
      
      x_parent  = map(x_temp,y_temp)\parent     % #x_max
      y_parent  = Int(map(x_temp,y_temp)\parent / #x_max)
      x_temp    = x_parent
      y_temp    = y_parent   
      VarW      = VarW + 1
      
    Until  map(x_temp,y_temp)\parent = 0 
  
  
  
  ;3.b. chemin le plus proche
  Else : x_temp = id_f_min % #x_max : y_temp = Int(id_f_min/#x_max)
 
    Repeat
      map(x_temp,y_temp)\list = #list_chemin ;+ A
 
      Chemun(VarW,1) = y_temp
      Chemun(VarW,0) = x_temp
           
      x_parent = map(x_temp,y_temp)\parent     % #x_max
      y_parent = Int(map(x_temp,y_temp)\parent / #x_max)
      x_temp   = x_parent
      y_temp   = y_parent
      VarW     = VarW + 1
         
    Until  map(x_temp,y_temp)\parent = 0 
   
  EndIf
 
 
EndMacro

Macro ReMap( )
Dim map.struc(#x_max,#y_max)


For A = 0 To #y_max 
Map(0,A)\mur = 1
Map(0,A)\list=#list_mur
        
Map(#x_max-1,A)\mur = 1
Map(#x_max-1,A)\list=#list_mur      
Next A

 
For A = 0 To #x_max - 1
Map(A,0)\Mur = 1      
Map(A,0)\list=#list_mur      
      
Map(A,#y_max)\Mur = 1      
Map(A,#y_max)\list=#list_mur       
Next a      
     

For A = 1 To 5
Map(Unit( A, 0 ) , Unit( A, 1 ) ) \Unite[0]  = A
Map(Unit( A, 0 ) , Unit( A, 1 ) ) \Unite[1]  = A * 100
If A <> UnitS



For x = -1 To 1
Map( Unit(A,0)+x, Unit(A,1) )\Mur   = 2
Map( Unit(A,0)+x, Unit(A,1) )\list  = #list_unit 
Next X

If Unit(A,1) % 2 ;Impaire
Decal = - 1
Else
Decal = 0
EndIf

    For x = 0 To 1
      Map( Unit(A,0)+x+Decal, Unit(A,1)-1 )\Mur   = 2
      Map( Unit(A,0)+x+Decal, Unit(A,1)-1 )\list  = #list_unit 

      Map( Unit(A,0)+x+Decal, Unit(A,1)+1 )\Mur   = 2
      Map( Unit(A,0)+x+Decal, Unit(A,1)+1 )\list  = #list_unit 
    Next x





EndIf

Next A


     
k = 0
      
For b=0 To #y_max 
For A=0 To #x_max  - 1  
Map(A,B)\id = k 
k + 1
Next
Next
EndMacro 





Dim Map.Struc(64, 64)
Dim liste_ouverte.liste((#x_max-1)*(#y_max-1))
Dim Unit(12,1)
Dim Chemun(50,1)

Unit(1,0) = 12 : Unit(1,1) = 17
Unit(2,0) = 13 : Unit(2,1) = 23
Unit(3,0) = 13 : Unit(3,1) = 11 
Unit(4,0) = 14 : Unit(4,1) = 20
Unit(5,0) = 14 : Unit(5,1) = 14

UnitS = 4


ReMap()





;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

;-@@@@@       Display      @@@@@

Repeat
;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    Repeat                                                    ; Pour OpenWindow
      Event = WindowEvent()
      
      
      
    Until Event = 0 
;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@    

ClearScreen(RGB(0,0,0))


;{     ;>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> CURSEURS   
     


  
  ;{ >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> Heros Actif   
    
      X = Unit( Units, 0 )
      Y = Unit( Units, 1 )
      
        If (Y) %2
        Focus_X = (X * 66) - 33 
        Else
        Focus_X = (X * 66) 
          
        EndIf : Focus_Y = (Y * 24) ; - 205
      
        Focus_X + MovX
        Focus_Y + MovY
      
        DisplaySprite(#Actif,Focus_X,Focus_Y)       
                
               
  ;}
  
  ;{ >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> La souris


        Y       = Round( MouseY/24, 0)   
        Focus_Y = (Y * 24)

        If (Y) %2 ; impaire
          X       = Round( (MouseX-33)/66, 0)   
          Focus_X = (X * 66) +33 
          X = X + 1 
        Else     ; paire
           X       = Round( (MouseX)/66, 0)  
           Focus_X = (X * 66)    
        EndIf    
        
        Var_X = X : Var_Y = Y
        
      


;}     
  
  ;{ >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> Le chemin
 
   
    For Z = 0 To VarW - 1
    
        Y       = Chemun(Z,1)   
        Focus_Y = (Y * 24)

        If (Y) %2 ; impaire
          X       = Chemun(Z,0)  
          Focus_X = (X * 66) -33 
        Else     ; paire
           X       = Chemun(Z,0)  
           Focus_X = (X * 66)    
        EndIf      
    

;>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
;{

DisplayTransparentSprite(#Chemin,Focus_X,Focus_Y)  

      StartDrawing( ScreenOutput() )
        DrawingBuffer      = DrawingBuffer()
        DrawingBufferPitch = DrawingBufferPitch()

        DrawingMode (1)
        FrontColor ( RGB (255,255,255))                  
  
          DrawingFont(FontID(3))
          DrawText(Focus_X,Focus_Y,    "F :"+Str( Map(X,Y)\f ) )  
          DrawText(Focus_X,Focus_Y+12, "G :"+Str( Map(X,Y)\g ) )  
   
   StopDrawing()
 
    Next Z




                    

;}

;{     >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> CHEMIN
If Chemin = 0 And Move = 0

ReMap()

X_Dep    = Unit(UnitS,0)
Y_Dep    = Unit(UnitS,1)

Y_Arrivee = Var_Y
X_Arrivee = Var_X

VarW = 0

Dim liste_ouverte.liste((#x_max-1)*(#y_max))

pathfinding( X_Dep, Y_Dep )

Old_X = Var_X
Old_Y = Var_Y

Chemin = 1

EndIf
;}

;{ >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> MILICIENS
For Y = 0 To #y_max : For X = 0 To #x_max - 1


        If (Y) %2
        Focus_X = (X * 66) - 33 
        Else
        Focus_X = (X * 66) 
          
        EndIf : Focus_Y = (Y * 24)
        
        
                 Select Map(X,Y)\list
                 
                        Case #list_mur    :   DisplayTransparentSprite( 70, Focus_X , Focus_Y )
                        Case #list_unit   :   DisplayTransparentSprite( 71, Focus_X , Focus_Y )

                 EndSelect
     

Next X : Next Y  
;}
                               ; Menu combat
DisplayTransparentSprite(0,MouseX,MouseY) ; souris

FlipBuffers(0)





If Var_X <> Old_X Or Var_Y <> Old_Y  :  : Chemin = 0 : EndIf



;{ Mouse
;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
ExamineMouse()

  If MouseDeltaX()<>0 : mouseX = mouseX+ MouseDeltaX() 
  If MouseX > 1024 : MouseX = 1024 : EndIf : If MouseX < 1 : MouseX = 1 : EndIf    
  EndIf
  
  If MouseDeltaY()<>0 : mouseY = mouseY+ MouseDeltaY() 
  If MouseY > 768 : MouseY = 768 : EndIf : If MouseY < 1 : MouseY = 1 : EndIf  
  EndIf
  




;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
If MouseButton(1)

If VarW-1 > 0
        Y       = Round( MouseY/24, 0)   
        Focus_Y = (Y * 24)

        If (Y) %2 ; impaire
          X       = Round( (MouseX-33)/66, 0)   
          Focus_X = (X * 66) +33 
          X = X + 1 
        Else     ; paire
           X       = Round( (MouseX)/66, 0)  
           Focus_X = (X * 66)    
        EndIf    
        
        NewX = X : NewY = Y

Move = 1 : DestX = 0 : DestY = 0 : BougeX = 0 : BougeY = 0
Animtime  = ElapsedMilliseconds()
Chrono    = ElapsedMilliseconds()

Etape = VarW-1
EndIf


EndIf
;}


If Move = 1
;{ -move
;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@


Map( Unit( UnitS, 0 ), Unit( UnitS, 1 ) )\Unite[0] = 0
Map( Unit( UnitS, 0 ), Unit( UnitS, 1 ) )\Unite[1] = 0

Unit( UnitS, 0 ) = Chemun( 0, 0 )
Unit( UnitS, 1 ) = Chemun( 0, 1 )

Map( Unit( UnitS, 0 ), Unit( UnitS, 1 ) )\Unite[0] = UnitS
Map( Unit( UnitS, 0 ), Unit( UnitS, 1 ) )\Unite[1] = UnitS * 100

EtapeANim = 0
Chemin    = 0
Move      = 0 


;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
EndIf
;}




ExamineKeyboard()
Until KeyboardPushed(#PB_Key_Escape)


:cry:

Bon j'ai re-extirpé l'algo du code donc y a ptet des chelouteries içi ou là, mais ça ne concerne pas l'algo..

Publié : dim. 22/juin/2008 20:53
par Huitbit
Hello!
Ce phénomène s'observe également avec des cases carrées.
N'oublie pas que la méthode te propose un chemin "pas trop mal", pas LE MEILLEUR CHEMIN !
(je n'arrive pas à avoir des cas aussi extrêmes que toi avec ton code, les chemins trouvés restent corrects)
Cette méthode est un compromis entre efficacité et rapidité !
Tu as peut-être raison, le calcul de l'heuristique est peut-être responsable de ces anomalies.


En tout cas l'adaptation du code pour des tiles hexagonales est intéressante.

Hasta la vista.

Publié : dim. 22/juin/2008 21:24
par Ouaf-Ouaf
J'ai quand même des chemins trés etranges, que l'algo de comtois par exemple me donne jamais ( j'prends ça en exemple par ce qu'on peux changer la map dynamiquement ).

J'ai ce genre d'anomalies quoi : (!)
Image

Je vais m'interresser de plus près à Djikstra, car mes map sont vraiment petites. pi à vue du nombre reduit de tiles, la precision prends d'autan plus d'importance.

( map de 16*29, avec une dixaine de pts d'actions par tour )

Publié : dim. 22/juin/2008 21:42
par Huitbit
Hello
A ta place, j'aurais plus confiance en l'algo de Comtois !
Ca pourrait t'éviter le Djikstra.


A la base le mien était fait avec les listes chaînées.
J'ai fait le tris par tas un peu à la légère :oops: pour pouvoir comparer avec les listes chaînées.
Dès que j'ai eu des résultats( tri par tas plus rapide), je n'ai pas été chercher plus loin !
Maintenant que tu as compris le principe du pathfinding, modifies la partie "tri" !

Ciao
Fuseau horaire sur UTC+01:00
Page 1 sur 1

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

Traduction française officielle © Qiaeru