Pathfinding aufbessern

Übersicht BlitzBasic Allgemein

Neue Antwort erstellen

coolo

Betreff: Pathfinding aufbessern

 BeitragSa, Dez 29, 2007 13:15
Antworten mit Zitat
Benutzer-Profile anzeigen
Hallo,
Ich habe jetzt mein 4 Wege Pathfinding fertig gemacht, es funktioniert nach dem A* Algo Prinzip. Der erste der Ankommt ist meiner Meinung nach meistens der Kürzeste. Nun habe ich das Problem, das das Wegpunkte setzen bei einer 20*20 Map ohne Hindernisse 10 sekunden dauert. Viel zu langsam für ein Strategie spiel. Wie kann ich es schneller machen.

Edit: neuer code:
Code: [AUSKLAPPEN]

Graphics 1024, 768 , 16, 2
SetBuffer BackBuffer()
Global sx=1
Global sy=1
Global zx=19
Global zy=19
Global mx=20
Global my=20
Global Tileset = LoadAnimImage("tile.bmp",32,32,0,1)
Global s = LoadImage("s.bmp")
Global z = LoadImage("z.bmp")
Global pun = LoadImage("punkt.bmp")
Global i
Global maxziel=0
Type wegpunkt
Field x,y,wegkosten
Field verarbeitet,fertig
Field ax,ay
End Type
Type node
Field x,y
End Type
Color 255,255,255
Global w.wegpunkt
Global n.node
Dim map(20,20)
Data 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
Data 1,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,1,0,0,0,1
Data 1,0,0,0,0,0,0,0,0,0,0,1,0,1,0,0,1,0,0,0,1
Data 1,0,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,0,0,0,1
Data 1,0,0,0,0,0,0,0,0,0,0,1,0,1,1,1,1,1,1,0,1
Data 1,0,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,0,0,0,1
Data 1,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,1,1,1,1,1
Data 1,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,1
Data 1,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,0,1
Data 1,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,0,0,1
Data 1,0,0,0,0,0,0,0,0,1,1,1,1,1,0,1,1,1,1,1,1
Data 1,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,0,0,1
Data 1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,1
Data 1,0,0,0,1,0,0,0,0,1,0,0,0,0,0,0,1,0,1,0,1
Data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
Data 1,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,1
Data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
Data 1,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1
Data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
Data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
Data 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
Dim pathmap(mx,my)

For y = 0 To 20
   For x = 0 To 20
      Read map(x,y)
   Next
Next
Repeat
   Cls
   For x = 0 To 20
      For y = 0 To 20
         If map(x,y)=0 Then
            DrawBlock Tileset,x*32,y*32
         EndIf
      Next
   Next
   m11x=MouseX()
   m11y=MouseY()
   If MouseDown(1) Then map(m11x/32,m11y/32)=1
   If MouseDown(2) Then map(m11x/32,m11y/32)=0
   If KeyHit(2) Then
      wuff1=MilliSecs()
      If findpath(sx,sy,zy,zx,mx,my) Then wuff2=MilliSecs()
   EndIf
   Text 0,0,wuff2-wuff1
   
For n=Each node
   DrawBlock z,n\x*32,n\y*32
Next

DrawImage s,sx*32,sy*32
DrawImage z,zx*32,zy*32


