A*-agent

Übersicht BlitzMax, BlitzMax NG Codearchiv & Module

Neue Antwort erstellen

Firstdeathmaker

Betreff: A*-agent

 BeitragMo, Feb 05, 2007 11:03
Antworten mit Zitat
Benutzer-Profile anzeigen
A-Stern Agent (2)

Nach dem A-Stern Prinzip funktionierende halb objekt orientierte pathfinding Routine. Sie ist deshalb so schnell, weil sie Schrittweise funktioniert und wie Wasser alle moeglichen Wege durchspuehlt. Sobald der Zielpunk "Nass" wird, kann der Weg zurueck verfolgt werden und ist somit der schnellst-moegliche ohne ALLE moeglichen Kombinationen druchgehen zu muessen.

Bei einer Map von 80x60 Feldern braucht die Funktion auf meinem PC (1,87 ghz) im Durchschnitt nur 1.85 ms um den Weg von oben Links nach unten rechts zu finden.

Features:
- Relativ schnell
- Einfach Richtungen vorzugeben


Steuerung:

Leertaste: Pathfinding starten
Linke Maustaste: Hindernis setzen
Rechte Maustaste: Hindernis entfernen

Im Code: Unter Type TPathAgent\Method live() kann man die erlaubten Schrittrichtungen festlegen.
Man kann also festlegen ob der Weg schraeg verlaufen darf (ObenLinks/ObenRechts/UntenLinks/UntenRechts) oder nur gerade (Rauf/Runter/Rechts/Links) oder was man eben will (z.B. Schachregeln fuer Springer).


A-Stern Agent Schau
Dieser Code ist nicht so optimiert, dafuer zeigt er aber besser wie der Algorithmus arbeitet.

Code: [AUSKLAPPEN]
SuperStrict
AppTitle = "A-Stern Agent 2"
' By Christian Geissler, 29.1.2007
Const C_VERSION:Float = 1.0
Const DEBUG:Byte = False

Global GFX_X:Int   = 800
Global GFX_Y:Int    = 600
Global GFX_DEEPTH:Byte = 32
Global GFX_FLIP:Byte = 0


Graphics GFX_X , GFX_Y , GFX_DEEPTH , GFX_FLIP

'Init Data

Global BOARD_x:Int = GFX_X/10
Global BOARD_y:Int = GFX_Y/10
Global BOARD:TField[BOARD_x , BOARD_y]
Global BOARD_Fw:Float = GFX_X / (BOARD_x) '(Field Width)
Global BOARD_Fh:Float = GFX_Y / (BOARD_y)'(Field Height)
BOARD_x:- 1
BOARD_y:- 1
For Local _x:Int = 0 To BOARD_x
For Local _y:Int = 0 To BOARD_y
   BOARD:TField[_x,_y] = New TField
Next
Next

BOARD[BOARD_x,BOARD_y].Mauer = 0
Local path:TList

Repeat
   If KeyHit(KEY_SPACE)
      Local t:Int = MilliSecs()
      Local n:Int = 1
      For Local i:Int = 1 To n
         path:TList = TPathAgent.GetPath:TList(0 , 0 , BOARD_x , BOARD_y)
      Next
   EndIf
   
   If MouseDown(1) BOARD[MouseX() / BOARD_Fw , MouseY() / BOARD_Fh].Mauer = True
   If MouseDown(2) BOARD[MouseX() / BOARD_Fw , MouseY() / BOARD_Fh].Mauer = False
   
   Cls
   BOARD_draw()
   If path TPathCoordinate.Draw(path)
   Flip
Until KeyHit(KEY_ESCAPE)
End


'Board
Function BOARD_draw()
   For Local _x:Int = 0 To BOARD_x
   For Local _y:Int = 0 To BOARD_y
      
      Local _gpx:Int = _x*BOARD_Fw
      Local _gpy:Int = _y * BOARD_Fh
      Local _gpx2:Int = _gpx + BOARD_Fw
      Local _gpy2:Int = _gpy + BOARD_Fh
      
      Local f:TField = BOARD[_x,_y]
      
      
      DrawLine _gpx , _gpy , _gpx2 , _gpy
      DrawLine _gpx2 , _gpy , _gpx2 , _gpy2
      DrawLine _gpx , _gpy2 , _gpx2 , _gpy2
      DrawLine _gpx , _gpy , _gpx , _gpy2
      
      If f.Mauer DrawRect _gpx+2, _gpy+2, BOARD_Fw-3, BOARD_Fh-3
   Next
   Next
