Aktuelle Zeit: 18.01.2021 18:38

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 13 Beiträge ]  Gehe zu Seite 1, 2  Nächste
Autor Nachricht
 Betreff des Beitrags: Ameisenalgorithmus
BeitragVerfasst: 04.06.2005 22:02 
Offline
Benutzeravatar

Registriert: 29.08.2004 20:11
Wohnort: Schweiz
Stichworte: Rundreise, Travelling-Salesman-Problem, TSP

Die (hoffentlich) fehlerlose Implementierung des Ameisenalgorithmus (siehe auch: https://de.wikipedia.org/wiki/Ameisenalgorithmus)
Code:
;- 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 :wink:

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


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags:
BeitragVerfasst: 05.06.2005 13:10 
Offline
Benutzeravatar

Registriert: 29.08.2004 20:11
Wohnort: Schweiz
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:
; 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:
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


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags:
BeitragVerfasst: 09.06.2005 16:34 
Offline
Benutzeravatar

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


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags:
BeitragVerfasst: 09.06.2005 16:54 
Offline
Ein Admin
Benutzeravatar

Registriert: 29.08.2004 20:20
Wohnort: Saarbrücken
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?

_________________
Ubuntu Gnome 20.04 LTS x64, PureBasic 5.72 x64 (außerdem 4.41, 4.50, 4.61, 5.00, 5.10, 5.11, 5.21, 5.22, 5.30, 5.31, 5.40, 5.50, 5.60, 5.71b2)
"Die deutsche Rechtschreibung ist Freeware, du darfst sie kostenlos nutzen – Aber sie ist nicht Open Source, d. h. du darfst sie nicht verändern oder in veränderter Form veröffentlichen."


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags:
BeitragVerfasst: 09.06.2005 17:16 
Offline
Benutzeravatar

Registriert: 29.08.2004 20:11
Wohnort: Schweiz
@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


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Ameisenalgorithmus
BeitragVerfasst: 10.07.2020 23:36 
Offline
Benutzeravatar

Registriert: 24.07.2019 17:53
Wohnort: Riesa
Der Link im ersten Beitrag sollte vielleicht gelöscht oder aktualisiert werden. Ich glaube nicht, dass das der ursprüngliche Inhalt ist. :lol:


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Ameisenalgorithmus
BeitragVerfasst: 10.07.2020 23:58 
Offline
Benutzeravatar

Registriert: 08.09.2004 00:57
Wohnort: Berlin
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 :mrgreen:
Der Source funktioniert ja auch nicht mehr <)

Kleiner Grabschänder :lol:

_________________
PureBasic 5.71 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 19.3 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Ameisenalgorithmus
BeitragVerfasst: 11.07.2020 11:25 
Offline
Benutzeravatar

Registriert: 24.07.2019 17:53
Wohnort: Riesa
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?


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Ameisenalgorithmus
BeitragVerfasst: 11.07.2020 12:00 
Offline
Benutzeravatar

Registriert: 24.11.2004 13:12
Wohnort: Germany
Ich habe noch Profan V6.x
Da kann ich Anwendungen für Windows 3.11 schreiben. :roll:

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

_________________
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul / OPC-Helper DLL
PB v3.30 / v5.7x - OS Mac Mini OSX 10.xx / Window 10 Pro. (X64) /Window 7 Pro. (X64) / Window XP Pro. (X86) / Ubuntu 14.04
Downloads auf My Webspace


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Ameisenalgorithmus
BeitragVerfasst: 11.07.2020 12:03 
Offline
Benutzeravatar

Registriert: 24.07.2019 17:53
Wohnort: Riesa
Ich hab alle Versionen von PureBasic aufgehoben und von Profan hab ich fast alle Versionen seit 2.6. :mrgreen:


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 13 Beiträge ]  Gehe zu Seite 1, 2  Nächste

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 11 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye