[BMax1.34] A-Star Wegfindung multi-Directional Upd:01.10.09

Übersicht BlitzMax, BlitzMax NG Codearchiv & Module

Gehe zu Seite 1, 2  Weiter

Neue Antwort erstellen

BladeRunner

Moderator

Betreff: [BMax1.34] A-Star Wegfindung multi-Directional Upd:01.10.09

 BeitragSo, Aug 06, 2006 13:14
Antworten mit Zitat
Benutzer-Profile anzeigen
Aktuelle Version: 1.12

Der a-star Algo ermöglicht es auf einer vorhandenen Karte Wege zu suchen. Diese sind nicht immer die kürzesten, aber dafür findet A* garantiert einen Weg wenn es einen gibt. Zudem lassen sich Wegekosten berücksichtigen.

Der hier ausgearbeitete Algo befindet sich noch im Wachstum, ich freue mich über jeden Verbesserungsvorschlag.

Bedienung:

die Funktion erwartet (in folgender Reihenfolge) diese Parameter:

- startx, starty : Ints mit der Position des Startpunktes
- targetx, targety : Ints mit der Zielposition
- Map : TGameMap-Instanz welche die Karte enthält. Der Type ist im Quellcode mit enthalten und sollte selbsterklärend sein.
- layer : welches Layer der Map enthält die Karteninfos. Default: 0
- block : Welcher Karteninhalt blockiert den Weg. Default: -1
- returnnearest : wenn true wird der dem Ziel am nächsten liegende gefundene Punkt zurückgegeben, sollte das Ziel nicht zu erreichen sein. Default: false
- weight : Art der Gewichtung, sowie bei astar8: Diagonalenglättung. Wird per Flag gesteuert. Default: 0
Vorhandene Flags:
* ASWEIGHTENED: Die Werte in layer werden als Wegekosten interpretiert
* ASHEIGHTENED: Die Werte in hlayer werden als Höhendifferenzen bestraft.
* ASCLIMBNFALL: s.o., jedoch wird ein Abstieg nur halb bestraft.
* ASSMOOTHENED: (astar8) Diagonalen werden vermieden.
- hlayer : Kartenlayer für Höhenbestrafung. Wenn default wird layer verwendet. Default: -1
- mode : (nur astar6) Ausrichtung der Karte. 0: oberste Zeile ist Rechtsbündig, 1: oberste Zeile ist linksbündig. Default: 0

~Edit~
kleiner Fehler gefixt der zum Absturz führte wenn ausser der Startnode keine begehbar war. Code editiert.
~Edit 2~
v1.03
- TMap umbenannt in TGameMap um Kollisionen mit dem BMax-internen Type zu vermeiden
- Richtungsänderungen werden nun "bestraft".
~Edit 3~
v1.04
- Code superstrict-konform umgestaltet.
~big Edit~
v1.09
- nun wird 4,6(hex), sowie 8-directional unterstützt. Dafür gibt es aus Performancegründen jeweils eine eigene Function. Ich habe zwar einen Multiheader integriert, kann den wegen des entstehenden Datenberges aber nicht empfehlen.
Achtung: seit v1.04 hat sich der Funktionsheader verändert, d.h. es besteht keine Schnittstellenkompatiblität mehr.
- Es wird nun die Möglichkeit verschiedener Wegekosten berücksichtigt. (weight = true). Die neue Demo zeigt dieses Feature. Einfach mal damit rumspielen.
- der Hexagonale A*Star lässt per mode eine Umschaltung zu wie die Karte gegliedert ist. Mode 0: die oberste Zeile ist rechts verschoben, 1: die oberste Zeile ist linksbündig.
- Kleinere Änderungen an der Demo zur besseren Verständlichkeit.

~Edit 5 ~ (15.08.06)
v1.11
- Gewichtung nach verschiedenen Kriterien möglich: reine Wegekosten, Höhendifferenzen, gewichtete Höhendifferenzen. Die Modi sind per bitweisem oder kombinierbar (siehe dazu Beispielcode).
Die Schnittstelle musste auch dieses mal angepasst werden und ist nicht mehr kompatibel zu v1.09.
- mit der Gewichtung wurde auch die Möglichkeit aufgenommen bei AStar8 Diagonalbewegungen zu vermeiden. Führt zu 'natürlicheren' Wegen. Optional, da rechenzeitintensiv und in Kombi mit Gewichtung nicht immer sinnvoll. Danke an D2006 für die Anregung.
- Demo der neuen Funtionalität angepasst.

~Edit 6 ~ (01.10.09)
v1.12
- komplett auf OO umgebaut und Listenhandling auf TLink umgestellt, um die Geschwindigkeit weiter zu steigern.

ToDo:
-Zonenerkennung in TGameMap und Auswertung in AStar.

Kurze Anmerkung:
Dieser Code ist selbstredend gemäß der Richtlinien dieses Forums Public Domain, d.h. ein jeder möge ihn verändern und nutzen wie er es mag. Ich würde mich jedoch sehr freuen wenn ihr mir Feedback geben würdet, so dass ich ihn gegebenenfalls noch verbessern kann. Auch eine Erwähnung in den Credits, solltet ihr ihn benutzen, würde mich sehr freuen (wie gesagt kein muss, sondern ein kann).

BlitzMax: [AUSKLAPPEN] 
SuperStrict

Const ASWEIGHTENED:Int = %0001
Const ASSMOOTHENED:Int = %0010
Const ASHEIGHTENED:Int = %0100
Const ASCLIMBNFALL:Int = %1000

