PureBasic

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 ""