Cet algorithme célèbre est un algorithme de type PathFinding.
Il recherche le chemin le plus rapide, j'ai bien dit rapide, entre deux points.
Pourquoi rapide et pas court?
Parce que celui-ci peut analyser les obstacles à franchir sur son chemin. Dans ce code vous pouvez soit charger un monde à partir du fichier monde.map soit en créér un aléatoirement.
Les déplacements se font sur les 4 pricipales directions.
Les options se configurent directement à partir de la source tel que la probabilité d'apparition de murs ou de divers obstacles lors de la création d'une map aléatoire. La source est bien commenté.
Source / Exemple :
'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
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.