Type TGameMap

	'Daten:
	Field Map:Int[1,1,1] 'die Karte: b*h*layer, wobei aus performancegründen l,h,w gespeichert wird, da
	Field width:Int 'dann die einzelnen Layerdaten hintereinander im Speicher stehen.
	Field height:Int
	Field layer:Int
	Field _link:TLink
	
	'Globale Daten:
	Global Lmap:TList = New TList
	
	'Funktionen:
	Function Create:TGameMap(w:Int,h:Int,l:Int)
		'erstellt eine neue Karte in den angegebenen Dimensionen. Sie wird in Lmap gespeichert.
		Local instanz:TGameMap = New TGameMap
		instanz.map = New Int[l,h,w]
		instanz.width = w
		instanz.height = h
		instanz.Layer = l 
		instanz._link = lmap.addlast(instanz)
		Return instanz
	End Function
	
	'Methoden:
	Method resize(w:Int,h:Int,l:Int)
		'redimensioniert eine Karte. Der Inhalt wird soweit möglich erhalten.
		Local copyi:Int,copyj:Int,copyk:Int
		If w >= Self.width Then
			copyi = Self.width
		Else
			copyi = w
		EndIf
		If h >= Self.height Then
			copyj = Self.height
		Else
			copyj = h
		EndIf
		If l >= Self.layer Then
			copyk = Self.layer
		Else
			copyk = l
		EndIf
		Local tempmap:Int[copyk,copyj,copyi]
		
		For Local i:Int = 0 To copyi -1
			For Local j:Int = 0 To copyj -1
				For Local k:Int = 0 To copyk-1
					tempmap[k,j,i]=Self.map[k,j,i]
				Next
			Next
		Next
		
		Self.map = New Int[l,h,w]
		Self.width = w
		Self.height = h
		Self.Layer = l
		
		For Local i:Int = 0 To copyi -1
			For Local j:Int = 0 To copyj -1
				For Local k:Int = 0 To copyk-1
					Self.map[k,j,i]=tempmap[k,j,i]
				Next
			Next
		Next
		
	End Method
	
	Method getvalue:Int(w:Int,h:Int,l:Int)
		'liesst den Wert aus der angegebenen Zelle
		If (w >=0) And (w < Self.width) And (h >=0) And (h <Self.height) And (l >=0) And (l<Self.layer) Then
			Return Self.map[l,h,w]
		Else
			RuntimeError "Unable to perform 'Read' on 'Map':Index out of Bounds"
		EndIf
	
	End Method
	
	Method setvalue(w:Int,h:Int,l:Int,value:Int)
		'setzt den Wert in die angegebene Zelle
		If (w >=0) And (w < Self.width) And (h >=0) And (h <Self.height) And (l >=0) And (l<Self.layer) Then
			Self.map[l,h,w] = value
		Else
			RuntimeError "Unable to perform 'Write' on Map:Index out of Bounds"
		EndIf
	End Method
	
	Method fill(value:Int)
		'füllt die Map mit einem Wert
		For Local i:Int = 0 To Self.width -1
			For Local j:Int = 0 To Self.height -1
				For Local k:Int = 0 To Self.layer -1
					Self.map[k,j,i] = value
				Next
			Next
		Next
	End Method
	
	Method filllayer(l:Int,value:Int)
		'füllt einen layer mit einem Wert
		If l < Self.layer Then
			For Local i:Int = 0 To Self.width -1
				For Local j:Int = 0 To Self.height -1
					Self.map[l,j,i]= value
				Next
			Next
		EndIf
	End Method
	
	Method destroy:TGameMap()
	'zerstört die aktuelle Karteninstanz
	_link.remove()
	Return Null
	End Method
	
	Method draw(numbers:Int = False)
		'vorläufige Implementierung für Testzwecke Astar
		Local i:Int,j:Int,k:Int
		For i = 0 To Self.width-1
			For j = 0 To Self.height-1
				For k = 0 To Self.layer-1
					If Self.map[k,j,i] = -1 Then
						SetColor 155+10*k,0,0
					Else
						SetColor 10+15*Self.map[k,j,i],10+24*Self.map[k,j,i],10+15*Self.map[k,j,i]
					EndIf
						DrawRect i*30,j*30,25-(k*3),25-(k*3)
					If numbers= True Then
						SetColor 255,255,255
						DrawText Self.map[k,j,i],i*30,j*30
					EndIf
				Next
			Next
		Next
	End Method

End Type
'____________________________________________________________________________________________________

