ALGORITHME DE PATHFINDING ASTAR

'Voici l'algorithme proprement dit. Le zip contient aussi le module contenant le module graphique contenant aussi la Map (aléatoire ou préfabriquée)


Option Strict On
Module ModIa
    'On utilise ici, pour retrouver le meilleur chemin entre le départ et l'arrivé,
    'l'algorithme A* ou Astar (Algo de type PathFinding). Voir http://fr.wikipedia.org/wiki/Algorithme_A*
    Public Class IPoint 'Classe utilisé pour A*, représentante d'une case étudié par cet algo.
        Public G, H, F As Integer 'G est le cout du départ à la position actuelle, H l'heuristique : une estimation du cout d'arrivé, et F leur somme
        Public Position As Point 'La position du point actuel étudié
        Public Parent As IPoint 'Son parent
    End Class
    Public Function FindPath(ByVal Start As Point, ByVal Goal As Point) As List(Of Point) 'On retourne une liste de positions à afficher

        Dim Solution As New List(Of IPoint) 'Nouvelle liste, liste des points intéressants étudié par l'algorithme succeptibles d'être des points solutions
        Solution = FindPathIA(Start, Goal) 'Appel à l'algo proprement dit
        If Solution Is Nothing Then Return Nothing 'Si la solution est nulle, ce qui peut arriver quand il n'y a pas de solution, on retourne rien
        Dim RealSolution As New List(Of Point) 'Liste des points à afficher

        'On cherche le point solution d'arrivé. Donc on commence par la fin
        Dim Index As Integer = 0
        For U As Integer = 0 To (Solution.Count - 1)
            If Solution.Item(U).Position = Goal Then Index = U
        Next

        'Voilà notre point
        Dim n As New IPoint
        n = Solution.Item(Index)

        'On remonte grâce aux parents, puis aux grands parents, aux ancetres etc...
        Do
            RealSolution.Add(n.Position)
            n = n.Parent
        Loop While n.Parent IsNot Nothing 'jusqu'à qu'il n'y en a plus

        Return RealSolution 'On retourne la solution

    End Function

    Private Function FindPathIA(ByVal S As Point, ByVal A As Point) As List(Of IPoint)
        'Listes de stockage
        Dim ListClosed As New List(Of IPoint) 'Ceci est la liste fermée. Elle contient les points solutions. Plusieurs chemins possibles sont présents dedans.
        Dim ListOpen As New List(Of IPoint) 'Ceci est la liste ouverte. Elle contient les points successeurs analysés.
        Dim succ(3) As IPoint 'Ce sont les points successeurs, c.a.d les points situés sur chaque côté de la case courante.

        'Déclarations
        Dim n As New IPoint 'Le point centre des successeurs. Le point en cours parent des successeurs.
        Dim CaseType As Integer 'Definit un type de case
        Dim Save As Boolean 'Definit s'il faut sauver le point successeur dans la liste ouverte.
        Dim Index As Integer = 0 'Ca s'expliquera plus tard..

        'Ajouter START, ceci est le premier point, faut bien commencer quelque part.
        n.G = 0
        n.H = (Math.Abs(A.X - S.X) + Math.Abs(A.Y - S.Y))
        n.F = n.G + n.H
        n.Position = S
        n.Parent = New IPoint 'Parent nul.
        n.Parent.Position = New Point(0, 0) 'Position inexistante (dans les bords inaccessibles).
        ListOpen.Add(n) 'On ajoute le premier point à la liste ouverte.

        Do While ListOpen.Count <> 0 'Tant que cette liste n'est pas vide....

            'Cherche le plus petit F
            Index = 0
            For U As Integer = 0 To (ListOpen.Count - 1)
                If ListOpen(U).F < ListOpen(Index).F Then Index = U
            Next

            'Si le plus petit F trouvé correspond au point d'arrivé, on est arrivé à la fin de la routine, on oublie pa de l'ajouter bien sûr à la liste fermée
            If ListOpen(Index).Position = A Then ListClosed.Add(ListOpen.Item(Index)) : Return ListClosed

            'Une fois qu'on a le plus petit point F , on l'ajoute à la liste fermée et on le supprime de la liste ouverte. On le stocke aussi dans la variable n
            n = ListOpen.Item(Index)
            ListClosed.Add(n)
            ListOpen.RemoveAt(Index)

            'On réinitialise les successeurs
            For u As Integer = 0 To 3
                succ(u) = New IPoint
            Next

            'On définit leur position
            succ(0).Position.X = n.Position.X
            succ(0).Position.Y = n.Position.Y - 1
            succ(1).Position.X = n.Position.X + 1
            succ(1).Position.Y = n.Position.Y
            succ(2).Position.X = n.Position.X
            succ(2).Position.Y = n.Position.Y + 1
            succ(3).Position.X = n.Position.X - 1
            succ(3).Position.Y = n.Position.Y


            For U As Integer = 0 To 3 'Pour tout les successeurs...
                Save = True 'On dit de sauvegarder
                CaseType = Monde(succ(U).Position.X, succ(U).Position.Y) 'On definit le type de case du successeur en cours.
                If CaseType > 0 Then 'Si ce n'est pas un mur...
                    succ(U).G = n.G + CaseType * 2 'On calcule le nouveau cout du point de départ au succcesseur
                    succ(U).H = Math.Abs(A.X - succ(U).Position.X) + Math.Abs(A.Y - succ(U).Position.Y) 'Puis l'heuristique
                    succ(U).F = succ(U).H + succ(U).G 'On mélange le tout
                    succ(U).Parent = New IPoint 'On définit un nouveau parent
                    succ(U).Parent = n 'C'est la case en cours
                    'Ici on regarde si le successeur correspond à la case de la l'élément de la liste en cours et si oui, on regarde si son chemin est plus court par rapport à celui de l'élément de la liste. On apporte les modifications nécéssaires.
                    For I As Integer = 0 To (ListOpen.Count - 1)
                        If ListOpen(I).Position = succ(U).Position Then
                            If ListOpen.Item(I).F < succ(U).F Then
                                'La celui de la liste est plus petit donc on ne sauvegardera pas dans la liste ouverte ce successeur.
                                Save = False
                                Exit For
                            Else
                                'Ici c'est l'inverse, on la remplace et on empêche la sauvegarde pour les doublons
                                Save = False
                                ListOpen.RemoveAt(I)
                                ListOpen.Add(succ(U))
                            End If
                        End If
                    Next
                    'Ici on regarde si le successeur se trouve dans le liste fermé et si oui comme ci-dessus, on apporte les modifications.
                    For I As Integer = 0 To (ListClosed.Count - 1)
                        If ListClosed(I).Position = succ(U).Position Then
                            If ListClosed.Item(I).F <= succ(U).F Then
                                'L'élement de la liste a un chemin plus court donc inutile de sauvegarder le successeur dans la liste ouverte
                                Save = False
                            Else
                                ListClosed.RemoveAt(I) 'Dans le cas contraire, on supprime cet élement et on pourra étudier le successeur dans la liste ouverte.
                            End If
                        End If
                    Next
                    If Save = True Then 'Si on peut on sauve
                        ListOpen.Add(succ(U))
                    End If
                End If
            Next
        Loop

        Return ListClosed
    End Function


End Module

Télécharger le zip

09 avril 2007 11:47:43 :

C'est du .NET

09 avril 2007 11:50:25 :

J'ai enlevé les fichiers inutiles

03 mai 2007 16:01:41 :

nano bug. Oubli de retourner le résultat d'une fonction lors d'un cas rare mais existant

03 mai 2007 16:06:17 :

j'en profite pour rajouter un peu de code dans la page.

04 mai 2007 20:45:40 :

heu on dirait que la mise d'hier n'a pas été effective...