PureBoard

;- 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

; 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

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