'____________________________________________________________________________________________________
Type TNode

	'Daten:
	Field lastnode:TNode
	Field x:Int,y:Int
	Field cost:Float,aprox:Float
	Field direction:Byte
	Field _link:TLink
	
	'Globale Daten:
	Global LOpen:TList = New TList
	Global LClose:TList = New TList
	
	'Funktionen:
	Function Create:TNode()
		'erstellt einen neuen Knoten.
		Local instanz:TNode = New TNode
		Return instanz
	End Function
	
	Function clear()
		'löscht die Offene und die geschlossene Liste
		LOpen.Clear()
		LClose.Clear()
	End Function
	
	Function draw(ldraw:TList)
		'zeichnet den Weg der gefunden wurde ein. Testimplementierung.
		SetColor 0,0,200
		If ldraw = Null Then Return
		For Local drawnode:TNode = EachIn Ldraw
			DrawRect drawnode.x*30+10,drawnode.y*30+10,10,10
		Next
	End Function
	
	Function AStar:TList(algo:Int,startX:Int,startY:Int,targetX:Int,targetY:Int,map:TGameMap,layer:Int = 0,..
	block:Int = -1,Returnnearest:Int = False,weight:Int=0,hlayer:Int = -1,mode:Int =0)
		'Schnittstelle, erlaubt es alle a* mit einer Function aufzurufen.
		Local Lreturn:TList = New TList
		
		Select algo
			Case 4
				lreturn = astar4(startX,startY,targetX,targetY,map,layer,block,Returnnearest,weight,hlayer)
			Case 6
				lreturn = astar6(startX,startY,targetX,targetY,map,layer,block,Returnnearest,weight,hlayer,mode)
			Case 8
				lreturn = astar8(startX,startY,targetX,targetY,map,layer,block,Returnnearest,weight,hlayer)
			Default RuntimeError "Unknown Pathfinding Method requested."
		End Select
		
		Return lReturn
	
	End Function
	
	Function AStar8:TList(startX:Int,startY:Int,targetX:Int,targetY:Int,map:TGameMap,layer:Int = 0,..
	block:Int = -1,Returnnearest:Int = False,Weight:Int = 0, hlayer:Int = -1)
		'Der AStar-Algo für 8 Richtungen. Block gibt an welcher Karteneintrag für blockerte Wege
		'gilt, Map ist die Karte die für die Wegfindung benutzt wird.
		'weight: Weightened: Gewichtung der Felder als Kosten
		' smoothened: Diagonalen werden geglättet (sehr viel langsamer!)
		' heightened: Höhendifferenzen gelten als Wegekosten
		' ClimbnFall: s.o., zusätzlich wird Abstieg nur halb gewertet
		' ist einer der beiden letzten gewählt, wird hlayer hinzugezogen, falls gesetzt.
		
		TNode.clear() 'die Listen werden gesäubert

		Local Start:TNode= TNode.Create() 'Der Startpunkt wird erschaffen
		start.setcoords(startx,starty) 'Die Startkoorinaten werden eingetragen
		start.addopen() 'und der Startpunkt wird auf die offene Liste gesetzt.
		start.cost = 0

		Local Target:TNode = TNode.Create() 'das Ziel wird erschaffen
		Target.setcoords(targetX,targety) 'und mit Koordinaten versehen
		start.aprox = Sqr((target.x-start.x)^2+(target.y-start.y)^2) 'Kostenschätzung Startfeld
		
		Local search:TNode = start 'nun beginnt der Reigen: Start ist der erste untersuchte Knoten
		Local done:Int = False 'Noch kein Ziel gefunden
		Local donenode:TNode 'Nodeinstanz für das Zielfeld
		While (Not done) And (Not LOpen.IsEmpty()) 'solange es noch offene Knoten zum untersuchen gibt
			'DebugStop
			search.close() 'die aktuelle Node wird bearbeitet und ist daher geschlossen
			Local direction:Byte = 0
			For Local x:Int = -1 To 1 'untersuche die umliegenden Felder
				For Local y:Int = -1 To 1
					direction :+ 1
					Local tempx:Int = search.x+x
					Local tempy:Int = search.y+y
					If tempx = target.x And tempy = target.y Then 'Ziel gefunden ?
						done = True 'Ziel gefunden !
						donenode = TNode.Create() 'nun wird donenode erschaffen
						donenode.lastnode=search 'und der letzte schritt dort hin gespeichert
						donenode.setcoords(tempx,tempy)
						donenode.direction = direction
					EndIf
					If (tempx >=0) And (tempx < map.width) And (tempy>=0) And (tempy<map.height) Then 'gültige Kartenposition?
						If (x + 2*y) Then 'falls nicht der Mittelpunkt (ist nur 0 wenn beide Komponenten es sind)
						Local tempfound:Int = False 'das untersuchte Feld ist noch nicht in der Liste der offenen Felder ?
						For Local secsearch:TNode = EachIn LOpen
							If (secsearch.x = tempx) And (Secsearch.y=tempy) Then
								tempfound = True 'doch, ist es
							EndIf
						Next
						For Local secsearch:TNode = EachIn LClose 'und bei den geschlossenen vielleicht ?
							If (secsearch.x = tempx) And (Secsearch.y=tempy) Then
								tempfound = True 'doch, ist es
							EndIf
						Next
						If (tempfound = False) And (map.getvalue(tempx,tempy,layer) <> block) Then 'wenn der Knoten noch nicht bekannt war
							Local node:TNode = TNode.Create() 'dann ist er es jetzt
							Node.setcoords(tempx,tempy) 'wo ist er
							node.lastnode = search 'von wo wurde er erreicht ?
							
							node.direction = direction
							Local add:Float
							If direction <> search.direction Then
								add:Float = 0.1
							End If
							node.cost = search.cost +Sqr(Abs(x)+Abs(y)) + add+ (map.getvalue(tempx,tempy,layer)*(weight & ASWEIGHTENED)) 'wie teuer war es her zu kommen (es werden für Diagonalen mehr berechnet.) ?
		
							If (weight & ASHEIGHTENED) Then 'Höhendifferenzbestrafung
								If hlayer = -1 Then hlayer = layer
									add = Abs(map.getvalue(node.lastnode.x,node.lastnode.y,hlayer) - map.getvalue(node.x,node.y,hlayer))
									node.cost :+ add
								EndIf
		
								If (weight & ASCLIMBNFALL) Then 'Höhendifferenzbestrafung 2: Anstieg schwerer Abstieg
									If hlayer = -1 Then hlayer = layer
										add = map.getvalue(node.lastnode.x,node.lastnode.y,hlayer) - map.getvalue(node.x,node.y,hlayer)
										If add > 0 Then
											node.cost :+ (add/2)
										Else
											node.cost :- add
										EndIf
									EndIf
		
									node.aprox = Sqr((target.x-node.x)^2+(target.y-node.y)^2) 'wie lautet die Schätzung für den Rest der Strecke ?
									node.addopen() 'ab auf die Liste der zu bearbeitenden Knoten
									If (weight & ASSMOOTHENED) And (Sqr(Abs(x)+Abs(y)) > 1) Then node.cost :+.5
								EndIf
							EndIf
						EndIf
		
					Next
				Next
			Local mincost:Float =$7fffffff 'setze die Kosten auf ein maximum
			For Local secsearch:TNode = EachIn LOpen'nun suche in der Offenen Liste nach dem Knoten mit den geringsten zu erwartenden Gesamtkosten
				If (secsearch.cost + secsearch.aprox ) < mincost Then
					search = secsearch 'dieser ist dann der nächste Suchknoten für Astar und wird beim nächsten durchlauf auf die geschlossene gesetzt.
					mincost = (secsearch.cost+secsearch.aprox)
				End If
			Next
		Wend
		'dieser Teil wird abgearbeitet wenn: a) der Zielknoten erreicht wurde oder
		'b) kein offener Knoten mehr existiert, d.h. das Ziel nicht
		'erreicht werden kann.
		If (Returnnearest = True) And (done = False) Then 'soll der nächstmöglichste Punkt zurückgegeben werden ?
			Local mincost:Float= $7fffffff
			For Local secsearch:TNode = EachIn LClose 'dann suche in der geschlossenen Liste den Punkt mit den niedrigsten geschätzten Restkosten
				If secsearch.aprox < mincost Then
					donenode = secsearch
					mincost = secsearch.aprox
				End If
			Next
		EndIf
	
		If donenode <> Null Then 'wenn es ein Ziel gibt, erstelle die Liste mit den Wegpunkten
			Local Lreturn:TList = New TList
		Local loop:TNode = donenode
		
		Repeat
			loop._link = LReturn.AddFirst(loop)
			If loop.lastnode <> Null Then loop = loop.lastnode
		Until loop = start
		If Not LReturn.Contains(loop) Then loop._link = LReturn.AddFirst(loop) 'optional, so wird der Startpunkt auch als wegpunkt übergeben.
			Return LReturn
		Else 'wenn es kein Ziel gibt, gebe eine undefinierte Liste zurück
			Return Null
		EndIf
	
	End Function
	
	Function AStar4:TList(startX:Int,startY:Int,targetX:Int,targetY:Int,map:TGameMap,layer:Int = 0,..
	block:Int = -1,Returnnearest:Int = False,weight:Int = 0, hlayer:Int = -1)
		'Der AStar-Algo für 4 Richtungen.
		
		TNode.clear()
		Local Start:TNode= TNode.Create()
		start.setcoords(startx,starty)
		start.addopen()
		start.cost = 0
		
		Local Target:TNode = TNode.Create()
		Target.setcoords(targetX,targety)
		start.aprox = Sqr((target.x-start.x)^2+(target.y-start.y)^2)
		
		Local search:TNode = start
		Local done:Int = False
		Local donenode:TNode
		While (Not done) And (Not LOpen.IsEmpty())
			search.close()
			Local direction:Byte = 0
			For Local x:Int = -1 To 1
				For Local y:Int = -1 To 1
					If Sqr(Abs(x)+Abs(y)) = 1 Then
						direction :+ 1
						Local tempx:Int = search.x+x
						Local tempy:Int = search.y+y
						If tempx = target.x And tempy = target.y Then
							done = True
							donenode = TNode.Create()
							donenode.lastnode=search
							donenode.setcoords(tempx,tempy)
							donenode.direction = direction
						EndIf
						If (tempx >=0) And (tempx < map.width) And (tempy>=0) And (tempy<map.height) Then
							If (x + 2*y) Then
								Local tempfound:Int = False
								For Local secsearch:TNode = EachIn LOpen
									If (secsearch.x = tempx) And (Secsearch.y=tempy) Then
										tempfound = True
									EndIf
								Next
								For Local secsearch:TNode = EachIn LClose
									If (secsearch.x = tempx) And (Secsearch.y=tempy) Then
										tempfound = True
									EndIf
								Next
								If (tempfound = False) And (map.getvalue(tempx,tempy,layer) <> block) Then
									Local node:TNode = TNode.Create()
									Node.setcoords(tempx,tempy)
									node.lastnode = search
									node.addopen()
									node.direction = direction
									Local add:Float
									If direction <> search.direction Then
										add:Float = 0.1
									End If
								
									node.cost = search.cost +1 + add + (map.getvalue(tempx,tempy,layer)*(weight & ASWEIGHTENED))
								
									If (weight & ASHEIGHTENED) Then
										If hlayer = -1 Then hlayer = layer
										add = Abs(map.getvalue(node.lastnode.x,node.lastnode.y,hlayer) - map.getvalue(node.x,node.y,hlayer))
										node.cost :+ add
									EndIf
								
									If (weight & ASCLIMBNFALL) Then
										If hlayer = -1 Then hlayer = layer
										add = map.getvalue(node.lastnode.x,node.lastnode.y,hlayer) - map.getvalue(node.x,node.y,hlayer)
										If add > 0 Then
											node.cost :+ (add/2)
										Else
											node.cost :- add
										EndIf
									EndIf
					
									node.aprox = Sqr((target.x-node.x)^2+(target.y-node.y)^2)
								EndIf
							EndIf
						EndIf
					EndIf
				Next
			Next
			Local mincost:Float =$7fffffff
			For Local secsearch:TNode = EachIn LOpen
				If secsearch.cost + secsearch.aprox < mincost Then
					search = secsearch
					mincost = secsearch.cost+secsearch.aprox
				End If
			Next
		Wend
		
		If (Returnnearest = True) And (done = False) Then
			Local mincost:Float= $7fffffff
			For Local secsearch:TNode = EachIn LClose
				If secsearch.aprox < mincost Then
					donenode = secsearch
					mincost = secsearch.aprox
				End If
			Next
		EndIf
		
		If donenode <> Null Then
			Local Lreturn:TList = New TList
			Local loop:TNode = donenode
			
			Repeat
				loop._link = LReturn.AddFirst(loop)
				If loop.lastnode <> Null Then loop = loop.lastnode
			Until loop = start
			If Not Lreturn.contains(loop) Then loop._link=LReturn.AddFirst(loop)
			Return LReturn
		Else
			Return Null
		EndIf
	
	End Function
	
	Function AStar6:TList(startX:Int,startY:Int,targetX:Int,targetY:Int,map:TGameMap,layer:Int = 0,..
	block:Int = -1,Returnnearest:Int = False,weight:Int = 0,hlayer:Int = -1,mode:Int =0)
		'Der AStar-Algo für 6 Richtungen.
		'Mode gibt an ob die 0er (mode 1) oder die 1erreihe linksbündig steht.
		
		TNode.clear()
		Local Start:TNode= TNode.Create()
		start.setcoords(startx,starty)
		start.addopen()
		start.cost = 0
		
		Local Target:TNode = TNode.Create()
		Target.setcoords(targetX,targety)
		start.aprox = Sqr((target.x-start.x)^2+(target.y-start.y)^2)
		
		Local search:TNode = start
		Local done:Int = False
		Local donenode:TNode
		While (Not done) And (Not LOpen.IsEmpty())
			search.close()
			For Local direction:Byte = 1 To 6
				Local tempx:Int = 0
				Local tempy:Int = 0
				If ((search.y + mode) Mod 2) Then
					Select direction
						Case 1
							tempx=search.x-1
							tempy=search.y-1
						Case 2
							tempx=search.x
							tempy=search.y-1
						Case 3
							tempx=search.x+1
							tempy=search.y
						Case 4
							tempx=search.x
							tempy=search.y+1
						Case 5
							tempx=search.x-1
							tempy=search.y+1
						Case 6
							tempx=search.x-1
							tempy=search.y
					End Select
				Else
					Select direction
						Case 1
							tempx=search.x
							tempy=search.y-1
						Case 2
							tempx=search.x+1
							tempy=search.y-1
						Case 3
							tempx=search.x+1
							tempy=search.y
						Case 4
							tempx=search.x+1
							tempy=search.y+1
						Case 5
							tempx=search.x
							tempy=search.y+1
						Case 6
							tempx=search.x-1
							tempy=search.y
					End Select
				EndIf
	
				If tempx = target.x And tempy = target.y Then
					done = True
					donenode = TNode.Create()
					donenode.lastnode=search
					donenode.setcoords(tempx,tempy)
					donenode.direction = direction
				EndIf
				If (tempx >=0) And (tempx < map.width) And (tempy>=0) And (tempy<map.height) Then
					Local tempfound:Int = False
					For Local secsearch:TNode = EachIn LOpen
						If (secsearch.x = tempx) And (Secsearch.y=tempy) Then
							tempfound = True
						EndIf
					Next
					For Local secsearch:TNode = EachIn LClose
						If (secsearch.x = tempx) And (Secsearch.y=tempy) Then
							tempfound = True
						EndIf
					Next
					If (tempfound = False) And (map.getvalue(tempx,tempy,layer) <> block) Then
						Local node:TNode = TNode.Create()
						Node.setcoords(tempx,tempy)
						node.lastnode = search
						node.addopen()
						node.direction = direction
						Local add:Float
						If direction <> search.direction Then
							add:Float = 0.1
						End If
						node.cost = search.cost + 1 + add + (map.getvalue(tempx,tempy,layer)*(weight & ASWEIGHTENED))
	
						If (weight & ASHEIGHTENED) Then
							If hlayer = -1 Then hlayer = layer
							add = Abs(map.getvalue(node.lastnode.x,node.lastnode.y,hlayer) - map.getvalue(node.x,node.y,hlayer))
							node.cost :+ add
						EndIf
	
						If (weight & ASCLIMBNFALL) Then
							If hlayer = -1 Then hlayer = layer
							add = map.getvalue(node.lastnode.x,node.lastnode.y,hlayer) - map.getvalue(node.x,node.y,hlayer)
							If add > 0 Then
								node.cost :+ (add/2)
							Else
								node.cost :- add
							EndIf
						EndIf
	
						node.aprox = Sqr((target.x-node.x)^2+(target.y-node.y)^2)
					EndIf
				EndIf
			Next
			Local mincost:Float =$7fffffff
			For Local secsearch:TNode = EachIn LOpen
				If secsearch.cost + secsearch.aprox < mincost Then
					search = secsearch
					mincost = secsearch.cost+secsearch.aprox
				End If
			Next
		Wend
	
		If (Returnnearest = True) And (done = False) Then
			Local mincost:Float= $7fffffff
			For Local secsearch:TNode = EachIn LClose
				If secsearch.aprox < mincost Then
					donenode = secsearch
					mincost = secsearch.aprox
				End If
			Next
		EndIf
	
		If donenode <> Null Then
			Local Lreturn:TList = New TList
			Local loop:TNode = donenode
	
			Repeat
				loop._link = LReturn.AddFirst(loop)
				If loop.lastnode <> Null Then loop = loop.lastnode
			Until loop = start
			If Not LReturn.Contains(loop) Then loop._link = LReturn.AddFirst(loop)
			Return LReturn
		Else
			Return Null
		EndIf
	
	End Function
	
	'Methoden:
	Method Addopen()
		'fügt die Instanz der Suchliste hinzu.
		_link = LOpen.AddLast(Self)
	End Method
	
	Method Close()
		'entfernt die Instanz von der Offenen Liste und setzt sie auf die geschlossene Liste
		If _link <> Null Then
			_link.remove()
			_link = LClose.AddLast(Self)
		EndIf
	End Method
	
	Method setcoords(x:Int,y:Int)
		'Koordinaten einer Node festlegen
		Self.x = x
		Self.y = y
	End Method
	