End Function

Function BOARD_ColorField(_x:Int , _y:Int)
   Local _gpx:Int = _x*BOARD_Fw
   Local _gpy:Int = _y * BOARD_Fh
   Local _gpx2:Int = _gpx + BOARD_Fw
   Local _gpy2:Int = _gpy + BOARD_Fh
   DrawRect _gpx+3, _gpy+3, BOARD_Fw-5, BOARD_Fh-5
End Function

Type TField
   Field Mauer:Byte
   
   Method New()
      self.Mauer = (Rand(0,2) = 0)
   End Method
End Type

'Pathfinding

Type TPathAgent
   Global TmpRaster:Byte[,]
   Global Target:Int[2]
   Global TargetPath:TList
   
   Field x:Int
   Field y:Int
   Global List:TList
   Field Link:TLink
   Field Father:TPathAgent
   
   Function GetPath:TList(x1:Int , y1:Int , x2:Int , y2:Int)
      Local timer:Int = MilliSecs()
      'Init
      TmpRaster:Byte = New Byte[BOARD_x +1, BOARD_y + 1]
      TargetPath = Null
      Target[0] = x2
      Target[1] = y2
      List = New TList
      
      Local agent:TPathAgent = New TPathAgent
      agent.CreateChild(x1 , y1)
      
      Repeat
         For Local pa:TPathAgent = EachIn List
            pa.live()
            If TargetPath
               Return TargetPath
            EndIf
         Next
      Until 0 = CountList(List) 'Wenn keine mehr jung sind
   End Function   
   
   Method CreateChild:Byte(x:Int , y:Int)    
      If TmpRaster[x , y] Return Null
      If BOARD[x , y].Mauer Return Null
      
      Local pa:TPathAgent = New TPathAgent
      pa.Father = Self
      pa.Link = List.AddFirst(pa)
      pa.x = x
      pa.y = y
      TmpRaster[x,y] = True
      Return True
   End Method
   
   Method live:Byte()'Returns if young
      If x = Target[0] And y = Target[1]
         Local l:TList = New TList
         l.AddFirst(TPathCoordinate.Create(x , y))
         If Father Father.GotPath(l)
      Else
         'Schr?e Schritte
         Rem
         If x < BOARD_x And y < BOARD_y CreateChild(x + 1 , y + 1)
         If x > 0 And y < BOARD_y CreateChild(x - 1 , y + 1)
         If x > 0 And y > 0 CreateChild(x - 1 , y - 1)
         If x < BOARD_x And y > 0 CreateChild(x + 1 , y - 1)
         End Rem
      
         'Gerade Schritte
         If x < BOARD_x CreateChild(x + 1 , y)
         If x > 0 CreateChild(x - 1 , y)
         If y < BOARD_y CreateChild(x , y + 1)
         If y > 0 CreateChild(x , y - 1)
      EndIf
      
      RemoveLink (self.Link)
      Return True   
   End Method
   
   Method GotPath(l:TList)
      If Father
         l.AddFirst(TPathCoordinate.Create(x,y))
         Father.GotPath(l)
      EndIf
      TargetPath = l
   End Method
      
End Type

Type TPathCoordinate
   Field X:Int
   Field Y:Int
   
   Function Create:TPathCoordinate(x:Int , y:Int)
      Local pc:TPathCoordinate = New TPathCoordinate
      pc.X = x
      pc.Y = y
      Return pc
   End Function
   
   Function Draw(l:TList)
      SetColor 0,0,255
      For Local pc:TPathCoordinate = EachIn l
         BOARD_ColorField(pc.X , pc.Y)
      Next
      SetColor 255,255,255
   End Function
