Pathfinding , nouvelle version

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Répondre
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :
Contacter Thyphoon

Message par Thyphoon »

donc Noeud(NoeudID)\G pour la distance a vol d'oiseau et Noeud(NoeudID)\H pour la distance réeel c'est bien ça ?
Haut
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :
Contacter Thyphoon

Message par Thyphoon »

J'ai essayé de rajouter dans la recherche de chemin des zones de Danger
de façon que le chemin essaye de s'éloigner jusqu'a une certaine distance de ce danger ...
voici le code que j'ai modifier... Avec la touche CTRL+bouton de souris on peut rajouter ou retirer un Danger !
Qu'en pensez-vous ? Si quelqu'un a une idée pour optimiser !! Ou encore si il y a des bugs. J'ai essayé de garder la façon de présenter de Comtois

Code : Tout sélectionner

; ************************************************************
; ** Comtois le 17/07/05 - Pathfinding pour Purebasic V0.5  **
; ** Tentative de rajout de Danger Part Thyphoon le 25/03/07**
; ************************************************************
; PB4.0

; **********************************************************************
; ************************** 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 **
; ** Touche [F8] Sans/Avec recherche du point le plus proche si l'accès à la cible n'est pas possible **
; ** Touche [F9] Sans/Avec Remplissage >> Visualise la zone de déplacement possible à partir de Départ**
; ** 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 **
; ** Bouton Gauche de la souris + la Touche [Crtl] Rajoute un Danger **
; ** Bouton Droit de la souris + la touche [Ctrl] Supprimer un Danger **
; **********************************************************************


; --- Initialisation ---
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
    MessageRequester("Erreur", "Impossible d'initialiser DirectX 7 Ou plus", 0)
    End
EndIf
LoadFont (1, "Arial", 7)
; --- 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,Chrono,ChronoMax,diagonale
Global Remplissage,Proche,LePlusProche.point,Destination.point

diagonale=1
affPath=1
AffGrille=1

; --- dimension du tableau et taille d'une case ---
#max_x=15
#max_y=15
#max_x1=#max_x+1
#taille=32
#NbZoneDangerMax=10