End Type

'___________________________________________________________________________________________________

'Rem TESTCODE
SeedRnd MilliSecs()
Local test:TGameMap = TGameMap.Create(15,15,2)
For Local i:Int = 0 To 14
	For Local j:Int = 0 To 14
		test.setvalue(i,j,0,Rand(10))
	Next
Next
For Local i:Int = 0 To 14
	For Local j:Int = 0 To 14
		test.setvalue(i,j,1,Rand(2))
	Next
Next

AppTitle="A* Demo V1.12 ~~BladeRunner~~"
Graphics 640,480

Local startx:Int = 0
Local starty:Int = 0
Local endx:Int = 14
Local endy:Int = 14

Repeat
	Local zeit2:Int
	Local mx:Int = MouseX()
	Local my:Int = MouseY()
	Local mbl:Int = MouseHit(1)
	Local mbr:Int = MouseHit(2)
	Local shifted:Int
	
	If KeyDown(key_lshift) Or KeyDown(key_rshift) Then
		shifted = 1
	Else
		shifted = 0
	EndIf
	
	If mbl And shifted And test.getvalue(mx/30,my/30,0) > 0 Then
		test.setvalue(mx/30,my/30,0,test.getvalue(mx/30,my/30,0)-1)
	EndIf
	
	If mbr And shifted And test.getvalue(mx/30,my/30,0) < 10 Then
		test.setvalue(mx/30,my/30,0,test.getvalue(mx/30,my/30,0)+1)
	EndIf
	
	If mbl And (shifted = 0) And test.getvalue(mx/30,my/30,1) > -1 Then
		test.setvalue(mx/30,my/30,1,test.getvalue(mx/30,my/30,1)-1)
	EndIf
	
	If mbr And (shifted = 0) And test.getvalue(mx/30,my/30,1) < 2 Then
		test.setvalue(mx/30,my/30,1,test.getvalue(mx/30,my/30,1)+1)
	EndIf
	
	If KeyHit(key_left) Then
		Select shifted
			Case 0
				If startx >0 Then startx :-1
			Case 1
				If endx >0 Then endx :-1
		End Select
	EndIf
	
	If KeyHit(key_right) Then
		Select shifted
			Case 0
				If startx <test.width Then startx :+1
			Case 1
				If endx <test.width Then endx :+1
		End Select
	EndIf
	
	If KeyHit(key_up) Then
		Select shifted
			Case 0
				If starty >0 Then starty :-1
			Case 1
				If endy >0 Then endy :-1
		End Select
	EndIf
	
	If KeyHit(key_down) Then
		Select shifted
			Case 0
				If starty <test.height Then starty :+1
			Case 1
				If endy <test.height Then endy :+1
		End Select
	EndIf
	Local zeit:Int = MilliSecs()
	Local ldraw:TList=TNode.astar8(startx,starty,endx,endy,test,1,-1,True,ASWEIGHTENED|ASSMOOTHENED|ASCLIMBNFALL,0)
	zeit2 = MilliSecs()
	test.draw()
	TNode.draw(ldraw)
	DrawText "LMB: decrease Cost",450,0
	DrawText "RMB: increase Cost",450,20
	DrawText "Shift+ MB: alter Height",450,40
	DrawText "up/down/left/right:",450,80
	DrawText " Move Start",450,100
	DrawText "to move End: hold Shift",450, 130
	DrawText GCMemAlloced(),500,460
	
	DrawText (zeit2-zeit)+" ms",500,300
	Flip
	Cls
