Sternenkarte - Verbindungen - Routenplanung

Übersicht BlitzBasic Blitz3D

Neue Antwort erstellen

 

Krischan

Betreff: Sternenkarte - Verbindungen - Routenplanung

 BeitragDo, Jan 22, 2009 16:48
Antworten mit Zitat
Benutzer-Profile anzeigen
Ich bastel gerade an einer 3D Sternenkarte, die sowohl zu Navigation als auch für den interstellaren Raumflug verwendbar sein wird. Allerdings hab ich ein kleines Verständnisproblem mit den Verbindungen zwischen den Sternen.

Mein Ziel ist es, dass man ausgehend von einem Startpunkt (entweder 0,0,0 oder irgendein anderer Stern) alle anderen Sterne erreichen kann, indem man von einem Stern zum nächsten hüpft. Da das Weltall gross ist und der Antrieb des Raumschiffs eine begrenzte Reichweite hat macht es keinen Sinn, jeden Stern mit jedem zu verbinden, da dann schnell mehrere hundert Lichtjahre Distanz zusammenkommen.

Meine bisherigen Ansätze waren wie folgt (als Basis verwende ich eine Textdatei mit Koordinaten der nächsten 3.000 Sterne in Nachbarschaft zur Sonne, da die "Normalverteilung" der Sterne im Raum hier realistischer ist als mit RND, Lichtjahre sind Units, davon nehme ich die ersten 1000 Sterne, also die der Sonne am nächsten sind). Zur Verbindung zwischen den Sternen verwende ich eine 3D-Linie, die nur aus einem zusammengestauchtem Triangle besteht (Single Surface).

A) Verbinde alles innerhalb X Lichtjahre miteinander
- gehe alle Sterne durch und speichere jeweils die Distanzen zu allen anderen Sternen
- verbinde jeden Stern mit allen Sternen, sofern die Distanz kleiner als X Lichtjahre ist
Leider funktioniert das nur im Rahmen zwischen 6-10 Lichtjahren, darunter sind die Verbindungen kaum zusammenhängend und darüber gibt es viel zu viele Verbindungen untereinander. Bei 10 LJ habe ich bei 1000 Sternen nur 4 "verwaiste", allerdings auch teilweise 15-20 Verbindungen zu Nachbarsternen. So gehts also nicht.
user posted image