Flip
Until KeyHit(1)
End
Function findpath(sx,sy,zy,zx,mx,my)
   w=New wegpunkt
   x1=1
   y1=1
   w\x=1
   w\y=1
   w\wegkosten=0
   Repeat
      If maxziel=0 Then
         For w=Each wegpunkt
            If w\verarbeitet=0
               x1=w\x
               y1=w\y
               wegk=w\wegkosten
               w\verarbeitet=1
               For i=1 To 4
                  w=New wegpunkt
                  w\wegkosten=wegk+1
                  If i=1 Then
                     If map(x1+1,y1)=0 And pathmap(x1+1,y1)=0 Then
                        w\x=x1+1
                        w\y=y1
                        w\ax=x1
                        w\ay=y1
                        pathmap(w\x,w\y)=1
                        If w\x=zx And w\y=zy Then
                           maxziel=w\wegkosten
                           altx=w\ax
                           alty=w\ay
                           n=New node
                           n\x=w\x
                           n\y=w\y
                        EndIf
                        
                     Else
                        Delete w.wegpunkt
                     EndIf
                  ElseIf i=2
                     If map(x1-1,y1)=0 And pathmap(x1-1,y1)=0   Then
                        w\x=x1-1
                        w\y=y1
                        w\ax=x1
                        w\ay=y1
                        pathmap(w\x,w\y)=1
                        If w\x=zx And w\y=zy Then
                           maxziel=w\wegkosten
                           altx=w\ax
                           alty=w\ay
                           n=New node
                           n\x=w\x
                           n\y=w\y
                        EndIf
                        
                        
                     Else
                        Delete w.wegpunkt
                     EndIf
                  ElseIf i=3
                     If map(x1,y1+1)=0 And pathmap(x1,y1+1)=0  Then
                        w\x=x1
                        w\y=y1+1
                        w\ax=x1
                        w\ay=y1
                        pathmap(w\x,w\y)=1
                        If w\x=zx And w\y=zy Then
                           maxziel=w\wegkosten
                           altx=w\ax
                           alty=w\ay
                           n=New node
                           n\x=w\x
                           n\y=w\y
                        EndIf
                        
                     Else
                        Delete w.wegpunkt
                     EndIf
                  Else
                     If map(x1,y1-1)=0 And pathmap(x1,y1-1)=0  Then
                        w\x=x1
                        w\y=y1-1
                        w\ax=x1
                        w\ay=y1
                        pathmap(w\x,w\y)=1
                        If w\x=zx And w\y=zy Then
                           maxziel=w\wegkosten
                           altx=w\ax
                           alty=w\ay
                           n=New node
                           n\x=w\x
                           n\y=w\y
                        EndIf
                     Else
                        Delete w.wegpunkt
                     EndIf
                  EndIf
                  
               Next
               
            EndIf
         Next
         
         For w=Each wegpunkt
         
            Text w\x*32,w\y*32,w\wegkosten
         Next
      Else
         For w=Each wegpunkt
            If altx=w\x And alty=w\y Then
               n=New node
               n\x=w\x
               n\y=w\y
               altx=w\ax
               alty=w\ay
               If w\x=sx And w\y=sy Then
                  Return True
               EndIf
            EndIf
         Next
         
      EndIf
      
   Forever
End Function




Download: hier
http://programming-with-design.at/ <-- Der Preis ist heiß!
That's no bug, that's my project!
"Eigenzitate sind nur was für Deppen" -Eigenzitat
  • Zuletzt bearbeitet von coolo am Sa, Dez 29, 2007 14:59, insgesamt 2-mal bearbeitet

BladeRunner

Moderator

BeitragSa, Dez 29, 2007 13:28
Antworten mit Zitat
Benutzer-Profile anzeigen
Dein Fehler ist dass Du den Weg in der Hauptschleife berechnen läßt in der auch alles gezeichnet wird.
Du musst die Wegfindung separieren in einer Funktion und EINMALIG laufen lassen.
So wie es bislang ist läuft ein Berechnungsschritt, dann wird alles neu gezeichnet, berechnung, neuzeichnen, bere....

Das ist lahm, weil es einfach Zeit kostet ständig den screen neu zu bemalen.
Zu Diensten, Bürger.
Intel T2300, 2.5GB DDR 533, Mobility Radeon X1600 Win XP Home SP3
Intel T8400, 4GB DDR3, Nvidia GF9700M GTS Win 7/64
B3D BMax MaxGUI
Stolzer Gewinner des BAC#48, #52 & #92

coolo

 BeitragSa, Dez 29, 2007 14:31
Antworten mit Zitat
Benutzer-Profile anzeigen
Vielen Dank BladeRunner! Jetzt brauchts statt 8 sekunden, 3875 Millisekunden. Eine deutliche Verbesserung. Oder kann man da noch was schneller machen? Das blöde ist nur, Es sucht jeden Punkt aus, gibts da auch ne Möglichkeit das es bei Sackgassen nicht rein geht? dann wäre es ja noch schneller.

Edit: Gibts so ne Art Multitasking? Weil während der sucht wird das ganze Programm aufgehalten. Gibts da ne möglichkeit?
http://programming-with-design.at/ <-- Der Preis ist heiß!
That's no bug, that's my project!
"Eigenzitate sind nur was für Deppen" -Eigenzitat

BladeRunner

Moderator

BeitragSa, Dez 29, 2007 15:13
Antworten mit Zitat
Benutzer-Profile anzeigen
Wenn er immer alle Wege absucht hast Du einen Fehler in deiner Implementierung - normalerweise sucht AStar immer den kürzesten Weg, und wenn nicht grade der kürzeste Weg so verschachtelt liegt dass alle Felder durchlaufen werden müssen sollte er da Ausnahmen machen.
Such mal im BMax-Codearchiv nach Astar, dort ist eine Implementierung von mir. Und wenn ich nicht irre gibt es auch mehrere BB-Versionen im BB-Codearchiv.
Eine 'stückweise' Berechnung wäre natürlich auch machbar, du müsstest nur die erzielten Ergebnisse nach xx millisecs zwischenspeichern und beim nächsten Funktionsaufruf weitermachen.
Zu Diensten, Bürger.
Intel T2300, 2.5GB DDR 533, Mobility Radeon X1600 Win XP Home SP3
Intel T8400, 4GB DDR3, Nvidia GF9700M GTS Win 7/64
B3D BMax MaxGUI
Stolzer Gewinner des BAC#48, #52 & #92