; --- 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 MapTest(#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))

Global Dim ZoneDanger.Point(#NbZoneDangerMax)
Global NbZoneDanger=0

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

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

; ************************************************************************************
; *** LES PROCEDURES ***
; ************************************************************************************
Procedure SauveMap()
    If CreateFile(0,"PathFindingMap.map")
        WriteLong(0,ciblex)
        WriteLong(0,cibley)
        WriteLong(0,departx)
        WriteLong(0,departy)
       
        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")
        ciblex=ReadLong(0)
        cibley=ReadLong(0)
        departx=ReadLong(0)
        departy=ReadLong(0)
        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 danger()
  Couleur=RGB(0,255,0)
  StartDrawing(ScreenOutput())
    For z=1 To NbZoneDanger
      Circle(ZoneDanger(z)\x*#taille + #taille/2,ZoneDanger(z)\y*#taille + #taille/2,#taille/2,Couleur)
    Next
  StopDrawing()
EndProcedure

Procedure.l CalculDanger(x.l,y.l)
  Danger=-1
  For z=1 To NbZoneDanger
    Vx=Abs(ZoneDanger(z)\x-x)
    Vy=Abs(ZoneDanger(z)\y-y)
    Tmp_Danger=Vx+Vy
    If Tmp_Danger<Danger Or Danger=-1
      Danger=Tmp_Danger
    EndIf
  Next
  If Danger>10 ; Nombre de case ou le danger est concidéré comme n'étant pas dangereurx
    Danger=0
  Else
    Danger=10-Danger
  EndIf
  ProcedureReturn Danger*10
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 : " + Str(diagonale))
   
     lig + 20
    DrawText(#taille*(#max_x+1),lig,"[F8] Sans/Avec proche : " + Str(Proche))
     
    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,"[Bouton Gauche] + [Ctrl] Rajoute un Danger")
   
     lig + 20
    DrawText(#taille*(#max_x+1),lig,"[Bouton Droit] + [Ctrl] Supprime un Danger")
   
     lig + 20
    DrawText(#taille*(#max_x+1),lig,"Position : " + Str(MouseX()/#taille) + " / " + Str(MouseY()/#taille))   
   
     lig + 20
    DrawText(#taille*(#max_x+1),lig,"Temps : " + Str(Chrono) + " / " + Str(ChronoMax))
   
    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()
    ;Debug "Dx:"+Str(departx)+" Dy:"+Str(departy)+" Cx:"+Str(ciblex)+" CY:"+Str(cibley)
    ;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=Destination\x And departy=Destination\y
        ProcedureReturn 0
    EndIf
   
    ;Calcul Un ID unique pour le Noeud en cours
    NoeudID = departx
    NoeudID + #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
                ;Conditions de validité d'une case
                If a >= 0 And a <= #max_x And b >= 0 And b <= #max_y And (diagonale=1 Or a = x Or b = y) And (a = x Or b = y Or map(a,y)=0 Or map(x,b)=0)
                   
                    ;Calcul un ID unique
                    TempID = a
                    TempID + #max_x1 * b
                   
                    ; ---- si la Case est libre et n'a pas encore été traitée
                    If map(a,b) = 0 And Noeud(TempID)\Closed = 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 = 14 + Noeud(NoeudID)\G ;
                        Else
                            G = 10 + Noeud(NoeudID)\G ;
                        EndIf
                       
                       
                        ; si la Case n'est pas dans la liste open ou si est meilleur en passant par cette case
                        If Noeud(TempID)\Open = 0 Or G < Noeud(TempID)\G
                           
                            parent(a,b)\x = x
                            parent(a,b)\y = y
                            Noeud(TempID)\G = G
                            Noeud(TempID)\H = (Abs(ciblex-a) + Abs(cibley-b))*10
                            ;-Thyphoon Modif
                            Noeud(TempID)\f = Noeud(TempID)\G + Noeud(TempID)\H+CalculDanger(x,y)
                                                       
                            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
                                Position = Taille_Tas
                               
                            Else
                               
                                ;Cherche la position du Noeud dans le tas
                                For i = 1 To Taille_Tas
                                    If Tas(i)=TempID
                                        Position = i
                                        Break
                                    EndIf
                                Next i
                               
                            EndIf
                           
                            ;Retasse le tas à partir du Noeud en cours
                            While Position <> 1
                                If Noeud(Tas(Position))\f <= Noeud(Tas(Position/2))\f
                                    temp = Tas(Position/2)
                                    Tas(Position/2) = Tas(Position)
                                    Tas(Position) = temp
                                    Position = Position/2
                                Else
                                    Break
                                EndIf
                            Wend
                           
                            ; --- la cible est trouvée ---
                            If a = Destination\x And b = Destination\y
                                fin = 1
                                Break 2
                            EndIf
                        EndIf
                    EndIf
                EndIf
            Next b
        Next a
    Wend
    ProcedureReturn fin
EndProcedure

Procedure souris(ToucheShift,ToucheCtrl)
    If ExamineMouse()
        SX = MouseX() / #taille
        SY = MouseY() / #taille
        If SX >= 0 And SX <= #max_x And SY >= 0 And SY <= #max_y
            
            If ToucheCtrl=1
                
                If MouseButton(1) And NbZoneDanger<#NbZoneDangerMax
                    NbZoneDanger=NbZoneDanger+1
                    ZoneDanger(NbZoneDanger)\x=SX
                    ZoneDanger(NbZoneDanger)\y=SY 
                    Delay(100) 
                ElseIf MouseButton(2) And NbZoneDanger>0
                    NbZoneDanger-1
                    Delay(100)
                EndIf
            ElseIf ToucheShift = 1
                If MouseButton(1)
                  If map(SX,SY)=0
                     ciblex = SX : cibley = SY ; place la cible
                  EndIf   
                ElseIf MouseButton(2)
                  If map(SX,SY)=0
                    departx = SX : departy = SY ; place le départ
                  EndIf 
                EndIf
            Else
                If MouseButton(1)
                    map(SX,SY)=1 ;place un mur
                ElseIf MouseButton(2)
                    map(SX,SY)=0 ; supprime un Mur
                EndIf
            EndIf
        EndIf
    EndIf
EndProcedure
Procedure AffRemplissage()
    Couleur=RGB(85,85,85)
    StartDrawing(ScreenOutput())
    For y=0 To #max_y
        For x=0 To #max_x
            xa=x*#taille
            ya=y*#taille
            Id = x + (#max_x+1)*y
            If MapTest(x,y)=2
                Box(xa + 1,ya + 1,#taille - 1,#taille - 1,Couleur)
            EndIf
        Next x
    Next y
    StopDrawing()
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_x+1)*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
             DrawingMode(#PB_2DDrawing_Transparent) 
             DrawingFont(FontID(1))  
            DrawText(xa + 3, ya + 1, "f="+Str(Noeud(Id)\f))
            DrawText(xa + 3, ya + 10, "h="+Str(Noeud(Id)\h))
            DrawText(xa + 3, ya + 19, "D="+Str(CalculDanger(x,y)))
        Next x
    Next y
    StopDrawing()
EndProcedure
Procedure affPath()
   
    Couleur=RGB(255,0,0)
    tps=ElapsedMilliseconds()
    Destination\x = ciblex
    Destination\y = cibley
    If ChercheChemin()=1
        Chrono=ElapsedMilliseconds()-tps
        If Chrono>ChronoMax
            ChronoMax=Chrono
        EndIf   
        a=-1
        b=-1
       
        cx=Destination\x
        cy=Destination\y
       
        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
        ;Circle(Destination\x*#taille+#taille/2,Destination\y*#taille+#taille/2,#taille/2,Couleur)
        StopDrawing()
    ElseIf Proche
 
         
       BestF = #max_y * #max_x * 2
       BestG = BestF
       For y=0 To #max_y
         For x=0 To #max_x
            Id = x + (#max_x+1)*y
            If Noeud(Id)\Open
               If Noeud(Id)\f > 0 And (Noeud(Id)\f < BestF Or((Noeud(Id)\f = BestF) And Noeud(Id)\h < BestH))
                  BestF = Noeud(Id)\f
                  BestH = Noeud(Id)\h
                  cx=x
                  cy=y
               EndIf
               
            EndIf
         Next x
      Next y
      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
        ;Circle(Destination\x*#taille+#taille/2,Destination\y*#taille+#taille/2,#taille/2,Couleur)
        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
        ElseIf KeyboardReleased(#PB_Key_F2)
            affPath=1-affPath
        ElseIf KeyboardReleased(#PB_Key_F3)
            SauveMap()
        ElseIf KeyboardReleased(#PB_Key_F4)
            ChargeMap()
        ElseIf KeyboardReleased(#PB_Key_F5)
            AffGrille=1-AffGrille
        ElseIf KeyboardReleased(#PB_Key_F6)
            EffaceMur()
        ElseIf KeyboardReleased(#PB_Key_F7)
            diagonale=1-diagonale
        ElseIf KeyboardReleased(#PB_Key_F8)
            Proche=1-Proche
           EndIf
        ToucheShift = KeyboardPushed(#PB_Key_LeftShift) Or KeyboardPushed(#PB_Key_RightShift)
        ToucheCtrl = KeyboardPushed(#PB_Key_LeftControl) Or KeyboardPushed(#PB_Key_RightControl)
    EndIf
    ;/ Gestion de la souris
    souris(ToucheShift,ToucheCtrl)
   

   
    mur()

    If AffGrille
        AffGrille()
    EndIf
    AffCadre()
    If AffOpenClosed
        AffOpenClosed()
    EndIf
   
    ;/Lance la recherche
    If affPath
        affPath()
    Else
        ChronoMax=0
    EndIf
        danger()
    ;/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
Haut
Avatar de l’utilisateur
Huitbit
Messages : 940
Inscription : jeu. 08/déc./2005 5:19
Localisation : Guadeloupe

C'est chaud!

Message par Huitbit »

Image
La petite boule n'a peur de rien!

Un option sur les dimensions de la grille ça serait cool (20*20=400 cases ; 50*50=2500 cases ; 64*64=4096...le nombre de cases augmente très vite!) parce que sur une grille 20*20, le temps sera toujours inférieur à 1 ms :? (en fait c'est presque une commande! En effet je pourrai savoir quand "mon" pathfinding sera passé du lambi à la mangouste :lol: !)

Hasta la vista!
Dernière modification par Huitbit le lun. 02/avr./2007 15:14, modifié 1 fois.
Elevé au MSX !
Haut
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :
Contacter Thyphoon

Message par Thyphoon »

Dans mon jeu j'ai une map de 512x512 !
Là ici j'expérimente ma technique avant de l'otpimisé...mais c'est pas encore au point ...lolllllllll et ta copie d'ecran me confirme bien la chose. Je vais continuer a chercher.

Pour le trie part Tas, c'est comme beaucoup de chose... ça fait des parties des trucs ou je regrette de ne pas avoir fait plus d'etude dans les maths !

Mais regarde le code de comtois peut être comprendra tu mieux l'utilisation des tas !
Haut
Avatar de l’utilisateur
Huitbit
Messages : 940
Inscription : jeu. 08/déc./2005 5:19
Localisation : Guadeloupe

Message par Huitbit »

:oops: voir plus loin!
Dernière modification par Huitbit le lun. 02/avr./2007 15:14, modifié 1 fois.
Elevé au MSX !
Haut
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :
Contacter Thyphoon

Message par Thyphoon »

J'obtiens le même resultat même en desactivant mes zones Danger :(

Concernant ma map de 512x512 si la plus part sont effectivement des petits trajets certain ne le sont pas pour l'instant ...
Il y a sur le net des debats en A* et un autre type de pathfinding Dajark je crois...chaqu'un aurait ses avantages et ses inconvenient ...

Bon je vais regarder de mon côté comment optimisé un peu plus le code. Quoi de passer derrière comtois...dois pas y avoir grand chose a faire lolllll
Haut
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :
Contacter Thyphoon

Message par Thyphoon »

Regarde si c'est pas mieux maintenant
J'ai optimisé (enfin j'ai essayé) et j'ai desactivé la detection des zone de danger pour l'instant... Alors ?

Code : Tout sélectionner

; ************************************************************
; ** Comtois le 17/07/05 - Pathfinding pour Purebasic V0.5  **
; ** Tentative de rajout de Danger Part Thyphoon le 25/03/07**
; ************************************************************
; PB4.0

; **********************************************************************
; ************************** 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 **
; ** Touche [F8] Sans/Avec recherche du point le plus proche si l'accès à la cible n'est pas possible **
; ** Touche [F9] Sans/Avec Remplissage >> Visualise la zone de déplacement possible à partir de Départ**
; ** 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 **
; ** Bouton Gauche de la souris + la Touche [Crtl] Rajoute un Danger **
; ** Bouton Droit de la souris + la touche [Ctrl] Supprimer un Danger **
; **********************************************************************


; --- Initialisation ---
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
    MessageRequester("Erreur", "Impossible d'initialiser DirectX 7 Ou plus", 0)
    End
EndIf
LoadFont (1, "Arial", 7)
; --- 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,Chrono,ChronoMax,diagonale
Global Remplissage,Proche,LePlusProche.point,Destination.point

diagonale=1
affPath=1
AffGrille=1

; --- dimension du tableau et taille d'une case ---
#max_x=64
#max_y=64
#max_x1=#max_x+1
#taille=8
#NbZoneDangerMax=10

; --- 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 MapTest(#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))

Global Dim ZoneDanger.Point(#NbZoneDangerMax)
Global NbZoneDanger=0

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

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

; ************************************************************************************
; *** LES PROCEDURES ***
; ************************************************************************************
Procedure SauveMap()
    If CreateFile(0,"PathFindingMap.map")
        WriteLong(0,ciblex)
        WriteLong(0,cibley)
        WriteLong(0,departx)
        WriteLong(0,departy)
       
        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")
        ciblex=ReadLong(0)
        cibley=ReadLong(0)
        departx=ReadLong(0)
        departy=ReadLong(0)
        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 danger()
  Couleur=RGB(0,255,0)
  StartDrawing(ScreenOutput())
    For z=1 To NbZoneDanger
      Circle(ZoneDanger(z)\x*#taille + #taille/2,ZoneDanger(z)\y*#taille + #taille/2,#taille/2,Couleur)
    Next
  StopDrawing()
EndProcedure

Procedure.l CalculDanger(x.l,y.l)
  Danger=-1
  For z=1 To NbZoneDanger
    Vx=Abs(ZoneDanger(z)\x-x)
    Vy=Abs(ZoneDanger(z)\y-y)
    Tmp_Danger=Vx+Vy
    If Tmp_Danger<Danger Or Danger=-1
      Danger=Tmp_Danger
    EndIf
  Next
  If Danger>10 ; Nombre de case ou le danger est concidéré comme n'étant pas dangereurx
    Danger=0
  Else
    Danger=10-Danger
  EndIf
  ProcedureReturn Danger*10
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 : " + Str(diagonale))
   
     lig + 20
    DrawText(#taille*(#max_x+1),lig,"[F8] Sans/Avec proche : " + Str(Proche))
     
    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,"[Bouton Gauche] + [Ctrl] Rajoute un Danger")
   
     lig + 20
    DrawText(#taille*(#max_x+1),lig,"[Bouton Droit] + [Ctrl] Supprime un Danger")
   
     lig + 20
    DrawText(#taille*(#max_x+1),lig,"Position : " + Str(MouseX()/#taille) + " / " + Str(MouseY()/#taille))   
   
     lig + 20
    DrawText(#taille*(#max_x+1),lig,"Temps : " + Str(Chrono) + " / " + Str(ChronoMax))
   
    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()
    ;Debug "Dx:"+Str(departx)+" Dy:"+Str(departy)+" Cx:"+Str(ciblex)+" CY:"+Str(cibley)
    ;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=Destination\x And departy=Destination\y
        ProcedureReturn 0
    EndIf
   
    ;Calcul Un ID unique pour le Noeud en cours
    NoeudID = departx
    NoeudID + #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(u<<1))\f : v = u<<1   : EndIf
                    If Noeud(Tas(v))\f >= Noeud(Tas(u<<1+1))\f : v = u<<1+1 : EndIf
                ElseIf u<<1 <= Taille_Tas
                    If Noeud(Tas(u))\f >= Noeud(Tas(u<<1))\f : v = u<<1 : 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
                ;Conditions de validité d'une case
                If  a >= 0 And a <= #max_x And b >= 0 And b <= #max_y And (diagonale=1 Or a = x Or b = y) And (a = x Or b = y Or map(a,y)=0 Or map(x,b)=0)
                   
                    ;Calcul un ID unique
                    TempID = a
                    TempID + #max_x1 * b
                   
                    ; ---- si la Case est libre et n'a pas encore été traitée
                    If map(a,b) = 0 And Noeud(TempID)\Closed = 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 = 3 + Noeud(NoeudID)\G ;
                        Else
                            G = 1 + Noeud(NoeudID)\G ;
                        EndIf
                       
                       
                        ; si la Case n'est pas dans la liste open ou si est meilleur en passant par cette case
                        If Noeud(TempID)\Open = 0 Or G < Noeud(TempID)\G
                           
                            parent(a,b)\x = x
                            parent(a,b)\y = y
                            Noeud(TempID)\G = G
                            Noeud(TempID)\H = (Abs(ciblex-a) + Abs(cibley-b))*10
                            ;-Thyphoon Modif
                            Noeud(TempID)\f = Noeud(TempID)\G + Noeud(TempID)\H;+CalculDanger(x,y)
                                                       
                            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
                                Position = Taille_Tas
                               
                            Else
                               
                                ;Cherche la position du Noeud dans le tas
                                For i = 1 To Taille_Tas
                                    If Tas(i)=TempID
                                        Position = i
                                        Break
                                    EndIf
                                Next i
                               
                            EndIf
                           
                            ;Retasse le tas à partir du Noeud en cours
                            While Position <> 1
                                If Noeud(Tas(Position))\f <= Noeud(Tas(Position>>1))\f
                                    temp = Tas(Position>>1)
                                    Tas(Position>>1) = Tas(Position)
                                    Tas(Position) = temp
                                    Position = Position>>1
                                Else
                                    Break
                                EndIf
                            Wend
                           
                            ; --- la cible est trouvée ---
                            If a = Destination\x And b = Destination\y
                                fin = 1
                                Break 2
                            EndIf
                        EndIf
                    EndIf
                EndIf
            Next b
        Next a
    Wend
    ProcedureReturn fin
EndProcedure

Procedure souris(ToucheShift,ToucheCtrl)
    If ExamineMouse()
        SX = MouseX() / #taille
        SY = MouseY() / #taille
        If SX >= 0 And SX <= #max_x And SY >= 0 And SY <= #max_y
           
            If ToucheCtrl=1
               
                If MouseButton(1) And NbZoneDanger<#NbZoneDangerMax
                    NbZoneDanger=NbZoneDanger+1
                    ZoneDanger(NbZoneDanger)\x=SX
                    ZoneDanger(NbZoneDanger)\y=SY
                    Delay(100)
                ElseIf MouseButton(2) And NbZoneDanger>0
                    NbZoneDanger-1
                    Delay(100)
                EndIf
            ElseIf ToucheShift = 1
                If MouseButton(1)
                  If map(SX,SY)=0
                     ciblex = SX : cibley = SY ; place la cible
                  EndIf   
                ElseIf MouseButton(2)
                  If map(SX,SY)=0
                    departx = SX : departy = SY ; place le départ
                  EndIf
                EndIf
            Else
                If MouseButton(1)
                    map(SX,SY)=1 ;place un mur
                ElseIf MouseButton(2)
                    map(SX,SY)=0 ; supprime un Mur
                EndIf
            EndIf
        EndIf
    EndIf
EndProcedure
Procedure AffRemplissage()
    Couleur=RGB(85,85,85)
    StartDrawing(ScreenOutput())
    For y=0 To #max_y
        For x=0 To #max_x
            xa=x*#taille
            ya=y*#taille
            Id = x + (#max_x+1)*y
            If MapTest(x,y)=2
                Box(xa + 1,ya + 1,#taille - 1,#taille - 1,Couleur)
            EndIf
        Next x
    Next y
    StopDrawing()
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_x+1)*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
             DrawingMode(#PB_2DDrawing_Transparent)
             DrawingFont(FontID(1)) 
            DrawText(xa + 3, ya + 1, "f="+Str(Noeud(Id)\f))
            DrawText(xa + 3, ya + 10, "h="+Str(Noeud(Id)\h))
            DrawText(xa + 3, ya + 19, "D="+Str(CalculDanger(x,y)))
        Next x
    Next y
    StopDrawing()
EndProcedure
Procedure affPath()
   
    Couleur=RGB(255,0,0)
    tps=ElapsedMilliseconds()
    Destination\x = ciblex
    Destination\y = cibley
    If ChercheChemin()=1
        Chrono=ElapsedMilliseconds()-tps
        If Chrono>ChronoMax
            ChronoMax=Chrono
        EndIf   
        a=-1
        b=-1
       
        cx=Destination\x
        cy=Destination\y
       
        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
        ;Circle(Destination\x*#taille+#taille/2,Destination\y*#taille+#taille/2,#taille/2,Couleur)
        StopDrawing()
    ElseIf Proche
 
         
       BestF = #max_y * #max_x * 2
       BestG = BestF
       For y=0 To #max_y
         For x=0 To #max_x
            Id = x + (#max_x+1)*y
            If Noeud(Id)\Open
               If Noeud(Id)\f > 0 And (Noeud(Id)\f < BestF Or((Noeud(Id)\f = BestF) And Noeud(Id)\h < BestH))
                  BestF = Noeud(Id)\f
                  BestH = Noeud(Id)\h
                  cx=x
                  cy=y
               EndIf
               
            EndIf
         Next x
      Next y
      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
        ;Circle(Destination\x*#taille+#taille/2,Destination\y*#taille+#taille/2,#taille/2,Couleur)
        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
        ElseIf KeyboardReleased(#PB_Key_F2)
            affPath=1-affPath
        ElseIf KeyboardReleased(#PB_Key_F3)
            SauveMap()
        ElseIf KeyboardReleased(#PB_Key_F4)
            ChargeMap()
        ElseIf KeyboardReleased(#PB_Key_F5)
            AffGrille=1-AffGrille
        ElseIf KeyboardReleased(#PB_Key_F6)
            EffaceMur()
        ElseIf KeyboardReleased(#PB_Key_F7)
            diagonale=1-diagonale
        ElseIf KeyboardReleased(#PB_Key_F8)
            Proche=1-Proche
           EndIf
        ToucheShift = KeyboardPushed(#PB_Key_LeftShift) Or KeyboardPushed(#PB_Key_RightShift)
        ToucheCtrl = KeyboardPushed(#PB_Key_LeftControl) Or KeyboardPushed(#PB_Key_RightControl)
    EndIf
    ;/ Gestion de la souris
    souris(ToucheShift,ToucheCtrl)
   

   
    mur()

    If AffGrille
        AffGrille()
    EndIf
    AffCadre()
    If AffOpenClosed
        AffOpenClosed()
    EndIf
   
    ;/Lance la recherche
    If affPath
        affPath()
    Else
        ChronoMax=0
    EndIf
        danger()
    ;/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
Haut
Avatar de l’utilisateur
Huitbit
Messages : 940
Inscription : jeu. 08/déc./2005 5:19
Localisation : Guadeloupe

Message par Huitbit »

:oops: voir plus loin!
Dernière modification par Huitbit le lun. 02/avr./2007 15:13, modifié 3 fois.
Elevé au MSX !
Haut
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :
Contacter Thyphoon

Message par Thyphoon »

A si un truc...pour tester il faut desactiver le debugger sinon c'est normal que tu es des variations :P
Bon je continue de chercher de mon côté
Haut
Avatar de l’utilisateur
Huitbit
Messages : 940
Inscription : jeu. 08/déc./2005 5:19
Localisation : Guadeloupe

Mea culpa...

Message par Huitbit »

Ouf, je suis rassuré, quand je fais "compiler sans le débogueur", toutes les cartes donnent un temps entre 0 ms et 16 ms!

Je vais donc effacer toutes les hypothèses foireuses données plus haut et me mettre au tri par tas!!!!!

:oops: Désolé pour cette perte de temps! :oops:

Hasta la vista!
Elevé au MSX !
Haut
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :
Contacter Thyphoon

Re: Mea culpa...

Message par Thyphoon »

Huitbit a écrit : :oops: Désolé pour cette perte de temps! :oops:
t'inquiète j'ai fait l'erreur avant toi , d'autre l'on fait, et encore d'autre le feront :P
Haut
Avatar de l’utilisateur
Jenova
Messages : 96
Inscription : mar. 09/mars/2004 10:27

Message par Jenova »

Hello, je farfouille partout pour trouver une bonne explication du fameux AStar et je suis tombé sur votre code que j'ai testé.
Je me suis de suite confronté à ce problème :
Image

ça saute aux yeux qu'il ne s'agit pas du chemin le plus court, vous avec une explication à ce bug ?
Haut
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :
Contacter comtois

Message par comtois »

fais un essai en changeant l'heuristique de H
j'avais utilisé la méthode de Manhattan pour le calcul de la distance.
(Abs(ciblex-a) + Abs(cibley-b))*10
essaye avec un calcul plus classique
Sqr((ciblex-a)² + (cibley-b)²)

à voir si c'est utile de faire un sqr, et le *10, je ne me souviens plus trop bien de ce code, mais l'idée est là ,adapte l'heuristique à ton besoin.
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.
Haut
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :
Contacter comtois

Message par comtois »

Sinon sur le forum anglais Heathen avait poussé l'étude du pathfinding beaucoup plus loin , son code est dispo ici

http://www.purebasic.fr/english/viewtopic.php?t=27598


[EDIT]
Ensuite je ne sais pas quel code tu as utilisé, je vois que les derniers codes postés sont différents du premier, tu peux faire varier le chemin calculé en changeant certains calculs, par exemple :
ici on tient compte de la distance d'un déplacement en diagonal qui vaut 14 contre 10 dans un déplacement horizontal ou vertical. si tu réduis la valeur 14, le chemin prendra plus souvent la diagonale, plutôt que d'aller tout droit.

Code : Tout sélectionner

; 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 = 14 + Noeud(NoeudID)\G ;
Else
    G = 10 + Noeud(NoeudID)\G ;
EndIf
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.
Haut
Avatar de l’utilisateur
Jenova
Messages : 96
Inscription : mar. 09/mars/2004 10:27

Message par Jenova »

Effectivement, j'avais pris le dernier code, qui utilisait 3 et 1 comme valeur.
En remplaçant par 14 et 10 on a d'excellents résultats :D
Haut
Répondre

Revenir à « Trucs et astuces »