End Type


Code: [AUSKLAPPEN]
SuperStrict
AppTitle = "A-Stern Agent Schau"

Const C_VERSION:Float = 0.1
Const DEBUG:Byte = True

Global GFX_X:Int   = 800
Global GFX_Y:Int    = 600
Global GFX_DEEPTH:Byte = 32
Global GFX_FLIP:Byte = 0


Graphics GFX_X , GFX_Y , GFX_DEEPTH , GFX_FLIP

'Init Data

Global BOARD_x:Int = 80
Global BOARD_y:Int = 60
Global BOARD:TField[BOARD_x , BOARD_y]
Global BOARD_Fw:Float = GFX_X / BOARD_x '(Field Width)
Global BOARD_Fh:Float = GFX_Y / BOARD_y'(Field Height)
BOARD_x:- 1
BOARD_y:- 1
For Local _x:Int = 0 To BOARD_x
For Local _y:Int = 0 To BOARD_y
   BOARD:TField[_x,_y] = New TField
Next
Next

BOARD[79,59].Mauer = 0
'Local tp:TPath = TPath.Get(0 , 0 , 20 , 20)
Local path:TList

Repeat
   If KeyHit(KEY_SPACE)
      path:TList = TPathAgent.GetPath:TList(0 , 0 , 79 , 59)
   EndIf
   
   If MouseDown(1) BOARD[MouseX() / BOARD_Fw , MouseY() / BOARD_Fh].Mauer = True
   If MouseDown(2) BOARD[MouseX() / BOARD_Fw , MouseY() / BOARD_Fh].Mauer = False
   
   Cls
   BOARD_draw()
   If path TPathCoordinate.Draw(path)
   Flip
Until KeyHit(KEY_ESCAPE)
End


'Board
Function BOARD_draw()
   For Local _x:Int = 0 To BOARD_x
   For Local _y:Int = 0 To BOARD_y
      
      Local _gpx:Int = _x*BOARD_Fw
      Local _gpy:Int = _y * BOARD_Fh
      Local _gpx2:Int = _gpx + BOARD_Fw
      Local _gpy2:Int = _gpy + BOARD_Fh
      
      Local f:TField = BOARD[_x,_y]
      
      
      DrawLine _gpx , _gpy , _gpx2 , _gpy
      DrawLine _gpx2 , _gpy , _gpx2 , _gpy2
      DrawLine _gpx , _gpy2 , _gpx2 , _gpy2
      DrawLine _gpx , _gpy , _gpx , _gpy2
      
      If f.Mauer DrawRect _gpx+2, _gpy+2, BOARD_Fw-3, BOARD_Fh-3
   Next
   Next
End Function

Function BOARD_ColorField(_x:Int , _y:Int)
   Local _gpx:Int = _x*BOARD_Fw
   Local _gpy:Int = _y * BOARD_Fh
   Local _gpx2:Int = _gpx + BOARD_Fw
   Local _gpy2:Int = _gpy + BOARD_Fh
   DrawRect _gpx+3, _gpy+3, BOARD_Fw-5, BOARD_Fh-5
End Function

Type TField
   Field Mauer:Byte
   
   Method New()
      self.Mauer = (Rand(0,2) = 0)
   End Method
End Type

'Pathfinding