Casiopaya

 BeitragSa, Dez 29, 2007 15:34
Antworten mit Zitat
Benutzer-Profile anzeigen
Hi

hmm, ich kenne mich nicht näher mit A* aus, allerdings wundert es mich schon sehr, dass er bei einer derart geringen Knotenanzahl schon so lange braucht?

Obwohl er theoretisch dem Dijkstra-Algorithmus überlegen ist kenne ich doch Realisierungen von Dijkstra welche 100 mal und noch mehr schneller sind.

Probier mal http://de.wikipedia.org/wiki/Dijkstra-Algorithmus nachzuprogrammieren. Der Algo besitzt quadratische Komplexität (wenn man es gut anstellt), sodass dein Beispiel in einer Millisekunde gelöst sein sollte.

Grüße

coolo

 BeitragSa, Dez 29, 2007 16:15
Antworten mit Zitat
Benutzer-Profile anzeigen
mhmm habs mir durchgelesen... Ziemlich Kompliziert. Werd beim A* bleiben. Aber ich glaube das liegt daran, das ich keine Wegabschätzung eingebaut habe->sucht jede Nische ab.
http://programming-with-design.at/ <-- Der Preis ist heiß!
That's no bug, that's my project!
"Eigenzitate sind nur was für Deppen" -Eigenzitat

kriD

 BeitragSa, Dez 29, 2007 17:01
Antworten mit Zitat
Benutzer-Profile anzeigen
denn isses aber doch kein A*, wenn er jede Nische absucht....

MfG kriD
Wenn ich du wäre, wäre ich lieber ich!
 

Dreamora

 BeitragSa, Dez 29, 2007 17:07
Antworten mit Zitat
Benutzer-Profile anzeigen
Es ist bestenfalls tiefensuche und dann noch sehr ineffizient implementiert.

Solange du nicht mit 3 verschiedenen Types arbeitest, nämlich abgearbeitete Knoten, aktive Knoten (aktueller Rand) und inaktive Knoten (ausserhalb des randes und noch nicht abgearbeitet) hast du da keine Chance irgend etwas effizientes hinzubekommen.

Aber glücklicherweise hats im Codearchive eine funktionierende A* Implementation.
Ihr findet die aktuellen Projekte unter Gayasoft und könnt mich unter @gayasoft auf Twitter erreichen.

Casiopaya

 BeitragSa, Dez 29, 2007 18:34
Antworten mit Zitat
Benutzer-Profile anzeigen
Sodele,

also ich hab nun mal aus Intererre selbst den Dijkstra programmiert. Ich habe deine 3800 ms nun schonmal auf 13 ms runtergebrochen Very Happy Very Happy Very Happy

Das macht nen Faktor 300, allerdings benötigt das Erstellen der Entfernungsmatrix etwa ebensoviel Zeit (13 ms). Da dies allerdings nur einmal passiert sollte man die Zeit rausrechnen. Wenn also einmal die Entfernungsmatrix erstellt ist kannst du beliebig oft mit verschiedenen Start- und Endpunkten suchen. Liegt im großen und ganzen daran, dass die LEvel-Darstellung in einem Data-Feld sehr ungünstig für eine weitere Verarbeitung ist.

Ich habe dir an 3 Stellen im Code TODOs reingemacht, damit du das Level ändern kannst.

Code: [AUSKLAPPEN]
; Copyright 2007 Vasilios Grigas (Casiopaya)


Time1% = MilliSecs()
Graphics 1024, 768, 16, 2

Global NODE_COUNT%

Global StartNode%, EndNode%


; TODO Leveldimension angeben, beginnend bei 1x1:
Global MapLenght% = 21, MapHeight% = 21
; END TODO


NODE_COUNT% = MapLenght% * MapHeight%
; Initialisieren der Felder:
Dim Distances(NODE_COUNT-1, NODE_COUNT-1)
Dim ForeRunner(NODE_COUNT-1)
Dim InAktiv(NODE_COUNT-1)


Dim Worked(NODE_COUNT%-1)
For i = 0 To NODE_COUNT%-1
  For j = 0 To NODE_COUNT%-1
    Distances(i, j) = -1
  Next
