IA : Find A Way...

lionel_om · Message par **lionel_om** » jeu. 20/janv./2005 13:52

Bonjour à tous !!!

Je suis en train de préparer un exposé sur l'intelligence artificielle. Je travaille actuellement sur la recherche de chemin.

J'ai composé 3 codes que voici...

J'ai donc fais un 1er programme (récursif) pour atteindre le point d'arrivé, mais lors des chemins complexes (point d'arrivée rapproché, mais très difficilement accessible), le calcul est très très long.

Voici le code 1 :

Code : Tout sélectionner

Declare.b FindDirection(x,y, tx, ty)
Declare.b FindAWay(x,y, tx, ty, cpt.b, exDir.b)
RandomSeed(ElapsedMilliseconds())

#HAUT = 1
#DROITE = 2
#BAS = 4
#GAUCHE = 8

Dim Map.b(15,15)
Dim Calk.b(15,15)

For j = 0 To 14
  For i = 0 To 14
    Read Map(i,j)
  Next i
Next j


PersoX = 1
PersoY = 1

TargetX.w = 1
TargetY.w = 1

ShowCursor_(1)
ShowCursor_(1)
ShowCursor_(1)


If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse()=0
  MessageRequester("Error", "Can't open DirectX 7 or later", 0)
  End
EndIf


OpenScreen(320, 240, 16, "Sprite")



; - - - - - - - - - - - BOUCLE - - - - - - - - - - -

Repeat

  FlipBuffers()
  If IsScreenActive() 
    ClearScreen(0,0,0)
    ReleaseMouse(0)
    ExamineKeyboard(): ExamineMouse()
    
    
    If MouseButton(1)
      If Map(Int(MouseX()/16), Int(MouseY()/16)) = 0
        TargetX = MouseX()/16
        TargetY = MouseY()/16
      EndIf
    EndIf
    
    Select FindDirection(PersoX, PersoY, TargetX, TargetY)
      Case #HAUT
        PersoY - 1
      Case #DROITE
        PersoX + 1
      Case #BAS
        PersoY + 1
      Case #GAUCHE
        PersoX - 1
    EndSelect
    
    StartDrawing(ScreenOutput())
      For j = 0 To 14
        For i = 0 To 14
          If Map(i,j)
            Box(i*16, j*16, 16, 16, RGB(255,255,255))
          EndIf
        Next i
      Next j
        Line(TargetX*16, TargetY*16, 16, 16, RGB(255,0,0))
        Line(TargetX*16, TargetY*16 +15, 16, -16, RGB(255,0,0))
      For i = 1 To 7
        Circle((PersoX*16) + 8, (PersoY*16) + 8, i, RGB(255,255,0))
      Next i
    StopDrawing()
    SetCursorPos_(MouseX(), MouseY())

  Else
    ReleaseMouse(1)
  EndIf


Until KeyboardPushed(#PB_Key_Escape)

CloseScreen()
End
; - - - - - - - - - - - - - - - - - - - - - - - - -


DataSection
  Data.b 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
  Data.b 1,0,0,0,0,0,0,1,0,0,0,0,0,1,1
  Data.b 1,0,1,1,0,1,0,1,0,1,1,1,0,0,1
  Data.b 1,0,1,1,0,1,0,0,0,1,1,1,1,0,1
  Data.b 1,0,0,1,0,1,0,1,0,1,0,0,1,0,1
  Data.b 1,1,0,1,0,1,0,1,0,0,0,0,0,0,1
  Data.b 1,0,0,0,0,1,0,1,1,1,1,0,1,1,1
  Data.b 1,1,1,1,1,1,0,1,0,0,0,0,1,0,1
  Data.b 1,0,0,0,0,0,0,1,0,1,1,0,1,0,1
  Data.b 1,0,1,1,0,1,1,1,0,0,1,0,1,0,1
  Data.b 1,0,1,0,0,1,0,1,1,0,1,0,1,0,1
  Data.b 1,0,1,0,1,1,0,1,1,0,1,0,1,0,1
  Data.b 1,0,1,0,0,1,0,1,1,1,1,0,1,0,1
  Data.b 1,0,0,0,0,0,0,1,0,0,0,0,0,0,1
  Data.b 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
EndDataSection


Procedure.b FindAWay(x,y, tx, ty, cpt.b, exDir.b)
  difX = (x - tx)
  difY = (y - ty)

  If x = tx And y = ty
    ProcedureReturn(15)
  ElseIf Abs(difX) + Abs(difY) > cpt
    ProcedureReturn(0)
  EndIf
  
  mur = Map(x,y-1)*#HAUT + Map(x+1,y)*#DROITE + Map(x,y+1)*#BAS + Map(x-1,y)*#GAUCHE
  

  
  tried.b = (exDir * 4) % 15
  
  If Abs(difX) > Abs(difY)
   ; perso trop à droite : <=
    If x > tx
      If (mur & #GAUCHE)=0 And tried <> #GAUCHE
        If FindAWay(x-1,y, tx, ty, cpt-1, #GAUCHE)
          ProcedureReturn(#GAUCHE)
        EndIf
      EndIf
      tried = #GAUCHE
   ;perso trop à gauche =>
    Else
      If (mur & #DROITE)=0 And tried <> #DROITE
        If FindAWay(x+1,y, tx, ty, cpt-1, #DROITE)
          ProcedureReturn(#DROITE)
        EndIf
      EndIf
      tried = #DROITE
    EndIf
  Else
   ; perso trop haut
    If y > ty
      If (mur & #HAUT)=0 And tried <> #HAUT
        If FindAWay(x,y-1, tx, ty, cpt-1, #HAUT)
          ProcedureReturn(#HAUT)
        EndIf
      EndIf
      tried = #HAUT
   ;perso trop bas ^
    Else
      If (mur & #BAS)=0 And tried <> #BAS
        If FindAWay(x,y+1, tx, ty, cpt-1, #BAS)
          ProcedureReturn(#BAS)
        EndIf
      EndIf
      tried = #BAS
    EndIf
  EndIf

  While (tried <> 15)
    c = Pow(2, Random(3))
    If (tried & c)=0
      Select c
        Case #HAUT
          If (mur & #HAUT)=0 And tried <> #HAUT
            If FindAWay(x,y-1, tx, ty, cpt-1, #HAUT)
              ProcedureReturn(#HAUT)
            EndIf
          EndIf
        
        Case #DROITE
          If (mur & #DROITE)=0 And tried <> #DROITE
            If FindAWay(x+1,y, tx, ty, cpt-1, #DROITE)
              ProcedureReturn(#DROITE)
            EndIf
          EndIf
          
        Case #BAS
          If (mur & #BAS)=0 And tried <> #BAS
            If FindAWay(x,y+1, tx, ty, cpt-1, #BAS)
              ProcedureReturn(#BAS)
            EndIf
          EndIf
        
        Case #GAUCHE
          If (mur & #GAUCHE)=0 And tried <> #GAUCHE
            If FindAWay(x-1,y, tx, ty, cpt-1, #GAUCHE)
              ProcedureReturn(#GAUCHE)
            EndIf
          EndIf
          
      EndSelect
      tried = tried | c
    EndIf
  Wend

    ProcedureReturn(0)
EndProcedure


Procedure.b FindDirection(x,y, tx, ty)
  If (x = tx) And (y = ty)
    ProcedureReturn(0)
  EndIf
  
  cpt = Abs(x - tx) + Abs(y - ty)
  Repeat
    r.b = FindAWay(x,y, tx,ty, cpt, 0)
    cpt + 1
    If cpt = 40
      End
    EndIf
  Until r
  ProcedureReturn(r)
EndProcedure

Puis j'ai refait un code similaire, sauf que c'est fois je fais 2 patates (récursion grandissante) et j'intercepte le point de collision entre ces 2 patates => point intermédiaire :

Code : Tout sélectionner

Declare.b FindDirection(x,y, tx, ty)
Declare.b FindAWay(x,y, tx, ty, cpt.b, exDir.b, marque.b, intersection.b)
RandomSeed(ElapsedMilliseconds())

#HAUT = 1
#DROITE = 2
#BAS = 4
#GAUCHE = 8

Dim Map.b(15,15)
Dim Calk.b(15,15)
Global PtInter.Point, inter.b

For j = 0 To 14
  For i = 0 To 14
    Read Map(i,j)
  Next i
Next j


PersoX = 1
PersoY = 1

TargetX.w = 1
TargetY.w = 1

ShowCursor_(1)
ShowCursor_(1)
ShowCursor_(1)


If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse()=0
  MessageRequester("Error", "Can't open DirectX 7 or later", 0)
  End
EndIf


OpenScreen(320, 240, 16, "Sprite")



; - - - - - - - - - - - BOUCLE - - - - - - - - - - -

Repeat

  FlipBuffers()
  If IsScreenActive() 
    ClearScreen(0,0,0)
    ReleaseMouse(0)
    ExamineKeyboard(): ExamineMouse()
    
    
    If MouseButton(1)
      If Map(Int(MouseX()/16), Int(MouseY()/16)) = 0
        TargetX = MouseX()/16
        TargetY = MouseY()/16
      EndIf
    EndIf
    
    If Inter
      dir = FindDirection(PersoX, PersoY, PtInter\x, PtInter\y)
    Else
      dir = FindDirection(PersoX, PersoY, TargetX, TargetY)
    EndIf
    
    Select dir
      Case #HAUT
        PersoY - 1
      Case #DROITE
        PersoX + 1
      Case #BAS
        PersoY + 1
      Case #GAUCHE
        PersoX - 1
    EndSelect
    
    If Inter
      If PtInter\x = PersoX And PtInter\y = PersoY
        Inter = 0
      EndIf
    EndIf
    
    StartDrawing(ScreenOutput())
      For j = 0 To 14
        For i = 0 To 14
          If Map(i,j)
            Box(i*16, j*16, 16, 16, RGB(255,255,255))
          EndIf
        Next i
      Next j
        Line(TargetX*16, TargetY*16, 16, 16, RGB(255,0,0))
        Line(TargetX*16, TargetY*16 +15, 16, -16, RGB(255,0,0))
        
        If Inter
          Line(PtInter\x*16, PtInter\y*16, 16, 16, RGB(0,0,255))
          Line(PtInter\x*16, PtInter\y*16 +15, 16, -16, RGB(0,0,255)) 
        EndIf       
      For i = 1 To 7
        Circle((PersoX*16) + 8, (PersoY*16) + 8, i, RGB(255,255,0))
      Next i
    StopDrawing()
    SetCursorPos_(MouseX(), MouseY())

  Else
    ReleaseMouse(1)
  EndIf


Until KeyboardPushed(#PB_Key_Escape)

CloseScreen()
End
; - - - - - - - - - - - - - - - - - - - - - - - - -


DataSection
  Data.b 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
  Data.b 1,0,0,0,0,0,0,1,0,0,0,0,0,1,1
  Data.b 1,0,1,1,0,1,0,1,0,1,1,1,0,0,1
  Data.b 1,0,1,1,0,1,0,0,0,1,1,1,1,0,1
  Data.b 1,0,0,1,0,1,0,1,0,1,0,0,1,0,1
  Data.b 1,1,0,1,0,1,0,1,0,0,0,0,0,0,1
  Data.b 1,0,0,0,0,1,0,1,1,1,1,0,1,1,1
  Data.b 1,1,1,1,1,1,0,1,0,0,0,0,1,0,1
  Data.b 1,0,0,0,0,0,0,1,0,1,1,0,1,0,1
  Data.b 1,0,1,1,0,1,1,1,0,0,1,0,1,0,1
  Data.b 1,0,1,0,0,1,0,1,1,0,1,0,1,0,1
  Data.b 1,0,1,0,1,1,0,1,1,0,1,0,1,0,1
  Data.b 1,0,1,0,0,1,0,1,1,1,1,0,1,0,1
  Data.b 1,0,0,0,0,0,0,1,0,0,0,0,0,0,1
  Data.b 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
EndDataSection


Procedure.b FindAWay(x,y, tx, ty, cpt.b, exDir.b, marque.b, intersection.b)
  difX = (x - tx)
  difY = (y - ty)

  If x = tx And y = ty
    ProcedureReturn(15)
  ElseIf Abs(difX) + Abs(difY) > cpt
    ProcedureReturn(0)
  EndIf

  If marque
    If Calk(x,y) > 0 And Calk(x,y) <> marque
      If intersection
        PtInter\x = x: PtInter\y = y
        Inter = 1
      EndIf
      ProcedureReturn(15)
    Else
      Calk(x,y) = marque
    EndIf
  EndIf
  
  mur = Map(x,y-1)*#HAUT + Map(x+1,y)*#DROITE + Map(x,y+1)*#BAS + Map(x-1,y)*#GAUCHE
  

  
  tried.b = (exDir * 4) % 15
  
  If Abs(difX) > Abs(difY)
   ; perso trop à droite : <=
    If x > tx
      If (mur & #GAUCHE)=0 And tried <> #GAUCHE
        If FindAWay(x-1,y, tx, ty, cpt-1, #GAUCHE, marque, intersection)
          ProcedureReturn(#GAUCHE)
        EndIf
      EndIf
      tried = #GAUCHE
   ;perso trop à gauche =>
    Else
      If (mur & #DROITE)=0 And tried <> #DROITE
        If FindAWay(x+1,y, tx, ty, cpt-1, #DROITE, marque, intersection)
          ProcedureReturn(#DROITE)
        EndIf
      EndIf
      tried = #DROITE
    EndIf
  Else
   ; perso trop haut
    If y > ty
      If (mur & #HAUT)=0 And tried <> #HAUT
        If FindAWay(x,y-1, tx, ty, cpt-1, #HAUT, marque, intersection)
          ProcedureReturn(#HAUT)
        EndIf
      EndIf
      tried = #HAUT
   ;perso trop bas ^
    Else
      If (mur & #BAS)=0 And tried <> #BAS
        If FindAWay(x,y+1, tx, ty, cpt-1, #BAS, marque, intersection)
          ProcedureReturn(#BAS)
        EndIf
      EndIf
      tried = #BAS
    EndIf
  EndIf

  If mur | tried = 15
    Calk(x,y) = -1
  EndIf

  While (tried <> 15)
    c = Pow(2, Random(3))
    If (tried & c)=0
      Select c
        Case #HAUT
          If (mur & #HAUT)=0 And tried <> #HAUT
            If FindAWay(x,y-1, tx, ty, cpt-1, #HAUT, marque, intersection)
              ProcedureReturn(#HAUT)
            EndIf
          EndIf
        
        Case #DROITE
          If (mur & #DROITE)=0 And tried <> #DROITE
            If FindAWay(x+1,y, tx, ty, cpt-1, #DROITE, marque, intersection)
              ProcedureReturn(#DROITE)
            EndIf
          EndIf
          
        Case #BAS
          If (mur & #BAS)=0 And tried <> #BAS
            If FindAWay(x,y+1, tx, ty, cpt-1, #BAS, marque, intersection)
              ProcedureReturn(#BAS)
            EndIf
          EndIf
        
        Case #GAUCHE
          If (mur & #GAUCHE)=0 And tried <> #GAUCHE
            If FindAWay(x-1,y, tx, ty, cpt-1, #GAUCHE, marque, intersection)
              ProcedureReturn(#GAUCHE)
            EndIf
          EndIf
          
      EndSelect
      tried = tried | c
    EndIf
  Wend

    ProcedureReturn(0)
EndProcedure


Procedure.b FindDirection(x,y, tx, ty)
  If (x = tx) And (y = ty)
    ProcedureReturn(0)
  EndIf
  
  For j = 0 To 15
    For i = 0 To 15
      If Map(i,j)
        Calk(i,j) = -1
      Else
        Calk(i,j) = 0
      EndIf
    Next i
  Next j
  
  cpt = (Abs(x - tx) + Abs(y - ty) + 1)/2
  Repeat
    r.b = FindAWay(x,y, tx,ty, cpt, 0, 1,cpt>7)
    If r
      ProcedureReturn(r)
    EndIf
    FindAWay(tx,ty, x,y, cpt, 0, 2,0)
    cpt + 2
    If cpt = 40
      End
    EndIf
  ForEver 
EndProcedure

Puis j'ai fais un code avec ce que j'ai appris brievement en maths : les graphes. J'ai donc repérer les noeuds de la carte (case où il n'y a qu'un ou aucun mur sur la case à côté (non diagonale) ).
De là je répartie la carte en zone. Je repère les zones qui se touchent. Je détermine la distance entre les 2 noeuds des zones juxtaposées. Puis je détermine par quelle zone il faut passer (étapes, point "médian") pour arriver au but.

Donc tous les calculs se font à la création de la carte. Ainsi les calculs entre les déplacements sont minimes et les déplacements sont donc quasi-instantanés.
Voici donc ce dernier code (beaucoup plus complexe que les 2 précédents) :

Code : Tout sélectionner

Structure Noeud
  x.w
  y.w
  num.w
EndStructure

Declare.b MapNotCompletelyAnalysed()
Declare GetNodes()
Declare.l CopyToMemory(*p.Noeud)
Declare BuildWay(x.w, y.w, num.w, rayon.b)
Declare MakeWays()
Declare MakeGraphe()
Declare BuildGraphe(x.w, y.w, num.w, exDir.b)
Declare GiveWayLength(x.w,y.w, tx.w,ty.w, exDir.b, rayon.b)
Declare CompleteGraphe()
Declare.b GetWay(x.w,y.w, *tx.w,*ty.w)
Declare MakeLinkingGraphe()
Declare AddToLinkingGraphe(cur.b, fin.b, deb.b, suiv.b, cpt.w)

Declare.b FindDirection(x,y, tx, ty)
Declare.b FindAWay(x,y, tx, ty, cpt.b, exDir.b)
RandomSeed(ElapsedMilliseconds())

#HAUT = 1
#DROITE = 2
#BAS = 4
#GAUCHE = 8
#SPRITE = 32

Dim Map.b(15,15)
Dim Calk.b(15,15)
Dim Link.b(15,15)
NewList Inter.l()
Global NbElts.w



For j = 0 To 14
  For i = 0 To 14
    Read Map(i,j)
  Next i
Next j

GetNodes()
Dim Graphe.w(NbElts, NbElts)
Dim Graph2.w(NbElts, NbElts)
Dim Way.b(NbElts)
MakeGraphe()
MakeLinkingGraphe()


PersoX = 1
PersoY = 1

TargetX.w = PersoX
TargetY.w = PersoY

MiddleX.w = PersoX
MiddleY.w = PersoX

ShowCursor_(1)
ShowCursor_(1)
ShowCursor_(1)


If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse()=0
  MessageRequester("Error", "Can't open DirectX 7 or later", 0)
  End
EndIf


OpenScreen(640, 480, 16, "Sprite")



; - - - - - - - - - - - BOUCLE - - - - - - - - - - -

Repeat

  FlipBuffers()
  If IsScreenActive() 
    ClearScreen(0,0,0)
    ReleaseMouse(0)
    ExamineKeyboard(): ExamineMouse()
    
    
    If MouseButton(1)
      If Map(Int(MouseX()/#SPRITE), Int(MouseY()/#SPRITE)) = 0
        TargetX = MouseX()/#SPRITE: MiddleX = TargetX
        TargetY = MouseY()/#SPRITE: MiddleY = TargetY
      EndIf
    EndIf
    
    nextDir = GetWay(PersoX,PersoY, @MiddleX, @MiddleY)
    Select nextDir
      Case #HAUT
        PersoY - 1
      Case #DROITE
        PersoX + 1
      Case #BAS
        PersoY + 1
      Case #GAUCHE
        PersoX - 1
    EndSelect
    
    If PersoX = MiddleX And PersoY = MiddleY
      MiddleX = TargetX
      MiddleY = TargetY
    EndIf
    
    StartDrawing(ScreenOutput())
      For j = 0 To 14
        For i = 0 To 14
          If Map(i,j)
            Box(i*#SPRITE, j*#SPRITE, #SPRITE, #SPRITE, RGB(255,255,255))
          EndIf
          ;Locate(i*#SPRITE, j*#SPRITE): FrontColor(0,128,255)
          ;DrawText(Str(Calk(i,j)))
        Next i
      Next j
      
        Line(MiddleX*#SPRITE, MiddleY*#SPRITE, #SPRITE, #SPRITE, RGB(0,0,255))
        Line(MiddleX*#SPRITE, (MiddleY+1)*#SPRITE-1, #SPRITE, 0-#SPRITE, RGB(0,0,255))

        Line(TargetX*#SPRITE, TargetY*#SPRITE, #SPRITE, #SPRITE, RGB(255,0,0))
        Line(TargetX*#SPRITE, (TargetY+1)*#SPRITE-1, #SPRITE, 0-#SPRITE, RGB(255,0,0))
      For i = 1 To 7
        Circle((PersoX*#SPRITE) + #SPRITE/2, (PersoY*#SPRITE) + #SPRITE/2, i, RGB(255,255,0))
      Next i
    StopDrawing()
    SetCursorPos_(MouseX(), MouseY())

  Else
    ReleaseMouse(1)
  EndIf


Until KeyboardPushed(#PB_Key_Escape)

CloseScreen(): End

; - - - - - - - - - - - - - - - - - - - - - - - - -


DataSection
  Data.b 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
  Data.b 1,0,0,0,0,0,0,1,0,0,0,0,0,1,1
  Data.b 1,0,1,1,0,1,0,1,0,1,1,1,0,0,1
  Data.b 1,0,1,1,0,1,0,0,0,1,1,1,1,0,1
  Data.b 1,0,0,1,0,1,0,1,0,1,0,0,1,0,1
  Data.b 1,1,0,1,0,1,0,1,0,0,0,0,0,0,1
  Data.b 1,0,0,0,0,1,0,1,1,1,1,0,1,1,1
  Data.b 1,1,1,1,1,1,0,1,0,0,0,0,1,0,1
  Data.b 1,0,0,0,0,0,0,1,0,1,1,0,1,0,1
  Data.b 1,0,1,1,0,1,1,1,0,0,1,0,1,0,1
  Data.b 1,0,1,0,0,1,0,1,1,0,1,0,1,0,1
  Data.b 1,0,1,0,1,1,0,1,1,0,1,0,1,0,1
  Data.b 1,0,1,0,0,1,0,1,1,1,1,0,1,0,1
  Data.b 1,0,0,0,0,0,0,1,0,0,0,0,0,0,1
  Data.b 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
EndDataSection




Procedure.b MapNotCompletelyAnalysed()
  For j = 1 To 13
    For i = 1 To 13
      If Calk(i,j) = 0
        ProcedureReturn(1)
      EndIf
    Next i
  Next j
EndProcedure

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
; Création des noeuds
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 

Procedure GetNodes()
  *p.Noeud = AllocateMemory(6)
  For j = 1 To 13
    For i = 1 To 13
      If Map(i,j)=0
        If Map(i,j-1) + Map(i+1,j) + Map(i,j+1) + Map(i-1,j) < 2
          NbElts + 1
          *p\x = i
          *p\y = j
          *p\num = NbElts
          LastElement(Inter())
          AddElement(Inter())
            Inter() = CopyToMemory(*p)
          Calk(i,j) = NbElts
        EndIf
      Else
        Calk(i,j) = -1
      EndIf
    Next i
  Next j
  FreeMemory(*p)
  MakeWays()
EndProcedure


Procedure.l CopyToMemory(*p.Noeud)
  *m.Noeud = AllocateMemory(SizeOf(*p))
  If *m
    CopyMemory(*p, *m, SizeOf(Noeud))
    ProcedureReturn(*m)
  Else
    MessageRequester("Error!", "Unable to allocate memory", #PB_MessageRequester_OK)
  EndIf
EndProcedure


; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
; Création des zones
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 

Procedure BuildWay(x.w, y.w, num.w, rayon.b)
  If Calk(x,y) = 0
    Calk(x,y) = num
  EndIf
  
  If rayon = 0
    ProcedureReturn
  EndIf
  
  mur = Map(x,y-1)*#HAUT + Map(x+1,y)*#DROITE + Map(x,y+1)*#BAS + Map(x-1,y)*#GAUCHE
  
  If (mur & #GAUCHE)=0
    BuildWay(x-1, y, num, rayon-1)
  EndIf
  If (mur & #DROITE)=0
    BuildWay(x+1, y, num, rayon-1)
  EndIf
  If (mur & #BAS)=0
    BuildWay(x, y+1, num, rayon-1)
  EndIf
  If (mur & #HAUT)=0
    BuildWay(x, y-1, num, rayon-1)
  EndIf
EndProcedure


Procedure MakeWays()
  rayon = 1
  *ad.Noeud
  
  While MapNotCompletelyAnalysed()
    ResetList(Inter())
    While NextElement(Inter())
      *ad = Inter()
      BuildWay(*ad\x, *ad\y, *ad\num, rayon)
    Wend
    rayon + 1
  Wend
EndProcedure


; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
; Cration du graphe des zones juxtaposées
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 

Procedure MakeGraphe()
  *ad.Noeud
  
  ResetList(Inter())
  While NextElement(Inter())
    *ad = Inter()
    BuildGraphe(*ad\x, *ad\y, *ad\num, 0)
  Wend
    CompleteGraphe()
EndProcedure



Procedure BuildGraphe(x.w, y.w, num.w, exDir.b)
  If Calk(x,y) <> num
    Graphe(num, Calk(x,y)) = 1
    ProcedureReturn
  EndIf
  
  mur = Map(x,y-1)*#HAUT + Map(x+1,y)*#DROITE + Map(x,y+1)*#BAS + Map(x-1,y)*#GAUCHE
  
  If (mur & #GAUCHE)=0 And exDir <> #DROITE
    BuildGraphe(x-1, y, num, #GAUCHE)
  EndIf
  If (mur & #DROITE)=0 And exDir <> #GAUCHE
    BuildGraphe(x+1, y, num, #DROITE)
  EndIf
  If (mur & #BAS)=0 And exDir <> #HAUT
    BuildGraphe(x, y+1, num, #BAS)
  EndIf
  If (mur & #HAUT)=0 And exDir <> #BAS
    BuildGraphe(x, y-1, num, #HAUT)
  EndIf
EndProcedure


Procedure CompleteGraphe()
  *m.Noeud: *n.Noeud
  For i = 1 To nbElts-1
    For j = i+1 To nbElts
      If Graphe(i,j)
        SelectElement(Inter(), i-1)
          *m = Inter()
        SelectElement(Inter(), j-1)
          *n = Inter()
        rayon = Abs(*m\x - *n\x) + Abs(*m\y - *n\y)
        Repeat
          t = GiveWayLength(*m\x,*m\y, *n\x,*n\y, 0, rayon)
          rayon + 1
        Until t
          Graphe(i,j) = rayon-1
          Graphe(j,i) = rayon-1
      EndIf
    Next j
  Next i
EndProcedure

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
; Distance entre 2 pts
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 

Procedure GiveWayLength(x.w,y.w, tx.w,ty.w, exDir.b, rayon.b)
  If x = tx And y = ty
    ProcedureReturn(1)
  ElseIf rayon = 0
    ProcedureReturn(0)
  EndIf
  
  mur = Map(x,y-1)*#HAUT + Map(x+1,y)*#DROITE + Map(x,y+1)*#BAS + Map(x-1,y)*#GAUCHE
  
  If (mur & #GAUCHE)=0 And exDir <> #DROITE
    If GiveWayLength(x-1,y, tx,ty, #GAUCHE, rayon-1)
      ProcedureReturn 1
    EndIf
  EndIf
  If (mur & #DROITE)=0 And exDir <> #GAUCHE
    If GiveWayLength(x+1,y, tx,ty, #DROITE, rayon-1)
      ProcedureReturn 1
    EndIf
  EndIf
  If (mur & #BAS)=0 And exDir <> #HAUT
    If GiveWayLength(x,y+1, tx,ty, #BAS, rayon-1)
      ProcedureReturn 1
    EndIf
  EndIf
  If (mur & #HAUT)=0 And exDir <> #BAS
    If GiveWayLength(x,y-1, tx,ty, #HAUT, rayon-1)
      ProcedureReturn 1
    EndIf
  EndIf  
EndProcedure


; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
; Directiion du personnage
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 

Procedure.b GetWay(x.w,y.w, *tx.w,*ty.w)
  If Calk(x,y) <> Calk(PeekW(*tx),PeekW(*ty))
    If Link( Calk(PeekW(*tx),PeekW(*ty)), Calk(x,y) )
      SelectElement(Inter(), Link( Calk(PeekW(*tx),PeekW(*ty)), Calk(x,y) )-1)
        *n.Noeud = Inter()
        PokeW(*tx, *n\x)
        PokeW(*ty, *n\y)
    EndIf
  EndIf
  
  ProcedureReturn( FindDirection(x,y, PeekW(*tx),PeekW(*ty)) )
EndProcedure


; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
; Création du graphe des étapes
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 


Procedure AddToLinkingGraphe(cur.b, fin.b, deb.b, suiv.b, cpt.w)
  If Way(cur)
    ProcedureReturn(0)
  EndIf


  Way(cur) = 1
  
  If Graphe(cur,fin)
   ; on a trouvé un chemin
    If Graphe(fin,0) > cpt + Graphe(cur,fin)
      Graphe(fin,0) = cpt + Graphe(cur,fin)
      Link(fin, deb) = suiv
      Link(deb, fin) = cur
    Else
      If fin = 66
        Debug "Un chemin plus court existe (lg="+Str(Graphe(fin,0))+")"
      EndIf
    EndIf
  Else
   ; Pas de chemin direct
    For i = 1 To NbElts
      If Graphe(i,cur)
        AddToLinkingGraphe(i, fin, deb, suiv, cpt+Graphe(i,cur))
      EndIf
    Next i
  EndIf
  
  Way(cur) = 0
  
EndProcedure


Procedure MakeLinkingGraphe()
  For j = 1 To NbElts
    For i = 1 To NbElts
      If Graphe(i,j)
        Link(i,j) = i
      EndIf
      Graph2(i,j) = Graphe(i,j)
    Next i
  Next j
  
  For j = 1 To NbElts
    
    For i = 1 To NbElts

     ; réinitialisation des tableaux
      For in = 0 To NbElts
        Way(in) = 0: Graphe(in,0)=127
      Next in
    
     ; recherche
      If i<>j
        For k = 1 To NbElts
          If Graphe(i, j)
            AddToLinkingGraphe(Link(i,j), j, i, j, 0)
          ElseIf Graphe(k,i)
            AddToLinkingGraphe(Link(k,i), j, i, k, Graphe(k,i))
          EndIf
        Next k
      EndIf

      If j<>i
        Graph2(j,i)= Graphe(j,0)
        Graph2(i,j)= Graphe(j,0)
      EndIf
      
    Next i
  Next j

EndProcedure


; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
; Fonctions récursives pour trouver un chemin
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 

Procedure.b FindAWay(x,y, tx, ty, cpt.b, exDir.b)
  difX = (x - tx)
  difY = (y - ty)

  If x = tx And y = ty
    ProcedureReturn(15)
  ElseIf Abs(difX) + Abs(difY) > cpt
    ProcedureReturn(0)
  EndIf
  
  mur = Map(x,y-1)*#HAUT + Map(x+1,y)*#DROITE + Map(x,y+1)*#BAS + Map(x-1,y)*#GAUCHE
  

  
  tried.b = (exDir * 4) % 15
  
  If Abs(difX) > Abs(difY)
   ; perso trop à droite : <=
    If x > tx
      If (mur & #GAUCHE)=0 And tried <> #GAUCHE
        If FindAWay(x-1,y, tx, ty, cpt-1, #GAUCHE)
          ProcedureReturn(#GAUCHE)
        EndIf
      EndIf
      tried = #GAUCHE
   ;perso trop à gauche =>
    Else
      If (mur & #DROITE)=0 And tried <> #DROITE
        If FindAWay(x+1,y, tx, ty, cpt-1, #DROITE)
          ProcedureReturn(#DROITE)
        EndIf
      EndIf
      tried = #DROITE
    EndIf
  Else
   ; perso trop haut
    If y > ty
      If (mur & #HAUT)=0 And tried <> #HAUT
        If FindAWay(x,y-1, tx, ty, cpt-1, #HAUT)
          ProcedureReturn(#HAUT)
        EndIf
      EndIf
      tried = #HAUT
   ;perso trop bas ^
    Else
      If (mur & #BAS)=0 And tried <> #BAS
        If FindAWay(x,y+1, tx, ty, cpt-1, #BAS)
          ProcedureReturn(#BAS)
        EndIf
      EndIf
      tried = #BAS
    EndIf
  EndIf

  While (tried <> 15)
    c = Pow(2, Random(3))
    If (tried & c)=0
      Select c
        Case #HAUT
          If (mur & #HAUT)=0 And tried <> #HAUT
            If FindAWay(x,y-1, tx, ty, cpt-1, #HAUT)
              ProcedureReturn(#HAUT)
            EndIf
          EndIf
        
        Case #DROITE
          If (mur & #DROITE)=0 And tried <> #DROITE
            If FindAWay(x+1,y, tx, ty, cpt-1, #DROITE)
              ProcedureReturn(#DROITE)
            EndIf
          EndIf
          
        Case #BAS
          If (mur & #BAS)=0 And tried <> #BAS
            If FindAWay(x,y+1, tx, ty, cpt-1, #BAS)
              ProcedureReturn(#BAS)
            EndIf
          EndIf
        
        Case #GAUCHE
          If (mur & #GAUCHE)=0 And tried <> #GAUCHE
            If FindAWay(x-1,y, tx, ty, cpt-1, #GAUCHE)
              ProcedureReturn(#GAUCHE)
            EndIf
          EndIf
          
      EndSelect
      tried = tried | c
    EndIf
  Wend

    ProcedureReturn(0)
EndProcedure


Procedure.b FindDirection(x,y, tx, ty)
  If (x = tx) And (y = ty)
    ProcedureReturn(0)
  EndIf
  
  cpt = Abs(x - tx) + Abs(y - ty)
  Repeat
    r.b = FindAWay(x,y, tx,ty, cpt, 0)
    cpt + 1
    If cpt = 40
      End
    EndIf
  Until r
  ProcedureReturn(r)
EndProcedure

Si vous connaissez des sites qui expliquent bien comment faire des IA, je suis preneur.
Maintenant, je vais faire un système de WayPoints (pour des voitures)

@ ++

filperj · Message par **filperj** » jeu. 20/janv./2005 14:48

Attention, le 1er code peut se révéler très chiant à arrêter!!!

Les 2 autres j'ai pas essayé, ça m'a un peut découragé

J'ai 2 soupçons: setcursorpos_() en mode plein écran, et peut-être examinekeyboard() trop peu fréquent

lionel_om · Message par **lionel_om** » jeu. 20/janv./2005 16:00

Non, j'ai la solution

Le problème c'est qu'il ets dans une boucle récursive.
A moins de créer des threads ou des processes à part,il est donc impossible d'arréter le programme pendant.

Précision : pour déplacer le perso, il faut cliquer sur un autre endroit de la map.

Et le 1er code n'est pas le plus interressant, car c'ets le plus basique, et le moins performant. C'est surtout le dernier (3ème) qui présente un intérêt.

comtois · Message par **comtois** » ven. 21/janv./2005 12:34

pour les liens , tu as celui ci , qui est excellent , et il renvoit vers pleins d'autres sites.

http://www.policyalmanac.org/games/aStarTutorial.htm

et sur le site d'intelligence artificielle , il y a aussi un excellent article sur la recherche d'un chemin. C'est la description de l'algo utilisé dans un jeu commercial .

lionel_om · Message par **lionel_om** » ven. 21/janv./2005 13:29

oki merci, je V allez jeter un coup d'oeil cet aprem.
J'ai fais un programme de simulation (très légère et sans aléatoire) d'une voiture/moto sur un circuit (trajectoire et vitesse).

Je le posterai toute !!

lionel_om · Message par **lionel_om** » ven. 21/janv./2005 16:34

Voici un nouveau code, mais cette fois-ci pour simuler un voiture/moto de course sur un circuit. Son chemin est tracé avec des WaysPoints et les changements de vitesse sont définis par des zones (avec vitesse maximale).

Cette démo a trois modes :
* Edition des WayPoints
* Edition des Zones de vitesse
* Mode démo : la voiture tourne sur le circuit

Pour changer de mode, il suffit d'appuyer sur les touches Droite / Gauche.
Pour Quitter, il suffit d'appuyer sur Echap

En mode Edition, des actions sont possibles :
* WaysPoints :
clic gauche : nouveau WP
clic droit : supprimer le dernier WP
Espace : sauvegarder votre création dans le fichier "wp.wp"

* Zones
Pression clic gauche : début nouvelle zone
Relacher clic gauche : fin de la zone en cours
touches +/- : augmenter ou réduire la vitesse maximale de la zone
Espace : sauvegarder votre création dans le fichier "zone.z"

Voici le lien.
Cette archive contient un bitmap, ainsi que des fichiers de configurations.
@ ++

comtois · Message par **comtois** » ven. 21/janv./2005 16:40

Cool , ça marche bien

Il faudrait pouvoir cliquer sur un point et le déplacer , sans avoir à revenir en arrière .Idem pour les zones de vitesse , ça serait bien de pouvoir modifier chaque bloc en cliquant dessus.

lionel_om · Message par **lionel_om** » ven. 21/janv./2005 17:22

Oui c'est sur. Mais j'ai fais ca dans le cadre d'un exposé sur l'IA. Donc c'est juste pour montrer les principes. J'ai donc fais 2 mini éditeurs pour que je puisse présenter une version montrant bien les principes mis en place et leur efficacité.

lionel_om · Message par **lionel_om** » sam. 22/janv./2005 11:01

Merci comtois pour ce site. En effet c'est très intéressant et ca ne semble pas super compliquer à mettre en place.
Par contre celui la je ne vais pas le programmer tout de suite, mais je le présenterai pr mon expo !!!

Merci bien en tout K !!!

Et vous connaissez d'autres sites de ce genre sur l'IA ???

comtois · Message par **comtois** » lun. 24/janv./2005 20:17

ça c'est un des premiers codes que j'ai fait avec purebasic , je viens de le modifier légèrement , C'est le principe du A* que j'utilise.

Je suis en train de reprendre ce code entièrement en utilisant un arbre de recherche .
Et je vais simplifier celui ci pour comparer les vitesses de recherche entre les deux méthodes .

Tu peux déplacer le sprite de départ et la cible , construire des murs , visualiser les zones open (enregistré comme étant un point de passage possible) et les zones closed (explorées)

Code : Tout sélectionner

; ***********************************************************
; ** Comtois le 15/08/03 - Pathfinding pour Purebasic V0.2 **
; ***********************************************************
;Rapidement retouché le 24/01/05

; **********************************************************************
; ************************** Mode d'emploi *****************************
; **********************************************************************
; ** Touche [F1] pour Afficher les cases Closed  / Open               **
; ** Touche [F2] pour Afficher le chemin                              **
; ** Bouton Gauche de la souris ajoute un mur                         **
; ** Bouton Droit de la souris efface un mur                          **
; ** Bouton Gauche de la souris + la Touche [Shift] Déplace la cible  **
; ** Bouton Droit de la souris + la touche [Shift] Déplace le départ  **
; **********************************************************************


; --- Initialisation ---
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
  MessageRequester("Erreur", "Impossible d'initialiser DirectX 7 Ou plus", 0)
  End
EndIf

; --- Plein écran ---
#ScreenWidth = 800
#ScreenHeight = 600
#ScreenDepth = 16
If OpenScreen(#ScreenWidth,#ScreenHeight,#ScreenDepth,"Essai Pathfinding") = 0
  MessageRequester("Erreur", "Impossible d'ouvrir l'écran ", 0)
  End
EndIf
; --- Variables globales ---
Global ciblex,cibley,departx,departy, AffOpenClosed,affPath
affPath=1

; --- dimension du tableau et taille d'une case ---
#max_x=48
#max_y=48
#taille=12
; --- positionne la cible sur la grille ---
ciblex=1+Random(#max_x-2)
cibley=1+Random(#max_y-2)

; --- positionne le départ sur la grille ---
departx=1+Random(#max_x-2)
departy=1+Random(#max_y-2)

; --- pour la recherche du chemin ---
Dim map(#max_x,#max_y)
Dim open(#max_x+1,#max_y+1)
Dim parent(#max_x,#max_y,1)
Dim F(#max_x,#max_y)
Dim G(#max_x,#max_y)
Dim H(#max_x,#max_y)
Dim closed(#max_x+1,#max_y+1)
Dim path(#max_x*#max_y,1)

; ************************************************************************************
; ***                                  LES SPRITES                                 ***
; ************************************************************************************
Enumeration
#depart
#cible
#Souris
EndEnumeration

;/Départ
CreateSprite(#depart, #taille, #taille)
StartDrawing(SpriteOutput(#depart))
Circle(#taille/2,#taille/2,(#taille/2),RGB(255,255,255))
StopDrawing()
;/Cible
CreateSprite(#cible, #taille, #taille)
StartDrawing(SpriteOutput(#cible))
Circle(#taille/2,#taille/2,(#taille/2),RGB(255,55,18))
StopDrawing()
;/ Souris 
CreateSprite(#Souris, #taille, #taille)
StartDrawing(SpriteOutput(#Souris))
DrawingMode(4)
Box(1,1,#taille-1,#taille-1,RGB(100,200,255))
StopDrawing()

; ************************************************************************************
; ***                             LES PROCEDURES                                   ***
; ************************************************************************************
Procedure mur()
  Couleur=RGB(100,100,255)
  StartDrawing(ScreenOutput())
  For y=0 To #max_y
    For x=0 To #max_x
      If map(x,y)
        xa=x*#taille
        ya=y*#taille
        Box(xa + 1,ya + 1,#taille - 1,#taille - 1,Couleur)
      EndIf  
    Next x
  Next y
  StopDrawing()
EndProcedure
Procedure init()
  path(0,0) = 0
  ;faire le point sur ce qui est vraiment utile d'initialiser
  For a = 0 To #max_x
    For b = 0 To #max_y
      open(a,b) = 0
      parent(a,b,0) = 0
      F(a,b) = 0
      G(a,b) = 0
      H(a,b) = 0
      closed(a,b) = 0
    Next b
  Next a
EndProcedure

Procedure.w ChercheChemin()
  ; C'est mon interprétation du fameux A*
  init()
  If departx=ciblex And departy=cibley
    fin=2
  EndIf
  ; --- on met le point de départ dans la liste open ---
  open(departx,departy)=1
  ; --- calcul F = G + H pour la Case de départ ---
  F(departx,departy)=-1
  ; --- tant que la liste open n'est pas vide et tant qu'on a pas trouvé la cible
  While fin = 0
    ; --- on cherche la Case la plus avantageuse ( avec F le plus bas) ===
    meilleurF = 0
    For a = 0 To #max_x
      For b = 0 To #max_y
        ; --- si la Case est open ---
        If open(a,b) = 1 And closed(a,b) = 0 And (F(a,b) < meilleurF Or meilleurF = 0)
          meilleurF = F(a,b)
          x = a
          y = b
        EndIf
      Next b
    Next a
    ; --- il n'y a pas de chemin ---
    If meilleurF = 0
      fin = 2
    EndIf
    ; --- on met la Case trouvée dans la liste closed
    closed(x,y) = 1
    ; --- on teste les cases autour si fin = 0 ===
    ; dans cette version le déplacement se fait dans les huits directions
    ; il est possible d'ajouter un paramètre pour limiter les déplacements à 4 directions
    If fin = 0
      For a = x - 1 To x + 1
        For b = y - 1 To y + 1
          ; ---- si la Case est libre et n'a pas encore été traitée
          If a >= 0 And a <= #max_x And b >= 0 And b <= #max_y
            If map(a,b) = 0 And closed(a,b) = 0
              interdit = 0
              If a=x-1 And b=y-1 And map(x,y-1)=1 And map(x-1,y)=1 : interdit=1 : EndIf
              If a=x-1 And b=y+1 And map(x,y+1)=1 And map(x-1,y)=1 : interdit=1 : EndIf
              If a=x+1 And b=y-1 And map(x,y-1)=1 And map(x+1,y)=1 : interdit=1 : EndIf
              If a=x+1 And b=y+1 And map(x,y+1)=1 And map(x+1,y)=1 : interdit=1 : EndIf
              If interdit = 0
                ; calcule G pour la Case en cours de test ( à adapter selon le jeu)
                ; si la distance n'a pas d'importance , on peut se contenter de calculer
                ; le nombre de cases , donc de faire G = G(x,y) + 1
                If Abs(a - x) > 0 And Abs(b - y) > 0
                  G = 14 + G(x,y)
                Else
                  G = 10 + G(x,y)
                EndIf
                ; si la Case n'est pas dans la liste open
                If open(a,b) = 0 Or G < G(a,b)
                  open(a,b) = 1
                  parent(a,b,0) = x
                  parent(a,b,1) = y
                  ; --- calcule F = G + H
                  G(a,b) = G
                  distance = (Abs(ciblex-a) + Abs(cibley-b))*10
                  H(a,b) = distance
                  F(a,b) = G(a,b) + H(a,b)
                  ; --- la cible est trouvée ---
                  If a = ciblex And b = cibley
                    fin = 1
                    Break 2
                  EndIf
                EndIf
              EndIf
            EndIf
          EndIf
        Next b
      Next a
    EndIf
  Wend
  ProcedureReturn fin
EndProcedure
Procedure souris(ToucheShift)
  If  ExamineMouse()
    SX = MouseX() / #taille
    SY = MouseY() / #taille
    If SX >= 0 And SX <= #max_x And SY >= 0 And SY <= #max_y 
      If ToucheShift = 0
        If MouseButton(1) 
          map(SX,SY)=1     ;place un mur
        ElseIf MouseButton(2)
          map(SX,SY)=0    ; supprime un Mur 
        EndIf
      Else
        If MouseButton(1)  
          ciblex = SX : cibley = SY  ; place la cible 
        ElseIf MouseButton(2) 
          departx = SX : departy = SY ; place le départ 
        EndIf
      EndIf  
    EndIf   
  EndIf  
EndProcedure
Procedure AffOpenClosed()
  CoulOpen=RGB(200,255,200)
  CoulClosed=RGB(255,200,200)
  StartDrawing(ScreenOutput())
  For y=0 To #max_y
    For x=0 To #max_x
      xa=x*#taille
      ya=y*#taille
      If closed(x,y)
        Box(xa + 1,ya + 1,#taille - 1,#taille - 1,CoulClosed)
      ElseIf open(x,y)
        Box(xa + 1,ya + 1,#taille - 1,#taille - 1,CoulOpen)
      EndIf
    Next x
  Next y
  StopDrawing()
EndProcedure
Procedure affPath()
  If ChercheChemin()=1
    a=-1
    b=-1
    cx=ciblex
    cy=cibley
    Couleur=RGB(255,255,100)
    StartDrawing(ScreenOutput())
    While a <> departx Or b <> departy
      a = parent(cx,cy,0)
      b = parent(cx,cy,1)
      xa=(cx*#taille)+#taille/2
      ya=(cy*#taille)+#taille/2
      xb=(a*#taille)+#taille/2
      yb=(b*#taille)+#taille/2
      LineXY(xa,ya,xb,yb,Couleur)
      cx = a
      cy = b
    Wend
    StopDrawing()
  EndIf
EndProcedure
Procedure AffCadre()
  Couleur=RGB(255,255,255)
  StartDrawing(ScreenOutput())
  DrawingMode(4)
  Box(0,0,#taille*(#max_x+1),#taille*(#max_y+1),Couleur)
  StopDrawing()
EndProcedure
; ************************************************************************************
; ***                          BOUCLE PRINCIPALE                                   ***
; ************************************************************************************
Repeat
  ClearScreen(0,0,0)
  ;/ état du clavier 
  If ExamineKeyboard()
    If KeyboardReleased(#PB_Key_F1)
      AffOpenClosed=1-AffOpenClosed
    EndIf
    If KeyboardReleased(#PB_Key_F2)
      affPath=1-affPath
    EndIf
    ToucheShift = KeyboardPushed(#PB_Key_LeftShift) Or KeyboardPushed(#PB_Key_RightShift)
  EndIf
  ;/ Gestion de la souris 
  souris(ToucheShift)
  ;/affiche le fond 
  mur()
  AffCadre()
  If AffOpenClosed 
    AffOpenClosed() 
  EndIf
  ;/Lance la recherche 
  If affPath
    affPath()
  EndIf
  ;/Affiche les sprites
  DisplayTransparentSprite(#Souris,MouseX() - #taille / 2,MouseY() - #taille / 2)
  DisplayTransparentSprite(#cible,ciblex * #taille,cibley * #taille)
  DisplayTransparentSprite(#depart,departx * #taille,departy * #taille)
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
End

lionel_om · Message par **lionel_om** » mar. 25/janv./2005 10:56

Oki merci comtois. Par contre je suis sur que sur des chemins longs, mon algo (le dernier, avec la méthode maths) est meilleurs que ke le A*, car ts les calculs sont faits avant : j'ai une matrice qui me dis que pour aller d'une zone à l'autre, je dois passer par cette zone ci. Puis quand je suis dans la zone en question, il faut ensuite passer par cette zone-là, etc..
Donc je n'ai qu'à faire une récursivité à la con sur une courte distance.
De même pour les chemins non directs, le A* vas dabord esssayer par le chemin le plus direct (à vol d'oiseau) - normal koi !!! Tandis que le mien connais déja ts les points intermédiaires.

Par contre si la carte ne se présente pas sous forme de "sentiers", le A* devrait se révéler meilleur.
Et si le décor est modifiable là, je peut remballer le mien !!!

Je testerai ton algo ce soir

comtois · Message par **comtois** » mar. 25/janv./2005 12:28

je n'ai pas le temps de développer une réponse , mais je peux juste te dire que A* est reconnu comme l'algo le plus performant dans la recherche d'un chemin . Seul il ne peut pas tout faire ,il faut bien sûr le seconder avec d'autres fonctions qui vont prémacher le travail , par exemple isoler des zones inaccessibles , ça sera toujours ça que A* n'aura pas à traiter .
On peut décomposer son jeu en plusieurs map , et A* se charge de trouver le chemin pour passer d'une map à l'autre , ça limite la taille du tableau pour les recherches . et ensuite ,tu peux utiliser A* pour te déplacer dans une map particulière .

tu verras un exemple concret de ce que je te raconte sur le site de la vie artificielle .

Et bien sûr dans mon code , tu peux modifier le terrain à volonté

comtois · Message par **comtois** » mar. 25/janv./2005 17:59

un article très intéressant à lire

http://www.vieartificielle.com/article/ ... cle&id=179

Extrait du site que je t'avais donné

vous trouverez parfois certains codes qui sont dit A*, mais ne le sont pas. Pour utiliser la méthode A*, il faut absolument inclure les notions abordées précedemment, et plus précisemment la "liste ouverte" et la "liste fermée", ainsi que le calcul des coûts F, G et H. Il existe beaucoup d'algorithmes de pathfinding, mais ces autres méthodes ne sont pas A*, qui est générallement considéré comme étant le meileur de tous. Bryan Stout aborde beaucoup d'entre eux dans cet article, incluant leurs avantages et inconvénients. Parfois, une alternative est mailleure dans certaine circonstances, mais réflechissez à ce dans quoi vous mettez les pieds!

lionel_om · Message par **lionel_om** » mer. 26/janv./2005 16:24

Oui c'est sur. En principe de récursion le A* est le plus rapide.
Pour l'optimiser il faut effectivement le coupler avec d'autres moyens afin d'éviter de faire des calculs dans des zones inaccessibles ou je ne c koi ...

J'avais tout lus du premier site ke tu m'avais passé (ac la méthode Manhattan, etc...), par contre celui la à l'R bcp plus long et je n'ai pas bcp le tps en ce moment.

Mais c'ets vrai que ton éditeur ramé dès que la distance devenait importante plus en ajoutant des murs. Je n'ai pas testé le cas ou l'objectif était inatteignable, mais bon ce n'est pas le but

Merci en tt K pr ts ces éléments