B) Verbinde nur den nächstgelegenen Stern
- gehe alle Sterne durch und prüfe, welcher Stern am nächsten liegt
- verbinde den Quell- mit dem Zielstern
Das sieht schon nicht schlecht aus, allerdings liegen die Sternkonstellationen untereinander auch recht weit auseinander. Vorteil ist hier, dass die Überprüfung auf den Nachbarstern sehr schnell geht (mit Hilfe dieses Threads im BB-Forum.
user posted image

Vermutlich liegt die Lösung in einer Art rekursiven Baumstruktur oder einem Graphen, ausgehend vom Startstern, zumal mit meinen beiden Lösungen Routenplanung mangels Parent/Child-Struktur kaum möglich sein dürfte. Mir schwebt folgendes vor:

- Position nahe beliebigem Stern
- 3D-Anzeige der Routen von diesem Stern zu seinen Nachbarsternen inkl. Lichtjahre
- Routenplaner zu jedem beliebigen Stern, also Waypoints und Auflistung der Abschnitte / Distanzen

Wie macht man sowas? Hat sich damit schon einmal jemand beschäftigt? Code kann ich gerne liefern, ist aber im Moment sehr unübersichtlich und unkommentiert.

Xeres

Moderator

BeitragDo, Jan 22, 2009 17:13
Antworten mit Zitat
Benutzer-Profile anzeigen
Da das Weltall gross ist und der Antrieb des Raumschiffs eine begrenzte Reichweite hat macht es keinen Sinn, jeden Stern mit jedem zu verbinden, da dann schnell mehrere hundert Lichtjahre Distanz zusammenkommen.
Warum sollte man überhaupt Sterne miteinander Verbinden? Das macht nur dann Sinn, wenn dies Wirtschaftlich oder Politische wichtige Routen darstellt.
Um zu einem bestimmten Stern über mehrere Stationen zu kommen, könnte man alle Sterne in Reichweite überprüfen und den Stern, der am ehesten in die Richtung des Zielsterns zeigt, ansteuern.
Win10 Prof.(x64)/Ubuntu 16.04|CPU 4x3Ghz (Intel i5-4590S)|RAM 8 GB|GeForce GTX 960
Wie man Fragen richtig stellt || "Es geht nicht" || Video-Tutorial: Sinus & Cosinus
THERE IS NO FAIR. THERE IS NO JUSTICE. THERE IS JUST ME. (Death, Discworld)
 

Krischan

 BeitragDo, Jan 22, 2009 17:20
Antworten mit Zitat
Benutzer-Profile anzeigen
Zum einen bekommt man mit den Linien eine schnell erfassbare visuelle Struktur in die Punktwolke, da später weit entfernte Sterne mit grösserer Leuchtkraft genauso gross erscheinen werden wie nahe mit niedriger Leuchtkraft (also wie nachts am Himmel). Zum anderen soll nicht jeder Stern mit allen möglichen Nachbarsternen verbunden sein, da bestimmte Routen z.B. durch Nebulae oder sonstige Hindernisse unmöglich mit interstellarem Antrieb erreichbar sind (man also einen Umweg fliegen muss). Wenn die Sterne unterschiedlich weit weg sind, sagen wir im Schnitt sind es 5-6 Lichtjahre und der Anfangsantrieb kann nur so weit, kann man andere Systeme, die weiter entfernt sind, erst später erreichen, wenn man einen Antrieb mit grösserer Reichweite eingebaut hat.

Es gibt viele Möglichkeiten das darzustellen, ich möchte es halt gerne so wie beschrieben haben. Nur wie macht man das am Besten?

Simples Beispiel:
user posted image

Das finde ich sehr übersichtlich gelöst. Aber auch das ist nicht perfekt. In Eve im XXL-Format sieht das dann so aus:

http://steamreview.org/wp-cont...tarmap.jpg
  • Zuletzt bearbeitet von Krischan am Do, Jan 22, 2009 22:54, insgesamt einmal bearbeitet

Firstdeathmaker

 BeitragDo, Jan 22, 2009 19:27
Antworten mit Zitat
Benutzer-Profile anzeigen
Habe ich das richtig verstanden, du willst ein Zusammenhängendes System haben?
Versuch es doch mal damit:

http://de.wikipedia.org/wiki/Spannbaum

eventuell einfach eine Handvoll "wichtige" Planeten raussuchen, den Algorithmus für diese Planeten ausführen und dann alle gefundenen minimalen Spannbäume miteinander vereinigen. Dadurch bekommt man die jeweils kürzesten Routen von diesen Planeten zu allen anderen (was ja irgendwie für wichtige Welten bzw. Städte auch zutrifft).
www.illusion-games.de
Space War 3 | Space Race | Galaxy on Fire | Razoon
Gewinner des BCC #57 User posted image
 

Krischan

 BeitragFr, Jan 23, 2009 0:51
Antworten mit Zitat
Benutzer-Profile anzeigen
Ja das sieht gut aus. Mit dem Dijkstra-Algorithmus hatte ich mich schon beschäftigt, das war mir aber zu hoch. Der Prim- bzw. Kruskal-Algorithmus hingegen sieht gut aus. Wenn ich das richtig verstanden habe, kann man mit dem Prim- bzw. Kruskal-Algorithmus die Struktur erstellen und dann mittels Dijkstra-Algorithmus den kürzesten Pfad herausfinden. Ich bekomme es aber irgendwie nicht in BB gebacken und finde im Netz nur (für mich) unleserliche C++ Codes (da kann man mal wieder sehen, WIE einfach Blitzbasic ist, das kann eigentlich jeder sofort lesen und verstehen).

Mal etwas von meinem BB-Code (nicht lauffähig, zur Veranschaulichung):

Code: [AUSKLAPPEN]
max%=1000
Dim distances#(max,max)

Type star
    Field id%
    Field entity%
    Field x#,y#,z#
End Type

For i=1 to max

    s.star = New star
    stars=stars+1

    s1\x=rnd(-100,100)
    s1\y=rnd(-100,100)
    s1\z=rnd(-100,100)

    s1\entity=CreateCube()
    s1\id=stars

Next

For s1.star = Each star
   
   id1=id1+1
   
   For s2.star = Each star
      
      id2=id2+1
      
      If distances(id1,id2)=0 Or distances(id2,id1)=0 Then
      
         d#=EntityDistance(s1\entity,s2\entity)
         distances(id1,id2)=d
         distances(id2,id1)=d
         
      EndIf
      
   Next
   
   id2=0
      
Next

So sieht ganz grob mein Testcode aus. Es werden 1000 Punkte zufällig plaziert und im Array "distances" die Entfernungen jedes Sterns zu jedem Stern festgehalten, so wie in einer Entfernungstabelle in Autoatlanten zwischen allen Städten. Auf dieser Webseite finde ich folgendes:

Algorithmus von Prim Wähle einen speziellen Ort aus und nenne ihn erreichbar. Alle anderen Orte sind zunächst nicht erreichbar. Führe den folgenden Schritt so oft aus, bis alle Orte erreichbar sind: Baue die kürzeste Brücke zwischen zwei Orten, von denen einer erreichbar und der andere nicht erreichbar ist, und nenne den bislang nicht erreichbaren Ort erreichbar.

Algorithmus von Kruskal Führe den folgenden Schritt so oft aus, bis alle Orte untereinander durch Brücken verbunden sind: Baue die kürzeste Brücke, die zwei Orte verbindet, die bislang nicht voneinander aus erreichbar sind.

Ich habe ein paar Versuche gestartet, aber irgendwie will das nicht so. Vielleicht war der Tag auch einfach zu lang Sad

Die Linien zeichne ich übrigens mit diesem Code: [AUSKLAPPEN]
Function create_3D_line(mesh,x0#,y0#,z0#,x1#,y1#,z1#,r%=255,g%=255,b%=255)

   If mesh = 0
      mesh = CreateMesh()
      surf = CreateSurface(mesh)
      EntityFX mesh,1+2+16
   Else
      last_surf = CountSurfaces(mesh)
      surf = GetSurface(mesh,last_surf)
      If CountVertices(surf) > 30000 Then surf = CreateSurface(mesh)
   End If

    v1 = AddVertex(surf,x1,y1,z1)
   v2 = AddVertex(surf,x0,y0,z0)
   AddTriangle surf,v1,v1,v2
   
    VertexColor surf,v1,r,g,b,1
   VertexColor surf,v2,r,g,b,1

   Return mesh

End Function

Firstdeathmaker

 BeitragFr, Jan 23, 2009 17:05
Antworten mit Zitat
Benutzer-Profile anzeigen
Ich schau mal, ich schreib dir da mal was, weis aber noch nicht wann es fertig wird, da ich heute noch viel zu tun hab Wink

Aber Grundsätzlich brauchst du schonmal 2 Datentypen:

(Dein Star-Type)
Code: [AUSKLAPPEN]
Type TNode
 field id%
 field pos#[3]
end type


(Verbindung zwischen den Stars)
Code: [AUSKLAPPEN]
Type TLink
 field n.TNode[2]
 field distance#
end type



Dann erstellst du erstmal alle Verbindungen, allerdings keine doppelten. Sprich wenn du eine Verbindung von Star1->Star2 hast, brauchst du nicht noch eine weitere Verbindung von Star2->Star1. Dadurch reduzierst du die Anzahl der Verbindungen schonmal extrem, und die Verbindungen würden somit ungerichteten Verbindungen entsprechen (= in beiden Richtungen geltend).

(zum berechnen der wirklichen Anzahl an benötigten Verbindungen damit du dafür ein Array erstellen kannst)
Code: [AUSKLAPPEN]
Global STARS% = 1000
Global CONNECTIONS% = (STARS*(STARS+1)/2) - STARS


Am besten programmierst du dir dann eine Funktion, über welche du schnell die entsprechenden Verbindungen finden kannst. Müsste also so aussehen:

Function getLink.TLink(node1%,node2%)

(Bis hierhin bin ich bisher gekommen).

Jetzt hast du schonmal ein gutes Datengerüst um an die Algorithmen ranzugehen.
www.illusion-games.de
Space War 3 | Space Race | Galaxy on Fire | Razoon
Gewinner des BCC #57 User posted image

Firstdeathmaker

 BeitragSa, Jan 24, 2009 18:42
Antworten mit Zitat
Benutzer-Profile anzeigen
Okay, fertig. War nen Haufen Arbeit, aber es funktioniert.

Das Prinzip:

Ich erstelle alle Nodes (= Planeten oder Sterne) und alle Connections (=Verbindungen) welche es geben kann.
Die Connections packe ich in ein großes Array. Da ich nicht Nodes*Nodes Connections habe (da ich keine Verbindungen in beide Richtungen brauche und auch keine auf den selben Planeten) muss ich die Position einer Verbindung im Array durch TConnection_getArrayPos%(n1%,n2%) berechnen. n1 und n2 stehen dabei für node\id's.

Die erstellten Verbindungen packe ich zugleich direkt in die QuickSortQueue. Nachdem alle erstellt worden sind, kann ich diese dann per TQuicksort_sort() sortieren, was viel schneller geht als wenn ich sie beim erstellen in einer Liste einordne. Die QuickSortQueue.bb habe ich unten auch gepostet, sie ist variabel einsetzbar, immer wenn man objekte sortieren möchte.

Nun ja, dann kommt der eigentliche Spannbaum-Algorithmus. Habe mich dabei für den Prim-Algorithmus entschieden, weil der hier einfacher zu implementieren war (geht trotzdem recht fix, schneller als das sortieren auf jeden Fall). Das löschen der überflüssigen Verbindungen am Schluss ist am aufwendigsten, vielleicht liegt das an der langsamen Positionsberechnung? Vielleicht fällt ja jmd ein wie man die Funktion
Code: [AUSKLAPPEN]
Function TConnection_getArrayPos%(n1%,n2%)
   Local na% = minInt(n1,n2)
   Local nb% = maxInt(n1,n2)
   Local pos% = 0
   For i% = 1 To na
      pos = pos + Sgn((na-i)) * (NODES - i)
   Next
   pos = pos + (nb-na) - 1
   Return pos
End Function

beschleunigen kann? Muss irgendwie mit dem kleinen Gauss zusammen hängen, aber mir ist einfach nix eingefallen...

Naja, am Ende hast du jedenfalls nach dem Aufruf der Funktion

TConnection_CreateSpanningTree(startNode.TNode)

nur noch Verbindungen übrig, welche alle Nodes/Planeten miteinander verbinden. Und dass alles auf kürzestem Weg zum StartNode.


Test.bb
Code: [AUSKLAPPEN]
Include "Spannbaum.bb"

TNode_InitAll()
TConnection_InitAll()
TConnection_CreateSpanningTree(First TNode)


WaitKey()
End



Spannbaum.bb
Code: [AUSKLAPPEN]
Include "QuickSortQueue.bb"



Global NODES%=500
Global NODES_XDIST# = 100 / 2
Global NODES_YDIST# = 100 / 2
Global NODES_ZDIST# = 100 / 2

Dim NODE_ARRAY.TNode(NODES)
Type TNode
    Field id%
    Field entity%
    Field pos#[3]
   Field connected%
End Type

Type TConnection
   Field node.TNode[2]
   Field dist#
End Type

Global CONNECTIONS% = TConnection_calcConnCount%()
Dim CONNECTION_ARRAY.TConnection(CONNECTIONS)

Function TConnection_calcConnCount%()
   Return (NODES*(NODES+1)/2) - NODES; See http://de.wikipedia.org/wiki/Der_kleine_Gau%C3%9F
End Function

Function minInt(c1%,c2%)
   If c1<=c2 Return c1
   Return c2
End Function

Function maxInt(c1%,c2%)
   If c1>=c2 Return c1
   Return c2
End Function

Function TConnection_getConnection.TConnection(n1%,n2%)
   If n1=n2 Return Null
   Return CONNECTION_ARRAY(TConnection_getArrayPos(n1,n2))
End Function

Function TConnection_getArrayPos%(n1%,n2%)
   Local na% = minInt(n1,n2)
   Local nb% = maxInt(n1,n2)
   Local pos% = 0
   For i% = 1 To na
      pos = pos + Sgn((na-i)) * (NODES - i)
   Next
   pos = pos + (nb-na) - 1
   Return pos
End Function

Function TConnection_getConnectionTest()
For i% = 5000 To 5005
Local c2.TConnection = TConnection_getConnection((i/1000)+1,(i Mod 1000)+1)
If c2<>Null
   Print ((i/1000)+1)+"/"+((i Mod 1000)+1) + " = "+c2\node[0]\id + "/"+c2\node[1]\id
EndIf
Next
End Function


Function TNode_InitAll()
   DebugLog "Init Nodes"
   For i% = 1 To NODES
      Local n.TNode = New TNode
      n\id = i
      n\pos[0] = Rnd(-NODES_XDIST,NODES_XDIST)
      n\pos[1] = Rnd(-NODES_YDIST,NODES_YDIST)
      n\pos[2] = Rnd(-NODES_ZDIST,NODES_ZDIST)
      NODE_ARRAY(i-1) = n
   Next
End Function

Function TConnection_Create.TConnection(n1.TNode,n2.TNode)
   Local c.TConnection = New TConnection
   c\node[0] = n1
   c\node[1] = n2
   c\dist = Sqr((n1\pos[0]-n2\pos[0])*(n1\pos[0]-n2\pos[0])+(n1\pos[1]-n2\pos[1])*(n1\pos[1]-n2\pos[1])+(n1\pos[2]-n2\pos[2])*(n1\pos[2]-n2\pos[2]))
   Return c
End Function



Function TConnection_InitAll()
   DebugLog "Init Connections"
   Local stmp% = NODES-1
   Local c% = 0
   TQuicksort_Clear()
   For i1% = 0 To stmp
      For i2% = i1 To stmp
         If i1<>i2
            CONNECTION_ARRAY(c) = TConnection_Create(NODE_ARRAY(i1),NODE_ARRAY(i2))
            TQuicksortLink_create.TQuicksortLink(CONNECTION_ARRAY(c)\dist,Handle(CONNECTION_ARRAY(c)))
            c = c + 1
         EndIf
      Next
   Next
   DebugLog "sorting connections: ..."
   TQuicksort_sort()
   DebugLog "sorting connections: finished"
End Function

Function TConnection_CreateSpanningTree(startNode.TNode)
   DebugLog "calculating min spanning tree"
   startNode\connected = True
   For i% = 1 To NODES
      TConnection_CreateSpanningTree_Sub()
   Next
   
   DebugLog "cleaning up"
   For qsl.TQuicksortLink = Each TQuicksortLink
      Local c.TConnection = Object.TConnection(qsl\objHandle)
      If c\node[0]\connected And c\node[1]\connected
         Local pos% = TConnection_getArrayPos%(c\node[0]\id,c\node[1]\id)
         If CONNECTION_ARRAY(pos)<>Null Delete CONNECTION_ARRAY(pos)
         CONNECTION_ARRAY(pos) = Null
      EndIf
   Next
   TQuickSort_clear()
   
   DebugLog "finished calc spanning tree"
   For c.TConnection = Each TConnection
      DebugLog "c "+c\node[0]\id+" <--> "+c\node[1]\id+" dist:"+c\dist
   Next
End Function

Function TConnection_CreateSpanningTree_Sub()
   ;Kleinste Kante wählen die Graph mit noch nicht verb. Knoten verbindet.
   For qsl.TQuicksortLink = Each TQuicksortLink
   
      Local c.TConnection = Object.TConnection(qsl\objHandle)
      
      If c\node[0]\connected Xor c\node[1]\connected
         c\node[0]\connected = True
         c\node[1]\connected = True
         Delete qsl
         Return
      EndIf
   Next
End Function


QuickSortQueue.bb
Code: [AUSKLAPPEN]

Type TQuicksortLink
   Field value#
   Field objHandle%
End Type

Function TQuicksortLink_create.TQuicksortLink(value#,objectHandle%)
   Local pl.TQuicksortLink = New TQuicksortLink
   pl\value = value
   pl\objHandle = objectHandle
   Return pl
End Function

Function TQuicksortLink_removeFirst%()
   Local l.TQuicksortLink = First TQuicksortLink
   If l<>Null
      Local h% = l\objHandle
      Delete l
      Return h
   EndIf
End Function

Function TQuicksortLink_removeLast%()
   Local l.TQuicksortLink = Last TQuicksortLink
   If l<>Null
      Local h% = l\objHandle
      Delete l
      Return h
   EndIf
End Function

Function TQuicksort_clear()
   For ql.TQuicksortLink = Each TQuicksortLink
      Delete ql
   Next
End Function

Function TQuicksort_sort()
   TQuicksort_sortPart(First TQuicksortLink,Last TQuicksortLink)
End Function

Function TQuicksort_sortPart(f.TQuicksortLink,l.TQuicksortLink)
   If f = l Return
   If l = Null Return
   If f = Null Return
   
   p.TQuicksortLink = f
   e.TQuicksortLink = l
   ;p = pivot element
   this.TQuicksortLink = f
   enum.TQuicksortLink = After this
   
   While this<>e And enum<>Null
      this = enum
      enum = After enum

      
      If this\value < p\value
         Insert this Before f
         f = this
      Else
         Insert this After l
         l = this
      EndIf
   Wend
   
   TQuicksort_sortPart(f,p)
   TQuicksort_sortPart(After p,l)
End Function
www.illusion-games.de
Space War 3 | Space Race | Galaxy on Fire | Razoon
Gewinner des BCC #57 User posted image
 

Krischan

 BeitragMo, Jan 26, 2009 13:35
Antworten mit Zitat
Benutzer-Profile anzeigen
Sorry dass ich mich erst jetzt melde, musste erst mal mein neues Notebook einrichten. Da hast Du Dir ja eine ganz schöne Arbeit mit gemacht, auch noch objektorientiert Shocked Ich wusste gar nicht, dass man mit B3D so komplex arbeiten kann und da ist auch schon mein Problem: das ist mir (noch) zu hoch, ich verstehe nicht, wie ich z.B.

a) die Sterne ab einem definierten Parent aus mit meiner Line3D Funktion verbinden soll
b) von einem Stern X die kürzeste Strecke zu einem Stern Y durchlaufen kann (z.B. Start bei ID 5, über 7,13,27,40 zu ID 49)

Ich habe es bislang nur geschafft, die Sterne anzuzeigen, das war aber kein Hexenwerk. Kannst Du das noch beschreiben bzw. mein Beispiel dahingehend erweitern, so dass ich da als Otto Normalprogrammierer was mit anfangen kann?

Code: [AUSKLAPPEN]
Include "Spannbaum.bb"

Global movespeed#=0.5

ms=MilliSecs()

TNode_InitAll()
TConnection_InitAll()
TConnection_CreateSpanningTree(First TNode)

Graphics3D 800,600,32,2

; Entities
cam=CreateCamera()
wiref_piv = CreatePivot()
solid_piv = CreatePivot()
stern=CreateSphere(8)

; Sterne erzeugen
For n.TNode = Each TNode
   
   n\entity=CopyEntity(stern,solid_piv)
   PositionEntity n\entity,n\pos[0],n\pos[1],n\pos[2]
   ScaleEntity n\entity,0.25,0.25,0.25
   
Next

ende=MilliSecs()-ms

While Not KeyHit(1)
   
   ; FPS messung
    FPS_C=FPS_C+1 : If ms<MilliSecs() Then ms=MilliSecs()+1000 : FPS=FPS_C : FPS_C=0
   
    ; Frame tweening
    Tween#=Float(MilliSecs()-FrameTime)/Float(20.0) : FrameTime=MilliSecs()
   
    ; Maussteuerung
    mxs#=MouseXSpeed() : mys#=MouseYSpeed() : pitch#=EntityPitch(cam)+(mys#/5)
    If pitch>89 Then pitch=89 Else If pitch<-89 Then pitch=-89
    RotateEntity cam,pitch,EntityYaw(cam)-(mxs#/5),0
   MoveMouse GraphicsWidth()/2,GraphicsHeight()/2
   
    ; Tastatursteuerung
   If KeyDown(200) Then MoveEntity cam,0,0,movespeed*tween
   If KeyDown(208) Then MoveEntity cam,0,0,-movespeed*tween
   If KeyDown(205) Then MoveEntity cam,movespeed*tween,0,0
   If KeyDown(203) Then MoveEntity cam,-movespeed*tween,0,0
    If KeyHit(57) Then wf=1-wf
   
    ; Render wireframe objects.
    WireFrame 1 : ShowEntity wiref_piv : HideEntity solid_piv
    CameraClsMode cam,1,1 : RenderWorld
   
    ; Render solid objects.
    WireFrame wf : HideEntity wiref_piv : ShowEntity solid_piv
    CameraClsMode cam,0,0 : RenderWorld
   
    ; Textausgabe
    Text 0, 0,"FPS...............: "+FPS
   Text 0,15,"Baum erstellt in..: "+ende+"ms"
   
   RenderWorld
   
   Flip 0
   
Wend

End

; 3D Linie zeichnen
Function Line3D(mesh,x0#,y0#,z0#,x1#,y1#,z1#,r%=255,g%=255,b%=255)
   
   If mesh = 0
      mesh = CreateMesh()
      surf = CreateSurface(mesh)
      EntityFX mesh,1+2+16
   Else
      last_surf = CountSurfaces(mesh)
      surf = GetSurface(mesh,last_surf)
      If CountVertices(surf) > 30000 Then surf = CreateSurface(mesh)
   End If
   
    v1 = AddVertex(surf,x1,y1,z1)
   v2 = AddVertex(surf,x0,y0,z0)
   AddTriangle surf,v1,v1,v2
   
    VertexColor surf,v1,r,g,b,1
   VertexColor surf,v2,r,g,b,1
   
   Return mesh
   
End Function


Im Internet hatte ich noch ein Beispiel für den Dijkstra-Algorithmus in PHP gefunden, evt. haben die das simpler gelöst, auch schwer objektorientiert gelöst (hab aber noch keine Zeit gehabt, den Code auseinanderzunehmen):

demo.dijkstra.php
Code: [AUSKLAPPEN]
<?php

include("class.dijkstra.php");
 
// I is the infinite distance.
define('I',1000);
 
// Size of the matrix
$matrixWidth = 20;
 
// $points is an array in the following format: (router1,router2,distance-between-them)
$points = array(
   array(0,1,4),
   array(0,2,I),
   array(1,2,5),
    array(1,3,5),
   array(2,3,5),
   array(3,4,5),
   array(4,5,5),
   array(4,5,5),
   array(2,10,30),
   array(2,11,40),
   array(5,19,20),
   array(10,11,20),
   array(12,13,20),
);
 
$ourMap = array();
 
 
// Read in the points and push them into the map
 
for ($i=0,$m=count($points); $i<$m; $i++) {
   $x = $points[$i][0];
   $y = $points[$i][1];
   $c = $points[$i][2];
   $ourMap[$x][$y] = $c;
   $ourMap[$y][$x] = $c;
}
 
// ensure that the distance from a node to itself is always zero
// Purists may want to edit this bit out.
 
for ($i=0; $i < $matrixWidth; $i++) {
    for ($k=0; $k < $matrixWidth; $k++) {
        if ($i == $k) $ourMap[$i][$k] = 0;
    }
}
 
 
// initialize the algorithm class
$dijkstra = new Dijkstra($ourMap, I,$matrixWidth);
 
// $dijkstra->findShortestPath(0,13); to find only path from field 0 to field 13...
$dijkstra->findShortestPath(0);
 
// Display the results
 
echo '<pre>';
echo "the map looks like:\n\n";
echo $dijkstra -> printMap($ourMap);
echo "\n\nthe shortest paths from point 0:\n";
echo $dijkstra -> getResults();
echo '</pre>';
 
?>


class.dijkstra.php
Code: [AUSKLAPPEN]
<?PHP
class Dijkstra {
 
   var $visited = array();
   var $distance = array();
   var $previousNode = array();
   var $startnode =null;
   var $map = array();
   var $infiniteDistance = 0;
   var $bestPath = 0;
   var $matrixWidth = 0;
 
   function Dijkstra(&$ourMap, $infiniteDistance) {
      $this -> infiniteDistance = $infiniteDistance;
      $this -> map = &$ourMap;
      $this -> bestPath = 0;
   }
 
   function findShortestPath($start,$to = null) {
      $this -> startnode = $start;
      foreach (array_keys($this->map) as $i) {
         if ($i == $this -> startnode) {
            $this -> visited[$i] = true;
            $this -> distance[$i] = 0;
         } else {
            $this -> visited[$i] = false;
            $this -> distance[$i] = isset($this -> map[$this -> startnode][$i])
               ? $this -> map[$this -> startnode][$i]
               : $this -> infiniteDistance;
         }
         $this -> previousNode[$i] = $this -> startnode;
      }
 
      $maxTries = count($this->map);
      $tries = 0;
      while (in_array(false,$this -> visited,true) && $tries <= $maxTries) {         
         $this -> bestPath = $this->findBestPath($this->distance,array_keys($this -> visited,false,true));
         if($to !== null && $this -> bestPath === $to) {
            break;
         }
         $this -> updateDistanceAndPrevious($this -> bestPath);         
         $this -> visited[$this -> bestPath] = true;
         $tries++;
      }
   }
 
   function findBestPath($ourDistance, $ourNodesLeft) {
      $bestPath = $this -> infiniteDistance;
      $bestNode = 0;
      for ($i = 0,$m=count($ourNodesLeft); $i < $m; $i++) {
         if($ourDistance[$ourNodesLeft[$i]] < $bestPath) {
            $bestPath = $ourDistance[$ourNodesLeft[$i]];
            $bestNode = $ourNodesLeft[$i];
         }
      }
      return $bestNode;
   }
 
   function updateDistanceAndPrevious($obp) {      
      foreach (array_keys($this->map) as $i) {
         if(    (isset($this->map[$obp][$i]))
             &&   (!($this->map[$obp][$i] == $this->infiniteDistance) || ($this->map[$obp][$i] == 0 ))   
            &&   (($this->distance[$obp] + $this->map[$obp][$i]) < $this -> distance[$i])
         )    
         {
               $this -> distance[$i] = $this -> distance[$obp] + $this -> map[$obp][$i];
               $this -> previousNode[$i] = $obp;
         }
      }
   }
 
   function printMap(&$map) {
      $placeholder = ' %' . strlen($this -> infiniteDistance) .'d';
      $foo = '';
      for($i=0,$im=count($map);$i<$im;$i++) {
         for ($k=0,$m=$im;$k<$m;$k++) {
            $foo.= sprintf($placeholder, isset($map[$i][$k]) ? $map[$i][$k] : $this -> infiniteDistance);
         }
         $foo.= "\n";
      }
      return $foo;
   }
 
   function getResults($to = null) {
      $ourShortestPath = array();
      $foo = '';
      foreach (array_keys($this->map) as $i) {
         if($to !== null && $to !== $i) {
            continue;
         }
         $ourShortestPath[$i] = array();
         $endNode = null;
         $currNode = $i;
         $ourShortestPath[$i][] = $i;
         while ($endNode === null || $endNode != $this -> startnode) {
            $ourShortestPath[$i][] = $this -> previousNode[$currNode];
            $endNode = $this -> previousNode[$currNode];
            $currNode = $this -> previousNode[$currNode];
         }
         $ourShortestPath[$i] = array_reverse($ourShortestPath[$i]);
         if ($to === null || $to === $i) {
         if($this -> distance[$i] >= $this -> infiniteDistance) {
            $foo .= sprintf("no route from %d to %d. \n",$this -> startnode,$i);
         } else {
            $foo .= sprintf('%d => %d = %d [%d]: (%s).'."\n" ,
                  $this -> startnode,$i,$this -> distance[$i],
                  count($ourShortestPath[$i]),
                  implode('-',$ourShortestPath[$i]));
         }
         $foo .= str_repeat('-',20) . "\n";
            if ($to === $i) {
               break;
            }
         }
      }
      return $foo;
   }
} // end class
?>

Firstdeathmaker

 BeitragMo, Jan 26, 2009 15:08
Antworten mit Zitat
Benutzer-Profile anzeigen
Zitat:
a) die Sterne ab einem definierten Parent aus mit meiner Line3D Funktion verbinden

Naja, dein "definiertes Parent" ist ja ein Stern, oder? Ich habe hier nochmal einen modifizierten Code für Spannbaum.bb angehängt sowie deinen Code (Test2.bb) leicht modifiziert, sodass die Verbindungen angezeigt werden.
Jetzt werden die Verbindungen nicht gelöscht, sondern einfach nur alle gültigen restlichen Verbindungen in das Array
Dim CurrentConnectionsArray.TConnection(NODES-1)
geschrieben. Ein Aufruf von TConnection_CreateSpanningTree(n.TNode) schreibt also alle gültigen Verbindungen in das Array CurrentConnectionsArray. Dieses kann man dann durchgehen und die entsprechenden Linien einzeichnen. Im Type TConnection habe ich zudem eine variable "valid" eingeführt, diese wird gesetzt, wenn die Verbindung eben eine der gefundenen ist (das wird bei Frage b) wichtig).

Achtung: Der Algorithmus erstellt wirklich nur einen minimalen Spannbaum. D.h. es werden nicht immer die kürzesten Verbindungen gewählt (weil das immer eine Gerade von Punkt A nach B ist), sondern ein Netzwerk aus jeweils kürzesten Verbindungen zu Nachbarplaneten. Dadurch kann es vor allem am Rand vorkommen, dass man für eigentlich kurze Strecken sehr lange Wege zurück legen muss. Aber sieh dir das am besten selbst an. Lösung wäre hier, einfach noch zusätzlich ein paar weitere Verbindungen hinzuzufügen.

Edit: Irgendwas stimmt mit dem Quicksort nicht. Auf dem alten Beispiel schafft er es, die Verbindungen viel schneller zu sortieren. Hier ist er aber total langsam geworden...

Edit2: Hab die Geschwindigkeitsbremse gefunden. Hatte die Funktion zum berechnen der Distanz zweier Nodes ausgelagert. Jetzt hab ich sie zurück nach TConnection_init() geschrieben, und auch noch das Sqrt() entfernt, dadurch dürfte sie sehr viel schneller sein.

Zitat:

b) von einem Stern X die kürzeste Strecke zu einem Stern Y durchlaufen kann (z.B. Start bei ID 5, über 7,13,27,40 zu ID 49)