Next


Dim Map(MapHeight%-1, MapLenght%-1)
; TODO Angeben der Kanten: (Dimensionen müssen stimmen!)
Data 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
Data 1,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,1,0,0,0,1
Data 1,0,0,0,0,0,0,1,0,0,0,1,0,1,0,0,1,0,0,0,1
Data 1,0,0,0,0,0,0,1,0,0,0,1,0,1,0,0,0,0,0,0,1
Data 1,0,0,0,0,0,0,1,0,0,0,1,0,1,1,1,1,1,1,0,1
Data 1,0,0,0,0,0,0,1,0,0,0,1,0,1,0,0,0,0,0,0,1
Data 1,0,0,0,0,0,0,1,0,0,0,0,0,1,0,1,1,1,1,1,1
Data 1,0,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,1
Data 1,0,0,0,0,0,0,1,0,0,0,0,0,1,1,1,1,1,1,0,1
Data 1,0,0,0,0,0,0,1,0,1,0,0,0,1,0,0,0,0,0,0,1
Data 1,0,0,0,0,0,0,1,0,1,1,1,1,1,0,1,1,1,1,1,1
Data 1,0,0,0,0,0,0,1,0,1,0,0,0,1,0,0,0,0,0,0,1
Data 1,0,0,0,0,0,0,1,0,1,0,0,0,0,0,0,0,0,0,0,1
Data 1,0,0,0,1,1,1,1,0,1,0,0,0,0,0,0,1,0,1,0,1
Data 1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,1
Data 1,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,0,1
Data 1,0,0,0,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,1
Data 1,0,0,1,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1
Data 1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
Data 1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
Data 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
; END TODO

For y = 0 To MapHeight% -1
   For x = 0 To MapLenght% -1
      Read Map(y,x)
   Next
Next

; Nachbarn werden eingefügt:
For y = 0 To MapHeight% -1
  For x = 0 To MapLenght%-1
    If Map (y,x) = 0 Then
      ; Links, Rechts, Oben und Unten sind Nachbarn:
      If Map(y, x-1) = 0 Then Distances(y*MapLenght% + x, y*MapLenght% + x -1) = 1
     If Map(y, x+1) = 0 Then Distances(y*MapLenght% + x, y*MapLenght% + x +1) = 1
     If Map(y-1, x) = 0 Then Distances(y*MapLenght% + x, (y-1)*MapLenght% + x) = 1
      If Map(y+1, x) = 0 Then Distances(y*MapLenght% + x, (y+1)*MapLenght% + x) = 1
     
      ; TODO Sind auch diagonale Wege möglich? Wenn ja einschalten mit TRUE:
      If False Then
      ; END TODO
        If Map(y-1, x-1) = 0 Then Distances(y*MapLenght% + x, (y-1)*MapLenght% + x-1) = 1
       If Map(y-1, x+1) = 0 Then Distances(y*MapLenght% + x, (y-1)*MapLenght% + x+1) = 1
       If Map(y+1, x-1) = 0 Then Distances(y*MapLenght% + x, (y+1)*MapLenght% + x-1) = 1
       If Map(y+1, x+1) = 0 Then Distances(y*MapLenght% + x, (y+1)*MapLenght% + x+1) = 1    
     End If
    End If
  Next
Next


Time2% = MilliSecs()

; Die Arbeitswerte einer evt. vorherigen Suche werden zurückgesetzt:
For i = 0 To NODE_COUNT%-1
  Worked(i) = -1
Next


; TODO Hier Start und Zielknoten eingeben, Aufsteigend zählend im Datafeld, horizontal. 1. Zahl ist "0"
StartNode% = 22
EndNode% = 418
; END TODO


Worked(StartNode%) = 0
pos = 1
Repeat
  shortestLenght = 10000000
  shortestNode% = 0

  For i = 0 To NODE_COUNT-1
    If Worked(i) >= 0 And (Not InAktiv(i)) Then
      aktiv = False
      For j = 0 To NODE_COUNT-1
        If (Worked(j) < 0) Then         
          If (Distances(i,j) >= 0) Then
         aktiv = True
          If Worked(i) + Distances(i,j) < shortestLenght Then
            workNode% = i
            shortestNode% = j
            shortestLenght = Worked(i) + Distances(i,j)
          End If
        End If
      End If
     Next
     If Not aktiv Then InAktiv(i) = True
   End If
  Next
 


  If shortestNode% = 0 Then
    Print "Kein Weg vorhanden"
    WaitKey()
    End
  End If

  Worked(shortestNode%) = shortestLenght
  ForeRunner(shortestNode%) = workNode%

  pos = pos +1
