J'en avais besoin alors j'ai fais des recherches.
Recherche le plus court chemin entre deux point dans un labyrinthe.
Voici le résultat de mon travail et c'est avec plaisir que je vous en fais profité.
Cette méthode est basée sur l’algorithme de E.W. Dijkstra.
PB : 6.30
Os : Windows 11
La procedure PlusCourtChemin
Pcc ( DepartX , DepartY , ArriveeX , ArriveeY , 0 , @Tables )
et la procedure
ChargeResultat ( ArriveeX , ArriveeY , @Tables , Resultat() )
sont autonome, il sufit de passer les tables en paramètre et
elle seront traitées.
Les résultats s'affiche dans la fenêtre de débogage.
Je pense avoir suffisamment commenté le code pour le rendre le plus clair possible.
Bien à vous.
Code : Tout sélectionner
; Recherche le plus court chemin
; entre deux point dans un labyrinthe
;
; Cette méthode est basée sur l’algorithme de E.W. Dijkstra.
;
; PB : 6.30
; Os : Windows 11
;
Structure Pt
x .w
y .w
Dist .w
EndStructure
Structure Tb
Array Laby .w ( 1 , 1 )
Array Chemin.Pt ( 1 )
V2 .w
L .b
H .b
EndStructure
Define .Tb Tables
; ***************
; Les procédures
Procedure AfficheResultat ( _x , _y , _v , *Tbs.Tb )
Protected a$
Debug "x = " + Str( _x ) + " : y = " + Str( _y ) + " : valeur = " + Str( _v )
For y = 0 To *Tbs\H
a$ = ""
For x = 0 To *Tbs\L
If *Tbs\Laby( x , y ) = -1
a$ + "XXX:"
Else
a$ + RSet( Str( *Tbs\Laby( x , y ) ) , 3 , " ") + ":"
EndIf
Next
Debug a$
Next
Debug""
EndProcedure
Procedure Pcc ( _x1 , _y1 , _x2 , _y2 , _v , *Tbs.Tb )
Protected ValTmp .w
v = _v + 1
*Tbs\Laby ( _x1 , _y1 ) = v
*Tbs\V2 + 1
*Tbs\Chemin ( *Tbs\V2 )\x = _x1
*Tbs\Chemin ( *Tbs\V2 )\y = _y1
*Tbs\Chemin ( *Tbs\V2 )\Dist = v
; ; Pour un affichage pas à pas, retirez le point-virgule de la ligne suivante
; AfficheResultat( _x1 , _y1 , v , *Tbs )
If _x1 = _x2 And _y1 = _y2 : ProcedureReturn : EndIf
; Pour chaque directions possibles :
ValTmp = *Tbs\Laby( _x1 + 1 , _y1 ) ; à droite
If v < ValTmp Or ValTmp = 0
Pcc( _x1 + 1 , _y1 , _x2 , _y2 , v , *Tbs )
EndIf
ValTmp = *Tbs\Laby( _x1 - 1 , _y1 ) ; à gauche
If v < ValTmp Or ValTmp = 0
Pcc( _x1 - 1 , _y1 , _x2 , _y2 , v , *Tbs )
EndIf
ValTmp = *Tbs\Laby( _x1 , _y1 + 1 ) ; en bas
If v < ValTmp Or ValTmp = 0
Pcc( _x1 , _y1 + 1 , _x2 , _y2 , v , *Tbs )
EndIf
ValTmp = *Tbs\Laby( _x1 , _y1 - 1 ) ; en haut
If v < ValTmp Or ValTmp = 0
Pcc( _x1 , _y1 - 1 , _x2 , _y2 , v , *Tbs )
EndIf
EndProcedure
Procedure ChargeResultat ( _x2 , _y2 , *Tabs.Tb , Array Res.Pt( 1 ) )
; Charge dans la table Resultat() le chemin le plus court
Protected .w Distance
Protected .w n
Protected .a Trouve
Distance = *Tabs\Laby ( _x2 , _y2 )
Res( Distance )\Dist = Distance
Res( Distance )\x = _x2
Res( Distance )\y = _y2
Trouve.a = #False
For n = *Tabs\V2 To 1 Step -1
If Not Trouve
; Recherche le point d'arrivée en partant de la fin
If *Tabs\Chemin( n )\Dist = Res( Distance )\Dist And
*Tabs\Chemin( n )\x = _x2 And
*Tabs\Chemin( n )\y = _y2
Trouve = #True
EndIf
Else
; Trace le chemin en remontant jusqu'au point de départ
If *Tabs\Chemin( n )\Dist < Distance
Distance - 1
Res( Distance )\Dist = *Tabs\Chemin( n )\Dist
Res( Distance )\x = *Tabs\Chemin( n )\x
Res( Distance )\y = *Tabs\Chemin( n )\y
EndIf
EndIf
Next
EndProcedure
; *************************
; Les données du labyrinthe
DataSection
DataLaby:
Data.b 14 , 14 ; Large , Haut
; 0 1 2 3 4 5 6 7 8 9 A B C D E
Data.b -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1 ; 0
Data.b -1, 0, 0, 0, 0, 0, 0, 0,-1, 0, 0, 0, 0, 0,-1 ; 1
Data.b -1,-1,-1,-1,-1,-1, 0,-1,-1,-1, 0,-1,-1,-1,-1 ; 2
Data.b -1, 0, 0, 0, 0, 0, 0, 0,-1, 0, 0, 0, 0, 0,-1 ; 3
Data.b -1, 0,-1,-1,-1, 0,-1, 0,-1,-1,-1,-1, 0,-1,-1 ; 4
Data.b -1, 0,-1, 0, 0, 0,-1, 0, 0, 0, 0, 0, 0, 0,-1 ; 5
Data.b -1, 0,-1,-1,-1, 0,-1,-1,-1,-1,-1,-1,-1,-1,-1 ; 6
Data.b -1, 0, 0, 0,-1, 0, 0, 0, 0, 0, 0, 0,-1, 0,-1 ; 7
Data.b -1, 0,-1, 0,-1,-1,-1,-1,-1,-1,-1, 0,-1, 0,-1 ; 8
Data.b -1, 0,-1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-1 ; 9
Data.b -1,-1,-1, 0,-1,-1,-1,-1, 0,-1,-1,-1,-1, 0,-1 ; A
Data.b -1, 0, 0, 0, 0, 0,-1, 0, 0, 0, 0, 0,-1, 0,-1 ; B
Data.b -1,-1,-1, 0,-1,-1,-1, 0,-1,-1,-1,-1,-1, 0,-1 ; C
Data.b -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-1 ; D
Data.b -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1 ; E
EndDataSection
Restore DataLaby
Read.b Tables\L
Read.b Tables\H
; Initialise les tables avec les bonnes valeurs
FreeArray( Tables\Laby () ) : Dim Tables\Laby.w ( Tables\L , Tables\H )
FreeArray( Tables\Chemin() ) : Dim Tables\Chemin.Pt( Tables\L * Tables\H )
Dim LabyStr.s ( Tables\L , Tables\H )
; Chargement des tables
For y = 0 To Tables\H
For x = 0 To Tables\L
Read.b Val1
Tables\Laby( x , y ) = Val1
If Val1 < 0 : LabyStr ( x , y ) = "#"
Else : LabyStr ( x , y ) = " "
EndIf
Next
Next
; ************************************************
; Les coordonnées du points de départ et d'arrivée
; peuvent être modifier ici.
; Les valeurs vont de 1 à 13 en x et en y.
DepartX = 9 : DepartY = 1
ArriveeX = 7 : ArriveeY = 13
; ********************************
; Controle la validité des valeurs
If LabyStr ( DepartX , DepartY ) <> " " : Debug "Invalide Depart." : End : EndIf
If LabyStr ( ArriveeX , ArriveeY ) <> " " : Debug "Invalide Arrivee." : End : EndIf
If DepartX < 1 Or DepartX > Tables\L : Debug "Invalide DepartX." : End : EndIf
If DepartY < 1 Or DepartY > Tables\H : Debug "Invalide DepartY." : End : EndIf
If ArriveeX < 1 Or ArriveeX > Tables\L : Debug "Invalide ArriveeX." : End : EndIf
If ArriveeY < 1 Or ArriveeY > Tables\H : Debug "Invalide ArriveeY." : End : EndIf
; *************************************************
; La recherche du chemin le plus court, c'est ici.
; avec les coordonnées de départ, d'arrivée, valeur initialisée à 0 et
; la variable structurée contenant les tables nécessaire au traitement.
Pcc ( DepartX , DepartY , ArriveeX , ArriveeY , 0 , @Tables )
; Dimensionne le tableau de résultat puis remplit celui-ci en partant du point d'arrivé.
; Tables\Laby ( ArriveeX , ArriveeY ) contient la distance minimale entre les deux points.
; C'est le nombre d'éléments du tableau
Dim Resultat.Pt ( Tables\Laby ( ArriveeX , ArriveeY ) )
ChargeResultat ( ArriveeX , ArriveeY , @Tables , Resultat() )
; **********************
; Affiche les résultats
Debug ""
Debug "*************************"
Debug "Affichage des résultats :"
Debug "Départ : x = " + Str( DepartX ) + " : y = " + Str( DepartY )
Debug "Arrivée : x = " + Str( ArriveeX ) + " : y = " + Str( ArriveeY )
Debug "Contenu du tableau Laby( x , y ) :"
For y = 0 To Tables\H
a$ = ""
For x = 0 To Tables\L
If Tables\Laby( x , y ) = -1
a$ + "XXX:"
Else
a$ + RSet( Str( Tables\Laby( x , y ) ) , 3 , " ") + ":"
EndIf
Next
Debug a$
Next
Debug ""
Debug "Chemin à suivre :"
For n = 1 To Tables\Laby ( ArriveeX , ArriveeY )
Debug Str( n ) + " : x = " + Str( Resultat ( n )\x ) + " : y = " + Str( Resultat ( n )\y )
LabyStr ( Resultat ( n )\x , Resultat ( n )\y ) = "o"
Next
Debug ""
Debug "le tracé :"
LabyStr ( DepartX , DepartY ) = "D"
LabyStr ( ArriveeX , ArriveeY ) = "A"
For y = 0 To Tables\H
a$ = ""
For x = 0 To Tables\L
a$ + LabyStr ( x , y ) + " "
Next
Debug a$
Next
Debug ""