Until KeyHit(KEY_ESCAPE) Or AppTerminate()
'EndRem




für die Boardsuche: AStar a* A-Star a-Stern astern Wegfinder Wegfindung pathfinding pathfinder algoritmus
  • Zuletzt bearbeitet von BladeRunner am Do, Okt 01, 2009 18:09, insgesamt 4-mal bearbeitet

Farbfinsternis

 BeitragMi, Aug 09, 2006 16:37
Antworten mit Zitat
Benutzer-Profile anzeigen
Absolut brilliant. Ich spiele noch ein wenig damit herum und gebe Dir dann ein wenig mehr Feedback. bekommst von mir als erster den neuen "TimEd" sobald ich Deinen Code angepasst habe Smile
Farbfinsternis.tv

StepTiger

 BeitragMi, Aug 09, 2006 22:17
Antworten mit Zitat
Benutzer-Profile anzeigen
wenn es aber wirklich nach dem A* Prinzip funktionieren würde, dann MUSS dein Code den kürzesten Weg finden.

anders wäre es nicht der A* Algorithmus
Noch gestern standen wir am Abgrund, doch heute sind wir schon einen Schritt weiter.
Computer:
AMD Sempron 3000+; ATI Radeon 9800 Pro; 512 MB DDR RAM 400Mhz; Asus E7N8X-E Deluxe; Samsung 200GB HD 5.4ns acces t
Gewinner: BP Code Compo #2
Π=3.141592653589793238...<--- und das aus dem kopf Laughing
Seit der Earthlings-Diskussion überzeugter Fleisch(fr)esser.

Byteemoz

 BeitragMi, Aug 09, 2006 23:09
Antworten mit Zitat
Benutzer-Profile anzeigen
StepTiger hat Folgendes geschrieben:
wenn es aber wirklich nach dem A* Prinzip funktionieren würde, dann MUSS dein Code den kürzesten Weg finden.

anders wäre es nicht der A* Algorithmus

Nein. A* findet den "billigsten" Weg, wobei die Wegekosten oft auch von anderen Faktoren (Richtungswechsel oder Vermeiden/Bevorzugen von bestimmten Abschnitten auf der Karte) beeinflusst werden können.
-- Byteemoz
MaxIDE Community Edition: Summary | Bugs | Feature Requests | CVS Repository | Thread

StepTiger

 BeitragDo, Aug 10, 2006 0:53
Antworten mit Zitat
Benutzer-Profile anzeigen
Byteemoz hat Folgendes geschrieben:
StepTiger hat Folgendes geschrieben:

wenn es aber wirklich nach dem A* Prinzip funktionieren würde, dann MUSS dein Code den kürzesten Weg finden.

anders wäre es nicht der A* Algorithmus


Nein. A* findet den "billigsten" Weg, wobei die Wegekosten oft auch von anderen Faktoren (Richtungswechsel oder Vermeiden/Bevorzugen von bestimmten Abschnitten auf der Karte) beeinflusst werden können.
-- Byteemoz


http://de.wikipedia.org/wiki/A*-Algorithmus

hab ich mich verlesen?

Steht da etwa in Zeile Nr. 1: "dient in der Informatik der Berechnung eines kürzesten Pfades zwischen zwei Knoten "?

war wohl mein Fehler.

BladeRunner

Moderator