Until Worked(EndNode%) >= 0



SetBuffer FrontBuffer()

z = LoadImage("z.bmp")
t = LoadImage("tile.bmp")

yPrintOffset = 40
For y = 0 To MapHeight% -1
   For x = 0 To MapLenght% -1
      If Map(y,x) = 0 Then
      DrawBlock t, x*32, y*32 + yPrintOffset
      End If
   Next
Next

lenght=0
aktNode% = EndNode%
While aktNode% <> StartNode%
  DrawBlock z, (aktNode% Mod MapLenght%)*32, (aktNode% / MapLenght%) *32 + yPrintOffset
  aktNode% = ForeRunner(aktNode%)
  lenght = lenght +1
Wend

Time3% = MilliSecs()
Print "Gesamtlänge des Wegs      : " + Lenght
Print "Dauer für Level-Erstellung: " + (Time2% - Time1%) + " Millisekunden"
Print "Dauer für Weg-Berechnung  : " + (Time3% - Time2%) + " Millisekunden"




Aber Obacht: Der Code ist KEINEFALLS optimal! ich verwende überalle Arrays, keine Listen. Mit etwas Hirnschmalz kann man die Komplexität von O(n^2) auf O(n*log(n)) brechen.

Grüße
 

HyDr0x

 BeitragSa, Dez 29, 2007 18:36
Antworten mit Zitat
Benutzer-Profile anzeigen
Ich hatte auch mal den A* Algorithmus in meinem explosive guy spiel mit integriert. Den habe ich glaube ich aus dem Codearchiv. Ich kann dir ja mal den Algorithmus geben mit dem ich geübt habe.

Code: [AUSKLAPPEN]


Type node
  Field parent.node
  Field cost
  Field x
  Field y
End Type

Type open
  Field node.node
End Type

Type path
  Field node.node
End Type

Dim map(0,0)
Dim sqrmap(0,0)
Dim nodemap(0,0)
Dim dirx(7)
Dim diry(7)
Dim dirz(7)

For i=0 To 7
  Read dirx(i)
  Read diry(i)
  Read dirz(i)
Next

Global mapwidth
Global mapheight


createmap(100,100)

pathfinding0(1,2,1,0)

;---------------------------------------------------------------------
Function createmap(width,height)
  mapwidth=width-1
  mapheight=height-1
  Dim map(width-1,height-1)
  Dim sqrmap(width-1,height-1)
  For y=0 To mapheight
    For x=0 To mapwidth
      sqrmap(x,y)=Sqr(x*x+y*y)
    Next
  Next
End Function





;---------------------------------------------------------------------
;A*Pathfinding 4
;---------------------------------------------------------------------
Function pathfinding0(startx,starty,endx,endy)
  Delete Each node
  Delete Each open
  Delete Each path
  Dim nodemap(mapwidth,mapheight)
  If startx=endx And starty=endy Then Return

  node.node=New node
  node\x=startx
  node\y=starty
  open.open=New open
  open\node=node
  nodemap(startx,starty)=1

  .again0
  node=Null
  cost=2147483647
  For open=Each open
    delta=Abs(open\node\x-endx)+Abs(open\node\y-endy)
    If open\node\cost+delta<cost Then
      cost=open\node\cost+delta
      node=open\node
   tempopen.open = open
    EndIf
  Next
  If node=Null Then Return
  Delete tempopen

  For i=0 To 3
    x=node\x+dirx(i)
    y=node\y+diry(i)
    If x=>0 And y=>0 And x<=mapwidth And y<=mapheight Then
      If map(x,y)=0 And nodemap(x,y)=0 Then
        tempnode.node=New node
        tempnode\parent=node
        tempnode\cost=node\cost+1
        tempnode\x=x
        tempnode\y=y
        open.open=New open
        open\node=tempnode
        nodemap(x,y)=1
        If x=endx And y=endy Then finish=1:Exit
      EndIf
    EndIf
  Next
  If finish=0 Then Goto again0

  While tempnode\parent<>Null
    path.path=New path
    path\node=tempnode
    tempnode=tempnode\parent
  Wend
  path.path=New path
  path\node=tempnode
End Function