Type TPathAgent
   Global TmpRaster:Byte[,]
   Global Target:Int[2]
   Global TargetPath:TList
   
   Field x:Int
   Field y:Int
   Global List:TList
   Field Link:TLink
   Field Father:TPathAgent
   Field Old:Byte
   
   Function GetPath:TList(x1:Int , y1:Int , x2:Int , y2:Int)
      Local timer:Int = MilliSecs()
      'Init
      TmpRaster:Byte = New Byte[BOARD_x +1, BOARD_y + 1]
      TargetPath = Null
      Target[0] = x2
      Target[1] = y2
      List = New TList
      
      Local agent:TPathAgent = New TPathAgent
      agent.CreateChild(x1 , y1)
      
      Local c:Int
      Repeat
         c = CountList(List)
         If DEBUG
            Cls
            BOARD_draw()
         EndIf
         For Local pa:TPathAgent = EachIn List
            c:-pa.live()
            If TargetPath
               DebugLog "Time: " + (MilliSecs() - timer)
               Return TargetPath
            EndIf
            SetColor 255,255,0
            If DEBUG BOARD_ColorField(pa.X , pa.Y)
            SetColor 255,255,255
         Next
         If DEBUG Flip
         If KeyHit(KEY_ESCAPE) end
      Until c = CountList(List) 'Wenn keine mehr jung sind
   End Function   
   
   Method CreateChild:Byte(x:Int , y:Int)
      
      SetColor 255,0,0
      If DEBUG BOARD_ColorField(X , Y)
      
      If TmpRaster[x , y] Return Null
      If BOARD[x , y].Mauer Return Null
      
      SetColor 0,255,0
      If DEBUG BOARD_ColorField(X , Y)
      SetColor 255,255,255
      
      Local pa:TPathAgent = New TPathAgent
      pa.Father = Self
      pa.Link = List.AddFirst(pa)
      pa.x = x
      pa.y = y
      TmpRaster[x,y] = True
      Return True
   End Method
   
   Method live:Byte()'Returns if young
      If Not Old
         If x = Target[0] And y = Target[1]
            Local l:TList = New TList
            l.AddFirst(TPathCoordinate.Create(x , y))
            If Father Father.GotPath(l)
         Else
         
            'Schr?e Schritte
            Rem
               If x < BOARD_x And y < BOARD_y CreateChild(x + 1 , y + 1)
               If x > 0 And y < BOARD_y CreateChild(x - 1 , y + 1)
               If x > 0 And y > 0 CreateChild(x - 1 , y - 1)
               If x < BOARD_x And y > 0 CreateChild(x + 1 , y - 1)
            End Rem
            
            
            
            'Gerade Schritte
            'rem
               If x < BOARD_x CreateChild(x + 1 , y)   'Right
               If x > 0 CreateChild(x - 1 , y)         'Left
               If y < BOARD_y CreateChild(x , y + 1)   'Down
               If y > 0 CreateChild(x , y - 1)         'Up
            'End Rem

            
            'Schach-Springer Bewegung
            Rem
               If x + 1 < BOARD_x
                  If y < BOARD_y CreateChild(x + 2 , y + 1)
                  If y > 0 CreateChild(x + 2 , y - 1)
               EndIf
               If x - 1 > 0
                  If y < BOARD_y CreateChild(x - 2 , y + 1)
                  If y > 0 CreateChild(x - 2 , y - 1)
               EndIf
               If y + 1 < BOARD_y
                  If x < BOARD_x CreateChild(x + 1 , y + 2)
                  If x > 0 CreateChild(x - 1 , y + 2)
               EndIf
               If y - 1 > 0
                  If x < BOARD_x CreateChild(x + 1 , y - 2)
                  If x > 0 CreateChild(x - 1 , y - 2)
               EndIf
            End Rem
            
            
            self.Old = True
         EndIf
         Return True   
      EndIf
      Return False
   End Method
   
   Method GotPath(l:TList)
      If Father
         l.AddFirst(TPathCoordinate.Create(x,y))
         Father.GotPath(l)
      EndIf
      TargetPath = l
   End Method
      
End Type

Type TPathCoordinate
   Field X:Int
   Field Y:Int
   
   Function Create:TPathCoordinate(x:Int , y:Int)
      Local pc:TPathCoordinate = New TPathCoordinate
      pc.X = x
      pc.Y = y
      Return pc
   End Function
   
   Function Draw(l:TList)
      SetColor 0,0,255
      For Local pc:TPathCoordinate = EachIn l
         BOARD_ColorField(pc.X , pc.Y)
      Next
      SetColor 255,255,255
   End Function
End Type
www.illusion-games.de
Space War 3 | Space Race | Galaxy on Fire | Razoon
Gewinner des BCC #57 User posted image

Neue Antwort erstellen


Übersicht BlitzMax, BlitzMax NG Codearchiv & Module

Nach Oben

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group