BeitragDo, Aug 10, 2006 2:36
Antworten mit Zitat
Benutzer-Profile anzeigen
Drum merke: Wikipedia ist nützlich für Grundinfos, aber bei weitem nicht perfekt.
A* gibt den günstigsten gefundenen Pfad aus, aber es gibt keine Garantie dafür dass dies auch wirklich der günstigste Pfad ist
Dies ist schon dadurch erklärbar das es kein rückwirkendes Löschen nachtraglich als uneffektiv erkannter Nodes gibt.
A* findet immer einen Weg (wie du schon schlauerweise in deinem Wegfindethread festgestellt hast), aber es ist nicht zwangsläufig der Kürzeste.
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
  • Zuletzt bearbeitet von BladeRunner am Do, Aug 10, 2006 17:54, insgesamt einmal bearbeitet
 

Dreamora

 BeitragDo, Aug 10, 2006 7:23
Antworten mit Zitat
Benutzer-Profile anzeigen
Der billigste Weg entspricht dem kürzesten, denn die Wegkosten entsprechen eigentlich der Wegdistanz zwischen den zwei Punkten.
So sind die Verbindungen eines Wegnetzes definiert.

Solange man sich das im Hinterkopf behält wenn man "Berge schwerer begehbar" macht und so gibts keine Probleme Smile

Supi code übrigens
Ihr findet die aktuellen Projekte unter Gayasoft und könnt mich unter @gayasoft auf Twitter erreichen.
  • Zuletzt bearbeitet von Dreamora am Do, Aug 10, 2006 9:52, insgesamt einmal bearbeitet

Justus

 BeitragDo, Aug 10, 2006 9:15
Antworten mit Zitat
Benutzer-Profile anzeigen
Wow, das ist echt brilliant.

StepTiger

 BeitragDo, Aug 10, 2006 12:51
Antworten mit Zitat
Benutzer-Profile anzeigen
Der A* Algorithmus löscht den Weg, bis zum neuen.

Sonst ist es dein Algorithmus der ähnlich dem A* Algo funktioniert. Aber nicht der A* Algorithmus.

der A* Algorithmus sucht, selbst wenn er am Ziel ist, den kürzesten Weg
Noch gestern standen wir am Abgrund, doch heute sind wir schon einen Schritt weiter.
Computer:
AMD Sempron 3000+; ATI Radeon 9800 Pro; 512 MB DDR RAM 400Mhz; Asus E7N8X-E Deluxe; Samsung 200GB HD 5.4ns acces t
Gewinner: BP Code Compo #2
Π=3.141592653589793238...<--- und das aus dem kopf Laughing
Seit der Earthlings-Diskussion überzeugter Fleisch(fr)esser.
 

Dreamora

 BeitragDo, Aug 10, 2006 13:36
Antworten mit Zitat
Benutzer-Profile anzeigen
Wenn er am Ziel ist, ist kein Weg der kürzeste Weg. Jede andere Ausgabe ist einfach nur falsch, denn die erste Abbruchbedingung in jedem Algo ist prinzipiell: "Bin ich am Ziel"
Da du scheinbar noch nicht die Vorlesung Algorithmen & Datenstrukturen an einer wissenschaftlichen Fakultät der Informatikwissenschaften besucht hast, wärs für alle (vor allem den Thread) einfacher, darüber keine Diskussionen mehr zu führen.
Ihr findet die aktuellen Projekte unter Gayasoft und könnt mich unter @gayasoft auf Twitter erreichen.

BladeRunner

Moderator

BeitragDo, Aug 10, 2006 18:07
Antworten mit Zitat
Benutzer-Profile anzeigen
user posted image

Der Weg ist nach A* ermittelt und der günstigste den der Algo findet.
Woher der Knick dann kommt ?
Astar arbeitet sich von Node zu Node vor, und die Bewegung diagonal nach unten war die günstigste, also wurde sie übernommen. Nun stösst der Algo auf ein Hindernis und korrigiert seinen Weg indem er den nun günstigsten Knoten sucht.
Ergo: A* findet seinen Weg, aber es ist nicht zwangsläufig der kürzeste.
Um das Zu Erreichen müsstest Du dann noch ein 2es Mal Astar über den Pfad laufen lassen, wobei Du dann aber die Punkte bei denen Richtungsänderungen stattfanden als Zielpunkte setzen musst. Dann glättet sich der Weg soweit es geht.

Ich werde allerdings in der nächsten Version noch das Bestrafen der Richtungsänderung optional machen, sowie eine Höhendistanzbestrafung einführen. Dauert ein paar Tage da ich grade ein Festival betreue.

Also: stay tuned.
Und herzlichen Dank für das Lob, Leute. Motiviert voll Smile
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

Farbfinsternis

 BeitragDo, Aug 10, 2006 18:17
Antworten mit Zitat
Benutzer-Profile anzeigen
Viel Spaß beim Festival ... und: Ich freue mich auf eine neue Version Very Happy
Farbfinsternis.tv

D2006

Administrator

BeitragDo, Aug 10, 2006 19:26
Antworten mit Zitat
Benutzer-Profile anzeigen
hmm...

Habe mich gestern auch mal selbst an dem Algo probiert, in BB natürlich, hab ja kein BMax.
Jedenfalls will ich nicht behaupten die perfekte Umsetzung zu haben, ist sogar ziemlich lahm, allerdings findet er einen besseren Weg als deiner (vom Screen her, kann ja nicht testen)

Pic:
https://www.blitzforum.de/upload/file.php?id=344

Deswegen behaupte ich nun, dass an deinem Algo was nicht stimmt. Ich schau ihn mir mal ein bisschen an.