;---------------------------------------------------------------------
;A*Pathfinding 8
;---------------------------------------------------------------------
Function pathfinding1(startx,starty,endx,endy)
  Delete Each node
  Delete Each open
  Delete Each path
  Dim nodemap(mapwidth,mapheight)
  If startx=endx And starty=endy Then Return

  node.node=New node
  node\x=startx
  node\y=starty
  open.open=New open
  open\node=node
  nodemap(startx,starty)=1

  .again1
  node=Null
  cost=2147483647
  For open=Each open
    delta=Abs(open\node\x-endx)+Abs(open\node\y-endy)
    If open\node\cost+delta<cost Then
      cost=open\node\cost+delta
      node=open\node
      tempopen.open=open
    EndIf
  Next
  If node=Null Then Return
  Delete tempopen

  For i=0 To 7
    x=node\x+dirx(i)
    y=node\y+diry(i)
    If x=>0 And y=>0 And x<=mapwidth And y<=mapheight Then
      If map(x,y)=0 And nodemap(x,y)=0 Then
        If dirz(i)=1 Then
          If map(x,node\y)=1 And map(node\x,y)=1 Then Goto jump1
        EndIf
        tempnode.node=New node
        tempnode\parent=node
        tempnode\cost=node\cost+1
        tempnode\x=x
        tempnode\y=y
        open.open=New open
        open\node=tempnode
        nodemap(x,y)=1
        If x=endx And y=endy Then finish=1:Exit
        .jump1
      EndIf
    EndIf
  Next
  If finish=0 Then Goto again1

  While tempnode\parent<>Null
    path.path=New path
    path\node=tempnode
    tempnode=tempnode\parent
  Wend
  path.path=New path
  path\node=tempnode
End Function





;---------------------------------------------------------------------
;A*Pathfinding 8+
;---------------------------------------------------------------------
Function pathfinding2(startx,starty,endx,endy)
  Delete Each node
  Delete Each open
  Delete Each path
  Dim nodemap(mapwidth,mapheight)
  If startx=endx And starty=endy Then Return

  node.node=New node
  node\x=startx
  node\y=starty
  open.open=New open
  open\node=node
  nodemap(startx,starty)=1

  .again2
  node=Null
  cost=2147483647
  For open=Each open
    delta=sqrmap(Abs(open\node\x-endx),Abs(open\node\y-endy))
    If open\node\cost+delta<cost Then
      cost=open\node\cost+delta
      node=open\node
      tempopen.open=open
    EndIf
  Next
  If node=Null Then Return
  Delete tempopen

  For i=0 To 7
    x=node\x+dirx(i)
    y=node\y+diry(i)
    If x=>0 And y=>0 And x<=mapwidth And y<=mapheight Then
      If map(x,y)=0 And nodemap(x,y)=0 Then
        If dirz(i)=1 Then
          If map(x,node\y)=1 And map(node\x,y)=1 Then Goto jump2
        EndIf
        tempnode.node=New node
        tempnode\parent=node
        tempnode\cost=node\cost+1+dirz(i)
        tempnode\x=x
        tempnode\y=y
        open.open=New open
        open\node=tempnode
        nodemap(x,y)=1
        If x=endx And y=endy Then finish=1:Exit
        .jump2
      EndIf
    EndIf
  Next
  If finish=0 Then Goto again2

  While tempnode\parent<>Null
    path.path=New path
    path\node=tempnode
    tempnode=tempnode\parent
  Wend
  path.path=New path
  path\node=tempnode
End Function


;---------------------------------------------------------------------
Data 0,-1,0,  -1,0,0,  1,0,0,  0,1,0,  -1,-1,1,  1,-1,1,  -1,1,1,  1,1,1



Hoffe ich hab nichts vergessen ...

Casiopaya

 BeitragSa, Dez 29, 2007 18:43
Antworten mit Zitat
Benutzer-Profile anzeigen
Wär vllt nicht schlecht wenn du ihm ein Beispiel mitgeben würdest. Nur ein Funktionsaufruf ist schwer verständlich.

Wo ist denn das A*-Beispiel im Codearchiv zu finden? Würde mich mal interessieren, wie schnell das läuft.

coolo

 BeitragSa, Dez 29, 2007 19:05
Antworten mit Zitat
Benutzer-Profile anzeigen
Danke ihr alle. werde mich den Funktionen bedienen.

[/quote]
http://programming-with-design.at/ <-- Der Preis ist heiß!
That's no bug, that's my project!
"Eigenzitate sind nur was für Deppen" -Eigenzitat
 

HyDr0x

 BeitragSa, Dez 29, 2007 23:04
Antworten mit Zitat
Benutzer-Profile anzeigen
Casiopaya hat Folgendes geschrieben:
Wär vllt nicht schlecht wenn du ihm ein Beispiel mitgeben würdest. Nur ein Funktionsaufruf ist schwer verständlich.
läuft.