Das läuft auf eine simple A* implementation hinaus.


Anmerkung: Ordnerstruktur ist folgendermassen:
Test2.bb in den Root
Alle anderen codes in Includes\

Test2.bb
Code: [AUSKLAPPEN]
Include "Includes\QuickSortQueue.bb"
Include "Includes\Spannbaum.bb"
Include "Includes\LinkedList.bb"
Include "Includes\PriorityQueue.bb"
Include "Includes\AStar.bb"


Global movespeed#=0.5

ms=MilliSecs()

TNode_InitAll()
TConnection_InitAll()

Graphics3D 800,600,32,2

; Entities
cam=CreateCamera()
wiref_piv = CreatePivot()
solid_piv = CreatePivot()
stern=CreateSphere(8)


; Sterne erzeugen
For n.TNode = Each TNode
   n\entity=CopyEntity(stern,solid_piv)
   PositionEntity n\entity,n\pos[0],n\pos[1],n\pos[2]
   ScaleEntity n\entity,0.25,0.25,0.25
Next

;Vom ersten Stern aus die kürzesten Wege zu allen anderen Berechnen und die entsprechenden Routen anzeigen.
TConnection_CreateSpanningTree(First TNode)
TConnections_Show()



ende=MilliSecs()-ms

While Not KeyHit(1)
   
   ; FPS messung
    FPS_C=FPS_C+1 : If ms<MilliSecs() Then ms=MilliSecs()+1000 : FPS=FPS_C : FPS_C=0
   
    ; Frame tweening
    Tween#=Float(MilliSecs()-FrameTime)/Float(20.0) : FrameTime=MilliSecs()
   
    ; Maussteuerung
    mxs#=MouseXSpeed() : mys#=MouseYSpeed() : pitch#=EntityPitch(cam)+(mys#/5)
    If pitch>89 Then pitch=89 Else If pitch<-89 Then pitch=-89
    RotateEntity cam,pitch,EntityYaw(cam)-(mxs#/5),0
   MoveMouse GraphicsWidth()/2,GraphicsHeight()/2
   
    ; Tastatursteuerung
   If KeyDown(200) Then MoveEntity cam,0,0,movespeed*tween
   If KeyDown(208) Then MoveEntity cam,0,0,-movespeed*tween
   If KeyDown(205) Then MoveEntity cam,movespeed*tween,0,0
   If KeyDown(203) Then MoveEntity cam,-movespeed*tween,0,0
    If KeyHit(57) Then wf=1-wf

   If KeyHit(28)
      ;Einen Weg berechnen von star1 -> star2
      Local offset# = 0.4
      Local star1.TNode = NODE_ARRAY(Rand(0,NODES-1))
      Local star2.TNode = NODE_ARRAY(Rand(0,NODES-1))
      
      ;Weg von star1 nach star2 finden
      Local path.TPathNode = AStar_getPath(star1,star2)
      
      ;Weg einzeichnen & Startplanet grün sowie Zielplanet rot markieren
      EntityColor star1\entity,255,0,0
      EntityColor star2\entity,0,255,0
      TConnections_Show()
      If path<>Null
         TPath_Show(path)
      Else
         DebugLog "Kein Weg gefunden (eigendlich nicht moeglich)"
      EndIf
   EndIf
   
    ; Render wireframe objects.
    WireFrame 1 : ShowEntity wiref_piv : HideEntity solid_piv
    CameraClsMode cam,1,1 : RenderWorld
   
    ; Render solid objects.
    WireFrame wf : HideEntity wiref_piv : ShowEntity solid_piv
    CameraClsMode cam,0,0 : RenderWorld
   
    ; Textausgabe
    Text 0, 0,"FPS...............: "+FPS
   Text 0,15,"Baum erstellt in..: "+ende+"ms"
   Text 0,30,"Druecke Enter um neuen Weg zu berechnen"
   
   RenderWorld
   
   Flip 0
   
Wend

End

; 3D Linie zeichnen
Function Line3D(mesh,x0#,y0#,z0#,x1#,y1#,z1#,r%=255,g%=255,b%=255)
   
   If mesh = 0
      mesh = CreateMesh()
      surf = CreateSurface(mesh)
      EntityFX mesh,1+2+16
   Else
      last_surf = CountSurfaces(mesh)
      surf = GetSurface(mesh,last_surf)
      If CountVertices(surf) > 30000 Then surf = CreateSurface(mesh)
   End If
   
    v1 = AddVertex(surf,x1,y1,z1)
   v2 = AddVertex(surf,x0,y0,z0)
   AddTriangle surf,v1,v1,v2
   
   VertexColor surf,v1,r,g,b,1
   VertexColor surf,v2,r,g,b,1
 
   Return mesh
End Function

Function TConnections_Show()
   For i% = 0 To NODES-1
      c.TConnection = CurrentConnectionsArray(i)
      If c<>Null
         If c\entity FreeEntity c\entity
         c\entity = Line3D(mesh,c\node[0]\pos[0],c\node[0]\pos[1],c\node[0]\pos[2],c\node[1]\pos[0],c\node[1]\pos[1],c\node[1]\pos[2],0,128,255)
      EndIf
   Next
End Function

Function TPath_Show(path.TPathNode)
   If path = Null Return
   Local pn.TPathNode = path
   While pn<>Null
      If pn\nextPathNode<>Null
         c.TConnection = TConnection_getConnection.TConnection(pn\node\id,pn\nextPathNode\node\id)
         If c\entity FreeEntity c\entity
         c\entity = Line3D(mesh,c\node[0]\pos[0],c\node[0]\pos[1],c\node[0]\pos[2],c\node[1]\pos[0],c\node[1]\pos[1],c\node[1]\pos[2],255,128,0)
      EndIf
      pn = pn\nextPathNode
   Wend
End Function


QuicksortQueue.bb
Code: [AUSKLAPPEN]

Type TQuicksortLink
   Field value#
   Field objHandle%
End Type

Function TQuicksortLink_create.TQuicksortLink(value#,objectHandle%)
   Local pl.TQuicksortLink = New TQuicksortLink
   pl\value = value
   pl\objHandle = objectHandle
   Return pl
End Function

Function TQuicksortLink_removeFirst%()
   Local l.TQuicksortLink = First TQuicksortLink
   If l<>Null
      Local h% = l\objHandle
      Delete l
      Return h
   EndIf
End Function

Function TQuicksortLink_removeLast%()
   Local l.TQuicksortLink = Last TQuicksortLink
   If l<>Null
      Local h% = l\objHandle
      Delete l
      Return h
   EndIf
End Function

Function TQuicksort_clear()
   For ql.TQuicksortLink = Each TQuicksortLink
      Delete ql
   Next
End Function

Function TQuicksort_sort()
   TQuicksort_sortPart(First TQuicksortLink,Last TQuicksortLink)
End Function

Function TQuicksort_sortPart(f.TQuicksortLink,l.TQuicksortLink)
   If f = l Return
   If l = Null Return
   If f = Null Return
   
   p.TQuicksortLink = f
   e.TQuicksortLink = l
   ;p = pivot element
   this.TQuicksortLink = f
   enum.TQuicksortLink = After this
   
   While this<>e And enum<>Null
      this = enum
      enum = After enum

      
      If this\value < p\value
         Insert this Before f
         f = this
      Else
         Insert this After l
         l = this
      EndIf
   Wend
   
   TQuicksort_sortPart(f,p)
   TQuicksort_sortPart(After p,l)
End Function


Spannbaum.bb
Code: [AUSKLAPPEN]




Const NODES%=500
Global NODES_XDIST# = 100 / 2
Global NODES_YDIST# = 100 / 2
Global NODES_ZDIST# = 100 / 2

Global CurrentConnections_counter% = 0
Dim CurrentConnectionsArray.TConnection(NODES-1)

Dim NODE_ARRAY.TNode(NODES)
Type TNode
    Field id%
    Field entity%
    Field pos#[3]
   Field connected%
End Type

Function TNode_getDistanceBetween(n1.TNode,n2.TNode)
   Return Sqr(n1\pos[0]-n2\pos[0])*(n1\pos[0]-n2\pos[0])+(n1\pos[1]-n2\pos[1])*(n1\pos[1]-n2\pos[1])+(n1\pos[2]-n2\pos[2])*(n1\pos[2]-n2\pos[2])
End Function

Type TConnection
   Field node.TNode[2]
   Field dist#
   Field valid%
   Field entity%
End Type

Global CONNECTIONS% = TConnection_calcConnCount%()
Dim CONNECTION_ARRAY.TConnection(CONNECTIONS)

Function TConnection_calcConnCount%()
   Return (NODES*(NODES+1)/2) - NODES; See http://de.wikipedia.org/wiki/Der_kleine_Gau%C3%9F
End Function

Function minInt(c1%,c2%)
   If c1<=c2 Return c1
   Return c2
End Function

Function maxInt(c1%,c2%)
   If c1>=c2 Return c1
   Return c2
End Function

Function TConnection_getConnection.TConnection(n1%,n2%)
   If n1=n2 Return Null
   Return CONNECTION_ARRAY(TConnection_getArrayPos(n1,n2))
End Function

Function TConnection_getArrayPos%(n1%,n2%)
   Local na% = minInt(n1,n2)
   Local nb% = maxInt(n1,n2)
   Local pos% = 0
   For i% = 1 To na
      pos = pos + Sgn((na-i)) * (NODES - i)
   Next
   pos = pos + (nb-na) - 1
   Return pos
End Function

Function TConnection_getConnectionTest()
For i% = 5000 To 5005
Local c2.TConnection = TConnection_getConnection((i/1000)+1,(i Mod 1000)+1)
If c2<>Null
   Print ((i/1000)+1)+"/"+((i Mod 1000)+1) + " = "+c2\node[0]\id + "/"+c2\node[1]\id
EndIf
Next
End Function


Function TNode_InitAll()
   DebugLog "Init Nodes"
   For i% = 1 To NODES
      Local n.TNode = New TNode
      n\id = i
      n\pos[0] = Rnd(-NODES_XDIST,NODES_XDIST)
      n\pos[1] = Rnd(-NODES_YDIST,NODES_YDIST)
      n\pos[2] = Rnd(-NODES_ZDIST,NODES_ZDIST)
      NODE_ARRAY(i-1) = n
   Next
End Function

Function TConnection_Create.TConnection(n1.TNode,n2.TNode)
   Local c.TConnection = New TConnection
   c\node[0] = n1
   c\node[1] = n2
   c\dist = (n1\pos[0]-n2\pos[0])*(n1\pos[0]-n2\pos[0])+(n1\pos[1]-n2\pos[1])*(n1\pos[1]-n2\pos[1])+(n1\pos[2]-n2\pos[2])*(n1\pos[2]-n2\pos[2])
   Return c
End Function

Function TConnection_InitAll()
   DebugLog "Init Connections"
   Local stmp% = NODES-1
   Local c% = 0
   TQuicksort_Clear()
   For i1% = 0 To stmp
      For i2% = i1 To stmp
         If i1<>i2
            CONNECTION_ARRAY(c) = TConnection_Create(NODE_ARRAY(i1),NODE_ARRAY(i2))
            TQuicksortLink_create.TQuicksortLink(CONNECTION_ARRAY(c)\dist,Handle(CONNECTION_ARRAY(c)))
            c = c + 1
         EndIf
      Next
   Next
   DebugLog "sorting connections: ..."
   Local time% = MilliSecs()
   TQuicksort_sort()
   DebugLog "sorting connections: finished within "+(MilliSecs()-time)+" ms"
End Function



Function TConnection_CreateSpanningTree(startNode.TNode)
   DebugLog "Reset"
   CurrentConnections_counter = 0
   For n.TNode = Each TNode
      n\connected = False
   Next
   For c.TConnection = Each TConnection
      c\valid = False
   Next

   DebugLog "calculating min spanning tree"
   startNode\connected = True
   For i% = 1 To NODES
      TConnection_CreateSpanningTree_Sub()
   Next
   
   DebugLog "cleaning up"
   ;For qsl.TQuicksortLink = Each TQuicksortLink
   ;   Local c.TConnection = Object.TConnection(qsl\objHandle)
   ;   If c\node[0]\connected And c\node[1]\connected
   ;      Local pos% = TConnection_getArrayPos%(c\node[0]\id,c\node[1]\id)
   ;      If CONNECTION_ARRAY(pos)<>Null Delete CONNECTION_ARRAY(pos)
   ;      CONNECTION_ARRAY(pos) = Null
   ;   EndIf
   ;Next
   TQuickSort_clear()
   
   DebugLog "finished calc spanning tree"
   For i% = 0 To NODES-1
      c.TConnection = CurrentConnectionsArray(i)
      If c<>Null DebugLog "c "+c\node[0]\id+" <--> "+c\node[1]\id+" dist:"+c\dist
   Next
End Function

Function TConnection_CreateSpanningTree_Sub()
   ;Kleinste Kante wählen die Graph mit noch nicht verb. Knoten verbindet.
   For qsl.TQuicksortLink = Each TQuicksortLink
   
      Local c.TConnection = Object.TConnection(qsl\objHandle)
      
      If c\node[0]\connected Xor c\node[1]\connected
         c\node[0]\connected = True
         c\node[1]\connected = True
         c\valid = True
         
         CurrentConnectionsArray(CurrentConnections_counter) = c
         CurrentConnections_counter = CurrentConnections_counter + 1
         
         Delete qsl
         Return
      EndIf
   Next
End Function


LinkedList.bb
Code: [AUSKLAPPEN]
;LinkedList.bb
;version 1.0
;by Christian Geißler
;24.1.2009

;;Beispiel zur Benutzung:
;Local list.TList = new TList
;TList_addLast(list,5) ;werte Einfügen (oder Handles)
;TList_addLast(list,2) ;werte Einfügen (oder Handles)
;
;;Beispiel zum durchgehen der Links
;Local link.TLink = TList_firstLink(list)
;While link<>Null
;   Print TLink_value(link)
;   link = TLink_nextLink(link)
;Wend



;STRUCT TList
Type TList
   Field f.TLink ;first link
   Field l.TLink ;last link
   Field count%
End Type

Function TList_first%(l.TList)
   Return TLink_value(l\f)
End Function

Function TList_last%(l.TList)
   Return TLink_value(l\l)
End Function

Function TList_firstLink.TLink(l.TList)
   Return l\f
End Function

Function TList_lastLink.TLink(l.TList)
   Return l\l
End Function

Function TList_addLast.TLink(list.TList,value%)
   Local newLink.TLink = TLink_create(list,list\l,Null,value)
   Return newLink
End Function

Function TList_insertBeforeLink(link.TLink,value%)
   TLink_insertBefore(link,value)
End Function

Function TList_insertAfterLink(link.TLink,value%)
   TLink_insertAfter(link,value)
End Function

Function TList_addFirst.TLink(list.TList,value%)
   Local newLink.TLink = TLink_create(list,Null,list\f,value)
   Return newLink
End Function


;removes last link and returns its value
Function TList_removeLast%(l.TList)
   Return TLink_remove(l\l)
End Function

;removes first link and returns its value
Function TList_removeFirst%(l.TList)
   Return TLink_remove(l\f)
End Function

;returns count of elements in this list
Function TList_count%(l.TList)
   Return l\count
End Function

;clears all values from list
Function TList_clear(l.TList)
   While l\f<>Null
      TList_removeFirst(l.TList)
   Wend
End Function

;STRUCT TLink
Type TLink
   Field n.TLink ;next link
   Field p.TLink ;previous link
   Field list.TList
   Field value%
End Type

Function TLink_create.TLink(list.TList,pL.TLink,nL.TLink,val%)
   If list = Null Return Null
   Local l.TLink = New TLink
   l\p = pL
   l\n = nL

   If pL<>Null
      If pL\n = nL
         pL\n = l
      Else
         DebugLog "ERROR"
      EndIf
   Else
      ;then this should be the first one
      list\f = l
   EndIf
   
   If nL<>Null
      If nL\p = pL
         nL\p = l
      Else
         DebugLog "ERROR"
      EndIf
   Else
      ;then this should be the last one
      list\l = l
   EndIf
   
   l\list = list
   list\count = list\count + 1
   l\value = val
   Return l
End Function

   
Function TLink_insertBefore(link.TLink,value%)
   TLink_create(link\list,link\p,link,value)
End Function

Function TLink_insertAfter(link.TLink,value%)
   TLink_create(link\list,link,link\n,value)
End Function

Function TLink_value%(link.TLink)
   If link<>Null Return link\value
End Function

Function TLink_nextLink.TLink(link.TLink)
   Return link\n
End Function

Function TLink_prevLink.TLink(link.TLink)
   Return link\p
End Function

Function TLink_remove%(l.TLink)
   If l = Null Return
   If l\p<>Null
      l\p\n = l\n
   EndIf
   
   If l\n<>Null
      l\n\p = l\p
   EndIf
   
   If l=l\list\f
      l\list\f = l\n
   EndIf
   
   If l=l\list\l
      l\list\l = l\p
   EndIf
   
   l\list\count = l\list\count - 1
   
   l\p = Null
   l\n = Null
   l\list = Null
   
   Local val% = l\value
   
   Delete l
   
   Return val
End Function


PriorityQueue.bb
Code: [AUSKLAPPEN]
;PriorityQueue.bb
;version 1.1
;by Christian Geißler
;24.1.2009




Type TPriorityQueue
   Field list.TList
End Type

Function TPriorityQueue_create.TPriorityQueue()
   Local pq.TPriorityQueue = New TPriorityQueue
   pq\list = New TList
   Return pq
End Function

Function TPriorityQueue_delete(pq.TPriorityQueue)
   TList_clear(pq\list)
   pq\list = Null
   Delete pq
End Function

Function TPriorityQueue_clear(pq.TPriorityQueue)
   TList_clear(pq\list)
End Function


;Adds an objectHandle whitch might be a very low one
;meaning it starts testing from the lower end of the list
Function TPriorityQueue_addLowest(pq.TPriorityQueue,objectHandle%,value#)
   Local newPL.TPriorityLink = TPriorityLink_create(value,objectHandle)
   Local oldPL.TPriorityLink = Null
   Local link.TLink = TList_firstLink(pq\list)
   While link<>Null
      oldPL = Object.TPriorityLink(TLink_value(link))
      If newPL\value<=oldPL\value
         TList_insertBeforeLink(link,Handle(newPL))
         Return
      EndIf
      link = TLink_nextLink(link)
   Wend
   TList_addLast(pq\list,Handle(newPL))
End Function

;Adds an objectHandle whitch might be a very high one
;meaning it starts testing from the higher end of the list
Function TPriorityQueue_addHighest(pq.TPriorityQueue,objectHandle%,value#)
   Local newPL.TPriorityLink = TPriorityLink_create(value,objectHandle)
   Local oldPL.TPriorityLink = Null
   
   Local link.TLink = TList_lastLink(pq\list)
   While link<>Null
      oldPL = Object.TPriorityLink(TLink_value(link))
      If newPL\value>=oldPL\value
         TList_insertAfterLink(link,Handle(newPL))
         Return
      EndIf
      link = TLink_prevLink(link)
   Wend
   TList_addFirst(pq\list,Handle(newPL))
End Function

;Adds an objectHandle to either the end or the beginning of the list (takes that one that seems better)
Function TPriorityQueue_add(pq.TPriorityQueue,objectHandle%,value#)
   Local pl.TPriorityLink = Object.TPriorityLink(TList_first(pq\list))
   If pl<>Null
      If pl\value > value ;insert at the beginning
         TPriorityQueue_addLowest(pq,objectHandle%,value#)
      Else
         TPriorityQueue_addHighest(pq,objectHandle%,value#)
      EndIf
   Else
      TPriorityQueue_addLowest(pq,objectHandle%,value#)
   EndIf
End Function

;returns: Handle of object with lowest value
Function TPriorityQueue_getLowest%(pq.TPriorityQueue)
   Local pl.TPriorityLink = Object.TPriorityLink(TList_first(pq\list))
   If pl<>Null Return pl\objHandle
End Function

;returns: Handle of object with highest value
Function TPriorityQueue_getHighest%(pq.TPriorityQueue)
   Local pl.TPriorityLink = Object.TPriorityLink(TList_last(pq\list))
   If pl<>Null Return pl\objHandle
End Function

;returns: Handle of object with lowest value
Function TPriorityQueue_removeLowest%(pq.TPriorityQueue)
   Local pl.TPriorityLink = Object.TPriorityLink(TList_removeFirst(pq\list))
   If pl<>Null Return pl\objHandle
End Function

;returns: Handle of object with highest value
Function TPriorityQueue_removeHighest%(pq.TPriorityQueue)
   Local pl.TPriorityLink = Object.TPriorityLink(TList_removeLast(pq\list))
   If pl<>Null Return pl\objHandle
End Function

Function TPriorityQueue_count%(pq.TPriorityQueue)
   Return TList_count(pq\list)
End Function




Type TPriorityLink
   Field value#
   Field objHandle%
End Type

 Function TPriorityLink_create.TPriorityLink(value#,objectHandle%)
   Local pl.TPriorityLink = New TPriorityLink
   pl\value = value
   pl\objHandle = objectHandle
   Return pl
 End Function


AStar.bb
Code: [AUSKLAPPEN]
;AStar for TNode and TConnection

;include Spannbaum.bb
;include PriorityQueue.bb


;finds a minimal path between start and finish
;(Hinweis: Sucht aus praktischen Gründen vom Ende zum Start, damit die Liste nachher nicht umgedreht werden muss.
Function AStar_getPath.TPathNode(start.TNode,finish.TNode)
   Local visited%[NODES]
   Local n.TPathNode = Null
   Local nn.TPathNode = Null
   Local whitelist.TPriorityQueue = TPriorityQueue_create()
   
   n = TPathNode_create(finish,Null)
   TPriorityQueue_addLowest(whitelist,Handle(n),TPathNode_CalcValue(n,start))
   visited[n\node\id] = True

   While n\node <> start
      n = Object.TPathNode(TPriorityQueue_removeLowest%(whitelist))
      If n = Null Exit
      If n\node = start Exit
      
      For i% = 0 To NODES-1
         Local c.TConnection = CurrentConnectionsArray(i)
         If c<>Null
            If c\node[0] = n\node Or c\node[1] = n\node
               If Not visited[c\node[1]\id]
                  visited[c\node[1]\id] = True
                  nn = TPathNode_create(c\node[1],n)
                  TPriorityQueue_addLowest(whitelist,Handle(nn),TPathNode_CalcValue(nn,start))
               ElseIf Not visited[c\node[0]\id]
                  visited[c\node[0]\id] = True
                  nn = TPathNode_create(c\node[0],n)
                  TPriorityQueue_addLowest(whitelist,Handle(nn),TPathNode_CalcValue(nn,start))
               EndIf
            
            EndIf
         EndIf
      Next
   Wend
   TPriorityQueue_Delete(whitelist)
   Return n
End Function





Type TPathNode
   Field node.TNode
   Field nextPathNode.TPathNode
   Field value#
   Field travelDist# ;left over travel distance to target point
End Type

Function TPathNode_create.TPathNode(node.TNode,nextNode.TPathNode)
   Local pn.TPathNode = New TPathNode
   pn\node = node
   pn\nextPathNode = nextNode
   If nextNode<>Null
      pn\travelDist = nextNode\travelDist + TNode_getDistanceBetween(node,nextNode\node)
   EndIf
   Return pn
End Function

;calculates node value
;this is the heuristic of AStar
Function TPathNode_CalcValue#(current.TPathNode,start.TNode)
   Return TNode_getDistanceBetween(current\node,start) + current\travelDist
End Function

Function TPathNode_deletePath(path.TPathNode)
   While path<>Null
      Local n.TPathNode = path\nextPathNode
      Delete path
      path = n
   Wend
End Function
www.illusion-games.de
Space War 3 | Space Race | Galaxy on Fire | Razoon
Gewinner des BCC #57 User posted image
 

Krischan

 BeitragDi, Jan 27, 2009 21:50
Antworten mit Zitat
Benutzer-Profile anzeigen
Ich bin mehr als beeindruckt. Genauso sollte das aussehen, uiiiii Very Happy Vielen Dank! Du solltest das ins Codearchiv posten, das kann man bestimmt auch prima für andere Dinge verwenden (Navigationssystem o.ä.).

Eine Frage habe ich noch: wenn ich 1000 Nodes erstelle anstatt 500 braucht das Programm fast 4x so lange, woran liegt denn das? Müsste der Aufwand nicht linear ansteigen? Habs mal grob gemessen:

10 Nodes = 250ms
50 Nodes = 250ms
100 Nodes = 250ms
200 Nodes = 300ms
300 Nodes = 400ms
400 Nodes = 500ms
500 Nodes = 700ms
750 Nodes = 1400ms
1000 Nodes = 2400ms
1500 Nodes = 5700ms

Die Zeit für die Pfadsuche hingegen ist sehr schnell: unter 15ms bei 500 Nodes!

Firstdeathmaker

 BeitragMi, Jan 28, 2009 21:28
Antworten mit Zitat
Benutzer-Profile anzeigen
Nein. Der Aufwand des Kruskal-Algorithmus wird hauptsächlich vom benutzten Sortieralgorithmus bestimmt. Und dieser ist Quicksort, mit einer Laufzeit zwischen Optimal O(n*log(n)) und WorstCase O(n^2).

Ich hab in meinem Code mal den Quicksort durch einen von Ralliman geschriebenen ersetzt, welcher noch etwas besser optimiert ist, aber das ändert nichts am mehr als linearen Anstieg der Laufzeit für größere n.

Man kann durch die Änderung nochmal 6% mehr Geschwindigkeit rausholen (nach meinen Messungen).

https://www.blitzforum.de/foru...=quicksort

QuickSortQueue.bb
Code: [AUSKLAPPEN]
;QuickSortQueue.bb
;version 1.0
;by Christian Geißler
;using Rallimen's Quicksort Program
;24.1.2009


Type TQuicksortLink
   Field value#
   Field objHandle%
End Type

Function TQuicksortLink_create.TQuicksortLink(value#,objectHandle%)
   Local pl.TQuicksortLink = New TQuicksortLink
   pl\value = value
   pl\objHandle = objectHandle
   Return pl
End Function

Function TQuicksortLink_removeFirst%()
   Local l.TQuicksortLink = First TQuicksortLink
   If l<>Null
      Local h% = l\objHandle
      Delete l
      Return h
   EndIf
End Function

Function TQuicksortLink_removeLast%()
   Local l.TQuicksortLink = Last TQuicksortLink
   If l<>Null
      Local h% = l\objHandle
      Delete l
      Return h
   EndIf
End Function

Function TQuicksort_clear()
   For ql.TQuicksortLink = Each TQuicksortLink
      Delete ql
   Next
End Function


Function TQuicksort_sort()
    L.TQuicksortLink = First TQuicksortLink
    If L.TQuicksortLink = Null  Return
    R.TQuicksortLink = Last TQuicksortLink
    If L.TQuicksortLink = R.TQuicksortLink  Return
    TQuicksort_sortPart(L.TQuicksortLink,R.TQuicksortLink)
End Function

Function TQuicksort_sortPart(P1.TQuicksortLink,P2.TQuicksortLink)
    ;Rallimen
    P4.TQuicksortLink = P1:P3.TQuicksortLink = P1
    While Not P5
        P3.TQuicksortLink = After P3
        If P3.TQuicksortLink = P2  P5 = True
        If P3\value < P4\value 
            If P5  P2.TQuicksortLink = Before P2
            P6.TQuicksortLink = P3 : P3.TQuicksortLink = Before P3
            Insert P6.TQuicksortLink Before P1 : P1.TQuicksortLink = P6
         Else
            If P3\value = P4\value 
                If P7.TQuicksortLink = Null 
                    P7.TQuicksortLink = P3 :P3.TQuicksortLink = Before P3
                    If P5  P2.TQuicksortLink = Before P2
                    Insert P7.TQuicksortLink Before P4
                    If P4.TQuicksortLink = P1.TQuicksortLink  P1.TQuicksortLink = P7
                 Else
                    P6.TQuicksortLink = P3
                    P3.TQuicksortLink = Before P3
                    If P5  P2.TQuicksortLink = Before P2
                    Insert P6.TQuicksortLink Before P4
                End If
            End If
        End If
    Wend
    If P7.TQuicksortLink = Null 
        If P4.TQuicksortLink <> P1  P8.TQuicksortLink = Before P4
     Else
        If P7.TQuicksortLink <> P1  P8.TQuicksortLink = Before P7
    End If
    If P8.TQuicksortLink <> Null  If P8.TQuicksortLink <> P1  TQuicksort_sortPart P1.TQuicksortLink,P8.TQuicksortLink
    If P4.TQuicksortLink <> P2 
        P9.TQuicksortLink = After P4
        If P9.TQuicksortLink <> Null  If P9.TQuicksortLink <> P2  TQuicksort_sortPart P9.TQuicksortLink,P2.TQuicksortLink
    End If
End Function
www.illusion-games.de
Space War 3 | Space Race | Galaxy on Fire | Razoon
Gewinner des BCC #57 User posted image

Neue Antwort erstellen


Übersicht BlitzBasic Blitz3D

Nach Oben

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group