EDIT:
Mit Hilfe von DC bin ich auf den "Fehler" gekommen.
Siehe dazu: http://blitzbase.de/artikel/path_4.htm
Wenn du Diagonalschritte teurer machst, müsste es klappen. Allerdings wird - wie beschrieben - der Algo dann langsamer.
(Also in diesem Fall wäre er schneller - meiner um 6 ms, aber in anderen Fällen bis zu 10 mal langsamer)
Intel Core i5 2500 | 16 GB DDR3 RAM dualchannel | ATI Radeon HD6870 (1024 MB RAM) | Windows 7 Home Premium
Intel Core 2 Duo 2.4 GHz | 2 GB DDR3 RAM dualchannel | Nvidia GeForce 9400M (256 MB shared RAM) | Mac OS X Snow Leopard
Intel Pentium Dual-Core 2.4 GHz | 3 GB DDR2 RAM dualchannel | ATI Radeon HD3850 (1024 MB RAM) | Windows 7 Home Premium
Chaos Interactive :: GoBang :: BB-Poker :: ChaosBreaker :: Hexagon :: ChaosRacer 2

BladeRunner

Moderator

BeitragDo, Aug 10, 2006 19:39
Antworten mit Zitat
Benutzer-Profile anzeigen
Hm, die Diagonalen werden schon korrekt berechnet, also mit 2^(1/2).
Werde aber bei Gelegenheit mal 'ne "Sondersteuer" einführen Wink
Näheres demnächst.

EDIT: Jop, Glättet die Kurve einwandfrei. Wird bei der nächsten Verbesserung mit gepastet.
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

StepTiger

 BeitragDo, Aug 10, 2006 21:17
Antworten mit Zitat
Benutzer-Profile anzeigen
probieren jetzt alle den A* Algo aus? ^^
Noch gestern standen wir am Abgrund, doch heute sind wir schon einen Schritt weiter.
Computer:
AMD Sempron 3000+; ATI Radeon 9800 Pro; 512 MB DDR RAM 400Mhz; Asus E7N8X-E Deluxe; Samsung 200GB HD 5.4ns acces t
Gewinner: BP Code Compo #2
Π=3.141592653589793238...<--- und das aus dem kopf Laughing
Seit der Earthlings-Diskussion überzeugter Fleisch(fr)esser.

BladeRunner

Moderator

BeitragDi, Aug 15, 2006 8:01
Antworten mit Zitat
Benutzer-Profile anzeigen
Neue Version 1.11. Siehe erster Post.
Jop, Steptiger, scheint sehr beliebt. Ist ja auch sehr nützlich.
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

Farbfinsternis

 BeitragDi, Aug 15, 2006 8:37
Antworten mit Zitat
Benutzer-Profile anzeigen
Danke, werde ich mir heute mal zu Gemüte führen.
Farbfinsternis.tv

BladeRunner

Moderator

BeitragDo, Okt 01, 2009 18:12
Antworten mit Zitat
Benutzer-Profile anzeigen
Habe mich des Codes nochmal angenommen:

Version 1.12 ist nun oben.

Hier wurde im Wesentlichen alles was noch an Wrapperfunktionen drin war (ListContains etc.) entfernt. Jugendsünden eben Wink
Ist somit komplett OOP, und dank eines Umstellens der Listenführung auf Entfernen per TLink.remove() sollte auch die Ausführungsgeschwindigkeit nochmal ein wenig gestiegen sein.
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

Nova

 BeitragMo, Jan 07, 2013 11:39
Antworten mit Zitat
Benutzer-Profile anzeigen
Ja, ich weiß, dass der Thread alt ist. Ich bin aber der Meinung, dass diese Diskussion noch nicht beendet ist.
Problem dabei: Ich bin auch der Meinung, dass der von BladeRunner auf seinem Bild vorgestellte Algorithmus nicht A* ist. Jede Erklärung, die ich mir im Internet angeguckt habe, sagt über A* aus, dass Sackgassen verworfen und von einem früheren Punkt wieder angefangen wird. Möglicherweise verallgemeinern diese Seiten das ganze aber auch etwas, ich schätze aber mal, dass der Fehler eher hier liegt.
Problem dabei: Auf deinem Bild ist nicht der optimale Weg gezeichnet, da der Weg erst in die Sackgasse und dort wieder raus führt. A* aber würde diese Sackgasse als ineffizient verwerfen und an einem vorherigen Punkt weitermachen. Dadurch würde der Algorithmus merken, dass es erst in eine Sackgasse gelaufen ist und dort wieder raus-"laufen".

Ich weiß leider nicht genau, ob dieses Problem bereits gelöst wurde, wollte es aber erwähnen. Vielleicht habe ich aber auch irgenwas an der Grafik nicht verstanden. Vielleicht stellen die Schattierungen von Grün ja einen speziellen Kostenfaktor oder so dar. Wink
AMD Athlon II 4x3,1GHz, 8GB Ram DDR3, ATI Radeon HD 6870, Win 7 64bit

BladeRunner

Moderator

BeitragMo, Jan 07, 2013 19:42
Antworten mit Zitat
Benutzer-Profile anzeigen
Dein Einwand ist -zumindest teilweise- berechtigt.
Die verschiedenen Grünstufen sind in der Tat verschieden hohe Wegekosten, was allerdings nichts zur Sache tut da diese für dieses Bild nicht berücksichtigt wurden.

Ich stimme dir auch zu dass ein korrekter A* den kostengünstigsten Weg findet, allerdings ist das mit den günstigsten Kosten so eine Sache, denn es gibt manchmal auch mehrere Wege nach Rom, und der kürzeste Pfad ist nicht unbedingt der billigste (was zumindest bei gewichteten Kosten der Fall ist).
Im vorliegenden Fall war das Problem aber nur ein Rundungsfehler der der Floatungenauigkeit geschuldet war. Nachdem ich für Diagonalen den Preis minimal über sqr(2) erhöht hatte passte die Route wieder.
Der hier umgesetzte Algorithmus ist hundertprozentig ein A-Star, das kann ich dir versichern.
(Allerdings würde ich ihn mittlerweile anders umsetzen, da meine Implementierung recht langsam ist (TList ist da nicht so optimal)).
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

Gehe zu Seite 1, 2  Weiter

Neue Antwort erstellen


Übersicht BlitzMax, BlitzMax NG Codearchiv & Module

Nach Oben

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group