PureBasic

Code : Tout sélectionner

;*************************************
;***** PathFinding avec Dijkstra *****
;************ Par lepiaf31 ***********
;*********** Purebasic 4.51 **********
;*************************************
EnableExplicit

#Infinity = -1 ;représente une valeur inifinie

;Structure de coordonnées (x;y)
Structure xy
  x.i ;abscisses
  y.i ;ordonnées
EndStructure

;Compare 2 nombres et renvoi vrai si a <= b (en tenant compte de l'infini)
Procedure smaller(a.i, b.i)
  ProcedureReturn (b=#Infinity Or (a <> #Infinity And a <= b))
EndProcedure

;retourne la somme entre deux nombres (en tenant compte de l'infini)
Procedure sum(a.i, b.i)
  If a = #Infinity Or b = #Infinity
    ProcedureReturn #Infinity
  Else
    ProcedureReturn a + b
  EndIf
EndProcedure
    
;Procedure de recherche du plus court chemin dans un plan en 2D (utilisat l'algorithme de dijkstra en 8-voisinage)
;  plan: tableau contenant le cout pour accéder à chaque case du plan (#Infinity pour un obstacle)
;  sizeX, sizeY: dimensions du plan
;  startCoord, endCoord: coordonnées de départ et d'arrivée du chemeni à trouver
;  result: liste contenant les coordonnées du chemin (liste vide en cas de chemin inexistant)
Procedure dijkstraPathFinding(Array plan.i(2), sizeX.i, sizeY.i, *startCoord.xy, *endCoord.xy, List result.xy())
  Protected x.i, y.i, bestCost.i, *bestCoord, continu.b, cost.i
  Dim pred.xy(sizeX, sizeY) ;coordonnées de la case précédant (x,y) dans le chemin
  Dim cost.i(sizeX, sizeY) ;coût pour accéder à la case (x,y)
  NewList toBeTreated.xy() ;liste des coordonnées à traiter
  
  ;** Initialisation: tous les coups valent l'infini sauf celui de la case de départ **
  For x=0 To sizeX-1
    For y=0 To sizeY-1
      cost(x, y) = #Infinity
      AddElement(toBeTreated())
      toBeTreated()\x = x
      toBeTreated()\y = y
    Next
  Next
  cost(*startCoord\x, *startCoord\y) = 0
  ;****
  
  ;** Début de l'algorithme: on traite toutes les cases non traitées, jusqu'a ce que la case d'arrivée soit traitée **
  continu = #True
  While continu And ListSize(toBeTreated()) > 0
    ;Récupération de la case non traitée ayant le meilleur cout (le plus faible)
    bestCost = #Infinity
    ForEach toBeTreated()
      If smaller(cost(toBeTreated()\x, toBeTreated()\y), bestCost)
        bestCost = cost(toBeTreated()\x, toBeTreated()\y)
        *bestCoord = @toBeTreated()
      EndIf
    Next
    ChangeCurrentElement(toBeTreated(), *bestCoord) ;au se positionne au niveau de l'element qui nous interesse
    
    ;Mise à jour des couts en suivant cet element (on peut se deplacer selon un 8-voisinnage)
    For x = toBeTreated()\x - 1 To toBeTreated()\x + 1
      For y = toBeTreated()\y - 1 To toBeTreated()\y + 1
        If x >= 0 And y >= 0 And x < sizeX And y < sizeY And (x <> toBeTreated()\x Or y <> toBeTreated()\y)
          cost = sum(cost(toBeTreated()\x, toBeTreated()\y), plan(x, y)) ;calcul du coup de la case si on prend ce chemin
          If Not smaller(cost(x, y), cost) ;le nouveau chemin est plus court
            cost(x, y) = cost
            pred(x, y)\x = toBeTreated()\x
            pred(x, y)\y = toBeTreated()\y
          EndIf
        EndIf
      Next
    Next
    
    ;on a fini de traiter la case d'arriver, ce n'est pas la peine de continuer
    If toBeTreated()\x = *endCoord\x And toBeTreated()\y = *endCoord\y 
      continu = #False
    EndIf
    
    DeleteElement(toBeTreated()) ;on a fini de traiter l'element
  Wend
  ;****
  
  ;** Récupération du chemin **
  ClearList(result())
  If cost(*endCoord\x, *endCoord\y) <> #Infinity ;si c'est l'infini, c'est qu'il n'y a pas de chemin
    AddElement(result())
    result()\x = *endCoord\x
    result()\y = *endCoord\y
    While *startCoord\x <> result()\x Or *startCoord\y <> result()\y
      x = pred(result()\x, result()\y)\x
      y = pred(result()\x, result()\y)\y
      ResetList(result())
      AddElement(result())
      result()\x = x
      result()\y = y
    Wend
  EndIf
  ;****
EndProcedure



;***** Tests *****
Procedure showPlan(Array plan.i(2), sizeX.i, sizeY.i, List result.xy())
  Protected window.i, windowWidth.i, windowHeight.i, caseWidth.i, caseHeight.i, x.i, y.i
  
  windowWidth = 300
  windowHeight = 300
  
  window = OpenWindow(#PB_Any, 0, 0, windowWidth, windowHeight, "PathFinding avec Dijkstra", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  If window
    caseWidth = windowWidth / sizeX
    caseHeight = windowHeight / sizeY
    StartDrawing(WindowOutput(window))
    For x=0 To sizeX-1
      For y=0 To sizeY-1
        If plan(x, y) = #Infinity
          Box(x*caseWidth, y*caseHeight, caseWidth, caseHeight, RGB(0,0,0))
        Else
          Box(x*caseWidth, y*caseHeight, caseWidth, caseHeight, RGB(255,255,255))
        EndIf
      Next
    Next
    
    ForEach result()
      Box(result()\x*caseWidth, result()\y*caseHeight, caseWidth, caseHeight, RGB(0,255,0))
    Next
    
    StopDrawing()
  EndIf
  
  Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndProcedure

Define nbCol.i, nbLi.i, dep.xy, arr.xy, x.i, y.i

nbCol = 4
nbLi = 4
NewList result.xy()
Dim plan(nbCol, nbLi)

;toutes les cases ont le meme cout
For x=0 To nbCol-1
  For y=0 To nbLi-1
    plan(x,y) = 1
  Next
Next

;on précise certains obstacles:
plan(1, 1) = #Infinity
plan(2, 1) = #infinity

;depart et arrivée
dep\x = 2
dep\y = 0
arr\x = 2
arr\y = 3

dijkstraPathFinding(plan(), nbCol, nbLi, @dep, @arr, result())
showPlan(plan(), nbCol, nbLi, result())

;changons l'arrivée pour voir:
arr\x = 0
arr\y = 2
dijkstraPathFinding(plan(), nbCol, nbLi, @dep, @arr, result())
showPlan(plan(), nbCol, nbLi, result())