Ameisenalgorithmus

remi_meier · Beitrag von **remi_meier** » 04.06.2005 22:02

Stichworte: Rundreise, Travelling-Salesman-Problem, TSP

Die (hoffentlich) fehlerlose Implementierung des Ameisenalgorithmus (siehe auch: https://de.wikipedia.org/wiki/Ameisenalgorithmus)

Code: Alles auswählen

;- Spielt etwas mit diesen Werten:
#BestAdapt = 35.0  ; zw. 0 und 100
#RandAdapt = 80.0  ; zw. 0 und 100


#N = 4  ; Anz. Städte
#A = 100 ; Anz. Ameisen
#D = 200 ; Anz. Durchläufe


Dim Distanzen.l(#N - 1, #N - 1)
Dim Pheromone.f(#N - 1, #N - 1)

Dim Ameisen(#A - 1, #N - 1)


; Distanzen einlesen
Restore distanzen
For y = 0 To #N - 1
	For x = 0 To #N - 1
		Read distanzen(x, y)
	Next
Next




Procedure.l FindWay(Am.l, Von.l, Bis.l)
	Protected z.l, Found.l, k.l, BestPh.f, BestStd.l
	
	
	Repeat	
		BestPh = -1.0
		BestStd = -1			
		
		; Zu allen Städten schauen (ohne 0 (Startpunkt))
		For z = 1 To #N - 1			
						
			Found = #False			
			; Wurde Stadt schon besucht?			
			For k = 1 To Bis
				If Ameisen(Am, k) = z								
					Found = #True		
					Break
				EndIf																		
			Next
			
			
			If Found
				Continue
			EndIf							
			
						
			v.f = Random(100)								
			If (Pheromone(Von, z) > BestPh And v > #BestAdapt) Or v > #RandAdapt
				BestPh = Pheromone(Von, z)
				BestStd = z
			EndIf						
		Next
	Until BestStd	<> -1	
	
	ProcedureReturn BestStd
EndProcedure


For n = 1 To #D

	; Für jede Stadt
	For z = 0 To #N - 2
		For t = 0 To #A - 1	
			NStadt.l = FindWay(t, Ameisen(t, z), z)
			Ameisen(t, z + 1) = NStadt	
		Next
	Next	
	
	; Pheromone Updaten
	For t = 0 To #A - 1
		Dist.l = 0	
		; Distanz errechnen	
		For z = 0 To #N - 2
			Dist + Distanzen(Ameisen(t, z), Ameisen(t, z + 1))
		Next
				
		; Pheromone setzen		
		For z = 0 To #N - 2
			Pheromone(Ameisen(t, z), Ameisen(t, z + 1)) + 1.0 / Dist
			Pheromone(Ameisen(t, z + 1), Ameisen(t, z)) + 1.0 / Dist			
		Next	
	Next		
	
Next


Best.l = 9999999
BestAm = 0
For t = 0 To #A - 1
	Dist.l = 0	
	; Distanz errechnen	
	For z = 0 To #N - 2
		Dist + Distanzen(Ameisen(t, z), Ameisen(t, z + 1))
	Next
	Dist + Distanzen(Ameisen(t, #N - 1), 0)	
	
	If Dist < Best
		Best = Dist
		BestAm = t
	EndIf							
Next		



For z = 0 To #N - 1
	Debug Ameisen(BestAm, z)
Next
Debug 0
Debug "########"
Debug Best

CallDebugger


DataSection
distanzen:
Data.l 0, 2, 3, 5
Data.l 2, 0, 4, 1
Data.l 3, 4, 0, 8
Data.l 5, 1, 8, 0
EndDataSection

Was macht er?
Er findet, nach dem Prinzip der Ameisen, eine relativ kurze Rundreise zw.
den (hier 4) Städten.

greetz
Remi

PS: Benutzt diesen Code nicht für den Contest in der PureLounge, das würde
ich merken

// Edit: Nicht mehr funktionierende Link-Adresse angepasst (Kiffi)

remi_meier · Beitrag von **remi_meier** » 05.06.2005 13:10

Achtung
Das Ding da oben ist wahrscheinlich nicht allzu gut eingestellt und verwendet
ev. nicht eine geeignete FindWay()-Prozedure. Bei mehr Städten fand
dieser Algorithmus bei mir irgendwie nicht mehr den Weg

Vielleicht
hat ja jemand eine Idee!

Dafür hab ich jetzt noch einen sehr rudimentären Algorithmus, ist glaub
so was wie Lin2Opt (bin mir nicht mehr ganz sicher).
Das Ding funktioniert sicher!

Code: Alles auswählen

; Lin2Opt

#D = 59999 ; Anz. Durchläufe

Global AnzPunkte.l, BestDistanz.l


Structure STADT
	x.l
	y.l
EndStructure



;- Einlesen und aufbereiten der Daten
Procedure LesePunkte()
	Protected s.s
	
	NewList Staedte.STADT()	
	
	If ReadFile(0, "Städte.txt")
		While Eof(0) = 0
			s = ReadString()
			If StringField(s, 1, "=") = "Punkte"
				AnzPunkte = Val(StringField(s, 2, "="))
			Else
				If Left(s, 1) = "X"
					AddElement(Staedte())
					Staedte()\x = Val(StringField(s, 2, "="))
				ElseIf Left(s, 1) = "Y"
					Staedte()\y = Val(StringField(s, 2, "="))
				EndIf															
			EndIf												
		Wend		
				
		CloseFile(0)			
	Else
		MessageRequester("Fehler", "Datei Städte.txt nicht gefunden!")		
	EndIf			
									
EndProcedure

Procedure BerechneDistanzen()
	Protected z.l, *p.STADT, *s.STADT, x.l, y.l, dx.l, dy.l
	; Abstände	
	Dim Distanzen.l(AnzPunkte - 1, AnzPunkte - 1)
	
	ForEach Staedte()
		*p = @Staedte()
		y = ListIndex(Staedte())	
					
		ForEach Staedte()
			*s = @Staedte()		
			If *s <> *p
				x = ListIndex(Staedte())
				
				dx = *p\x - *s\x				
				dy = *p\y - *s\y				
				Distanzen(x, y) = Sqr(dx * dx + dy * dy)
								
			EndIf						
		Next
				
		ChangeCurrentElement(Staedte(), *p)									
	Next		
				
EndProcedure

;- Graphische Ausgabe
CreateImage(0, 800, 600)
OpenWindow(0, 10, 10, 800, 600, #PB_Window_Systemmenu, "Ameisenkolonie")
CreateGadgetList(WindowID())
ImageGadget(1, 0, 0, 800, 600, UseImage(0))

 

;- Hauptprogramm
LesePunkte()
BerechneDistanzen()

Dim BestWeg(AnzPunkte - 1)
Dim Weg(AnzPunkte - 1)
For z = 0 To AnzPunkte - 1
	Weg(z) = z
Next
BestDistanz = 1 << 31 - 1

;- Algorithmus
Procedure.l Lin2Opt(Rahmen.f)
	Protected Dist.l, a.l, b.l, z.l, d.l, Dist2.l
	
	; Dist Ausrechnen
; 	Dist = 0	
; 	For z = 0 To AnzPunkte - 2
; 		Dist + Distanzen(Weg(z), Weg(z + 1))
; 	Next		
; 	Dist + Distanzen(Weg(AnzPunkte - 1), Weg(0))	
	
	; Vertauschungspartner	
	a.l = Random(AnzPunkte - 1)
	b.l = Random(AnzPunkte - 1)		
	
	; Vertausche
	d = Weg(a)
	Weg(a) = Weg(b)
	Weg(b) = d
	
	; Schauen, ob im Rahmen			
	Dist2 = 0		
	For z = 0 To AnzPunkte - 2
		Dist2 + Distanzen(Weg(z), Weg(z + 1))
	Next		
	Dist2 + Distanzen(Weg(AnzPunkte - 1), Weg(0))
	
		
	If Dist2 - BestDistanz > Rahmen
		; Rückgängig
 		d = Weg(a)
		Weg(a) = Weg(b)
		Weg(b) = d
	EndIf		
			
EndProcedure


For n = 1 To #D
	
	Lin2Opt(20.0 * #D / n)	

	; BestWeg()
	Dist = 0
	For z = 0 To AnzPunkte - 2
		Dist + Distanzen(Weg(z), Weg(z + 1))
	Next		
	Dist + Distanzen(Weg(AnzPunkte - 1), Weg(0))
	
	If Dist < BestDistanz
		BestDistanz = Dist
		CopyMemory(@Weg(), @BestWeg(), AnzPunkte * 4)
	EndIf					
	
				
	;- Draw
	StartDrawing(ImageOutput())
		DrawingMode(1)	
		FrontColor(255, 255, 255)
		
								
		Box(0,0, 800,600, 0)	
		For z = 0 To AnzPunkte - 1
			SelectElement(Staedte(), BestWeg(z))
			LineXY(x1, y1, Staedte()\x, Staedte()\y, RGB(255, z * 1.0 / AnzPunkte * 255.0, 0))
			x1 = Staedte()\x
			y1 = Staedte()\y
			
			Circle(Staedte()\x, Staedte()\y, 5, $FF00)
			Locate(Staedte()\x, Staedte()\y)
			DrawText(Str(ListIndex(Staedte()) + 1))									
		Next
		FirstElement(Staedte())	
		LineXY(x1, y1, Staedte()\x, Staedte()\y, RGB(255, z * 1.0 / AnzPunkte * 255.0, 0))
		
		Locate(10, 10)
		DrawText("Routenlänge: " + Str(BestDistanz) + "   Rahmen: " + Str(20.0 * #D / n))		
	StopDrawing()	
			
	SetGadgetState(1, UseImage(0))
	Event = WindowEvent()
	While Event 
		If Event = #PB_Event_CloseWindow
			Break 2
		EndIf
		Event = WindowEvent() 		
	Wend
	
Next
		



; Die 1 suchen:
For z = 0 To AnzPunkte - 1
	If BestWeg(z) = 0
		Pos = z
		Break
	EndIf
Next

										
CreateFile(0, "Route.txt")
For z = Pos To AnzPunkte - 1
	WriteStringN(Str(BestWeg(z) + 1))
Next
For z = 0 To Pos
	WriteStringN(Str(BestWeg(z) + 1))
Next
CloseFile(0)


MessageRequester("Fertig", "Fertig")
Repeat
	Event = WaitWindowEvent()	
Until Event = #PB_Event_CloseWindow

Es wird eine Textdatei verlangt, die wie folgt aussieht:

Code: Alles auswählen

Punkte=10
X1=574
Y1=28
X2=269
Y2=322
X3=452
Y3=276
X4=181
Y4=468
X5=621
Y5=368
X6=433
Y6=480
X7=224
Y7=507
X8=121
Y8=465
X9=593
Y9=480
X10=253
Y10=76

greetz
Remi

Updated: Ein paar Schönheitsfehler

Dostej · Beitrag von **Dostej** » 09.06.2005 16:34

Sieht gut aus. Den Code könnte ich ganz gut für mein Spiel gebracuhen. Dürfte ich den verwenden? (gegen Credits?)

Beitrag von **NicTheQuick** » 09.06.2005 16:54

Kann man den Code auch "verbildlichen"? Also wie sieht das bildlich aus, was der Algorithmus da anstellt? Ich kann mir da jetzt grad nicht viel drunter vorstellen.

Ist das einfach nur eine Weg-finde-KI?

remi_meier · Beitrag von **remi_meier** » 09.06.2005 17:16

@Dostej: Jep, darfst du verwenden

(aber wie gesagt, der Ameisenalgo
funktioniert irgendwie noch nicht immer... der untere schon, wobei ich da
schon eine schnellere Version habe, werds bald mal updaten)

@Nic: Für den Ameisenalgo hab ich oben einen Link angegeben, da wird
das sehr schön erklärt. Für Lin2Opt, hats ja eine grafische Ausgabe, wobei
da nichts Spezielles dabei ist, ist alles ziemlich zufällig.
KI ist sowieso ein relativer Begriff, ich würde mal behaupten, das der
Ameisenalgorithmus noch am ehesten als KI bezeichnet werden kann. Der
andere ist rein zufällig.
Ja, diese Algos finden Wege, aber nicht den kürzesten zwischen 2 Punkten,
sondern eine relativ gute Lösung um ALLE Punkte zu besuchen und wieder
zurück zum Start, also eine Rundreise. Keiner dieser beiden Algos findet
sicher den optimalen Weg.

greetz
Remi

Jac de Lad · Beitrag von **Jac de Lad** » 10.07.2020 23:36

Der Link im ersten Beitrag sollte vielleicht gelöscht oder aktualisiert werden. Ich glaube nicht, dass das der ursprüngliche Inhalt ist.

ts-soft · Beitrag von **ts-soft** » 10.07.2020 23:58

jacdelad hat geschrieben:Der Link im ersten Beitrag sollte vielleicht gelöscht oder aktualisiert werden

Ich denke mal, keiner macht sich hier grosse Gedanken, wenn ein 15 Jahre alter Link nicht mehr funktioniert

Der Source funktioniert ja auch nicht mehr

Kleiner Grabschänder

Jac de Lad · Beitrag von **Jac de Lad** » 11.07.2020 11:25

Ich bin darüber gestolpert und meine Neugier würde geweckt. Da könnte man doch gleich alle Threads, die älter als 10 Jahre sind, löschen. Das wäre aber kein guter Ansatz.

Warum funktioniert der Quelltext nicht mehr? Wegen der Weiterentwicklung von PureBasic?

mk-soft · Beitrag von **mk-soft** » 11.07.2020 12:00

Ich habe noch Profan V6.x
Da kann ich Anwendungen für Windows 3.11 schreiben.

Manchmal kann man auch aus alten Code was machen. Also nichts löschen!

Jac de Lad · Beitrag von **Jac de Lad** » 11.07.2020 12:03

Ich hab alle Versionen von PureBasic aufgehoben und von Profan hab ich fast alle Versionen seit 2.6.

PureBoard

Ameisenalgorithmus

Ameisenalgorithmus

Re: Ameisenalgorithmus

Re: Ameisenalgorithmus

Re: Ameisenalgorithmus

Re: Ameisenalgorithmus

Re: Ameisenalgorithmus