hier ein kleines bsp. was mit dabei war, wo ichs her hab weiß ich nimma ganz genau. Der Algo ist aber sauschnell. Habe ihn wie gesagt in meinem kleinen 2D Spiel Explosive Guy ( https://www.blitzforum.de/foru...hp?t=25981)angewand. Von daher sollte es auch für dich kein Problem sein mit dem Code hier zu lernen, wenn ich das schaffe schaffst du das schon lange ^^.

Code: [AUSKLAPPEN]

Include "pathfinding.bb"

Graphics 640,480,16,2
AppTitle "Pathfinding"
SetBuffer BackBuffer()
ClsColor 255,255,255

Global font1   =LoadFont("Arial",12)
Global font2   =LoadFont("Arial",24)
Global font3   =LoadFont("Arial",16)
Global startx  =07
Global starty  =14
Global endx    =22
Global endy    =14
Global pathmode=00

Dim setup(3)
setup(0)=1
setup(1)=1
setup(2)=1

createmap(30,30)

.start
drawmap1()

While Not KeyHit(57)
  If KeyHit(1)=1 Then End
  If KeyHit(2)=1 Then clearmap()
  If KeyHit(3)=1 Then paintmap()
  mouse_x=MouseX()/16
  mouse_y=MouseY()/16
  mouse_1=MouseDown(1)
  mouse_2=MouseDown(2)
  If mouse_x<=29 And mouse_y<=29 Then
    If mouse_1=1 Then map(mouse_x,mouse_y)=1:drawmap1()
    If mouse_2=1 Then map(mouse_x,mouse_y)=0:drawmap1()
  EndIf
Wend

drawmap2()
MouseHit(1)
MouseHit(2)

While Not KeyHit(57)
  If KeyHit(1)=1 Then End
  mouse_xx=MouseX()
  mouse_yy=MouseY()
  mouse_x=mouse_xx/16
  mouse_y=mouse_yy/16
  mouse_1=MouseHit(1)
  mouse_2=MouseHit(2)
  If (mouse_1=1 Or mouse_2=1) And mouse_x<=29 And mouse_y<=29 Then
    If mouse_1=1 Then startx=mouse_x:starty=mouse_y
    If mouse_2=1 Then endx=mouse_x:endy=mouse_y
    drawmap2()
  EndIf
  If mouse_1=1 And mouse_xx>=504 And mouse_yy=>48 And mouse_xx<=615 And mouse_yy<=106 Then
    pathmode=(mouse_yy-48)/20
    drawmap2()
  EndIf
  If mouse_1=1 And mouse_xx>=504 And mouse_yy=>328 And mouse_xx<=615 And mouse_yy<=406 Then
    nr=(mouse_yy-328)/20
    setup(nr)=1-setup(nr)
    If setup(3)=1 Then
      If nr=3 Then setup(0)=0:setup(2)=0
      If setup(1)=1 Then setup(1)=0
    EndIf
    drawmap2()
  EndIf
Wend
Goto start





;---------------------------------------------------------------------
Function drawmap1()
  Cls
  For y=0 To mapheight
    For x=0 To mapwidth
      If map(x,y)=0 Then Color 230,230,230 Else Color 0,0,0
      Rect x*16,y*16,15,15,1
    Next
  Next

  Color 0,255,0
  Rect startx*16,starty*16,15,15,1

  Color 100,200,255
  Rect endx*16,endy*16,15,15,1

  Color 0,0,0
  SetFont font2
  Text 560,20,"Zeichnen",1

  SetFont font3
  Text 560,50,"Weiter mit Leertaste",1
  Text 560,70,"Löschen mit 1",1
  Text 560,90,"Vorlage mit 2",1
  Flip
End Function





;---------------------------------------------------------------------
Function drawmap2()
  t1=MilliSecs()
  If pathmode=0 Then pathfinding0(startx,starty,endx,endy)
  If pathmode=1 Then pathfinding1(startx,starty,endx,endy)
  If pathmode=2 Then pathfinding2(startx,starty,endx,endy)
  t2=MilliSecs()-t1

  ClsColor 255,255,255
  Cls
  For y=0 To mapheight
    For x=0 To mapwidth
      If map(x,y)=0 Then Color 230,230,230 Else Color 0,0,0
      Rect x*16,y*16,15,15,1
    Next
  Next

  Color 255,195,195
  For node.node=Each node
    If setup(2)=1 Then Rect node\x*16,node\y*16,15,15,1
    nodes1=nodes1+1
  Next

  Color 240,220,220
  For open.open=Each open
    If setup(2)=1 Then Rect open\node\x*16,open\node\y*16,15,15,1
    nodes2=nodes2+1
  Next

  Color 255,0,0
  For path.path=Each path
    If setup(3)=0 Then Rect path\node\x*16,path\node\y*16,15,15,1
    nodes3=nodes3+1
  Next

  Color 0,255,0
  Rect startx*16,starty*16,15,15,1

  Color 100,200,255
  Rect endx*16,endy*16,15,15,1

  If setup(3)=1 Then
    Color 200,0,0
    For path.path=Each path
      If path=Last path Then Exit
      tmp.path=Before path
      If tmp=Null Then
        x0=path\node\x
        y0=path\node\y
      Else
        x0=tmp\node\x
        y0=tmp\node\y
      EndIf
      x1=path\node\x
      y1=path\node\y
      tmp.path=After path
      x2=tmp\node\x
      y2=tmp\node\y
      tmp.path=After tmp
      If tmp=Null Then
        x3=x2
        y3=y2
      Else
        x3=tmp\node\x
        y3=tmp\node\y
      EndIf
      spline x0*16+7,y0*16+7 , x1*16+7,y1*16+7 , x2*16+7,y2*16+7 , x3*16+7,y3*16+7
    Next
  EndIf

  If setup(1)=1 Then
    Color 180,180,180
    For node=Each node
      If node\parent<>Null Then
        Line node\x*16+7,node\y*16+7,node\parent\x*16+7,node\parent\y*16+7
      EndIf
    Next
  EndIf

  Color 255,255,0
  Rect 504,48+pathmode*20,112,19,1

  Color 0,0,0
  If setup(0)=1 Then
    SetFont font1
    For node=Each node
      Text node\x*16+7,node\y*16+7,Int(node\cost),1,1
    Next
  EndIf

  SetFont font2
  Text 560,20,"Pathfinding",1
  Text 560,150,"Information",1
  Text 560,300,"Einstellungen",1

  SetFont font3
  If nodes1>0 And nodes2>0 Then nodes2=nodes2-1
  Text 515,50,"A*Pathfinding 4"
  Text 515,70,"A*Pathfinding 8"
  Text 515,90,"A*Pathfinding 8+"
  Text 515,180,"Zeit:"
  Text 515,200,"Knoten:"
  Text 515,220,"Zweige:"
  Text 515,240,"Weg:"
  Text 570,180,t2+" ms"
  Text 570,200,nodes1
  Text 570,220,nodes2
  Text 570,240,nodes3
  Text 515,330,"Wegkosten"
  Text 515,350,"Zweige"
  Text 515,370,"Flood"
  Text 515,390,"Spline"
  For i=0 To 3
    If setup(i)=0 Then Text 585,330+i*20,"(aus)"
    If setup(i)=1 Then Text 585,330+i*20,"(ein)"
  Next

  Flip
End Function





;---------------------------------------------------------------------
Function clearmap()
  For y=0 To mapwidth
    For x=0 To mapheight
      map(x,y)=0
    Next
  Next
  drawmap1()
End Function





;---------------------------------------------------------------------
Function paintmap()
  For y=0 To mapwidth
    For x=0 To mapheight
      map(x,y)=0
    Next
  Next
  For x=0 To 10:map(x,2)=1:Next
  For x=5 To 26:map(x,5)=1:Next
  For x=5 To 26:map(x,26)=1:Next
  For x=0 To 11:map(x,22)=1:Next
  For x=19 To 29:map(x,22)=1:Next
  For x=3 To 7:map(x,18)=1:Next
  For x=16 To 19:map(x,18)=1:Next
  For x=6 To 10:map(x,10)=1:Next
  For y=2 To 18:map(2,y)=1:Next
  For y=0 To 26:map(15,y)=1:Next
  For y=0 To 2:map(19,y)=1:Next
  For y=2 To 18:map(24,y)=1:Next
  For y=10 To 22:map(11,y)=1:Next
  For y=9 To 18:map(19,y)=1:Next
  drawmap1()
End Function





;---------------------------------------------------------------------
Function spline(x1,y1,x2,y2,x3,y3,x4,y4)
  For u#=0 To 1.1 Step .1
    u2#=u#*u#
    u3#=u#*u#*u#
    f1#=-0.5*u3#+1.0*u2#-0.5*u#
    f2#= 1.5*u3#-2.5*u2#+1.0
    f3#=-1.5*u3#+2.0*u2#+0.5*u#
    f4#= 0.5*u3#-0.5*u2#
    x=x1*f1#+x2*f2#+x3*f3#+x4*f4#
    y=y1*f1#+y2*f2#+y3*f3#+y4*f4#
    If u#>0 Then Line ax,ay,x,y
    ax=x
    ay=y
  Next
End Function

Neue Antwort erstellen


Übersicht BlitzBasic Allgemein

Nach Oben

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group