;Der kürzeste Weg zwischen einer beliebigen Anzahl an Punkten
;¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯

Declare StartAlgorythmus()
Declare ZeigePlatz(Platz.l)

;Dimensioniert die benötigten Arrays auf Null.
Procedure ClearArrays()
  Dim PunkteAbstand.f(0, 0)
  Dim Summe.f(0)
  Dim BenutztePunkte.l(0, 0)
  Structure PunkteSt
    XPos.f
    YPos.f
  EndStructure
  Dim Punkte.PunkteSt(0)
EndProcedure

ClearArrays()

;-- Globals
Width.l = 640
Height.l = 480

;-- Fenster-Aufbau
If OpenWindow(0, 0, 0, Width + 162, Height + 24, #PB_Window_SystemMenu | #PB_Window_ScreenCentered, "Sortierungsalgorhythmus") = #False
  End
EndIf

;-- Koordinateneingabe
; Lese die Anzahl der Punkte und die Koordinaten jeden Punktes in ein Array mit einer Struktur ein

PunktAnzahl.l = 1000
Dim Punkte.PunkteSt(PunktAnzahl - 1)

RandomSeed(0)
For a.l = 0 To PunktAnzahl - 1
  Punkte(a)\XPos = Random(1000 * (Width - 1)) / 1000
  Punkte(a)\YPos = Random(1000 * (Height - 1)) / 1000
Next

;-- Image-Erstellung
; Erstelle ein Image, in dem alle Punkte als schwarze Pixel angegeben sind
CreateImage(1, Width, Height)
StartDrawing(ImageOutput())
  For a.l = 0 To PunktAnzahl - 1
    Plot(Punkte(a)\XPos, Punkte(a)\YPos, RGB(255, 255, 255))
  Next
StopDrawing()

;-- Gadget-Einrichtung
WaitWindowEvent()
If CreateGadgetList(WindowID()) = #False
  End
EndIf
ImageGadget(0, 0, 0, Width, Height, ImageID())
ProgressBarGadget(1, 0, Height + 1, Width, 22, 0, PunktAnzahl - 1, #PB_ProgressBar_Smooth)
ListIconGadget(2, Width + 1, 0, 160, Height, "N°", 30, #PB_ListIcon_FullRowSelect | #PB_ListIcon_AlwaysShowSelection)
AddGadgetColumn(2, 1, "Entfernung", 120)
ButtonGadget(3, Width + 1, Height + 1, 160, 22, "Editor", #PB_Button_Toggle)

StartAlgorythmus()

;-- Ausgabe
; Gib die errechneten Ergebnisse aus
For a.l = 0 To PunktAnzahl - 1
  AddGadgetItem(2, a, Str(a + 1))
  SetGadgetItemText(2, a, StrF(Summe(a)), 1)
Next

Procedure ZeigePlatz(Platz.l)
  Shared Width, Height, PunktAnzahl
  
  StartDrawing(ImageOutput())
    Box(0, 0, Width, Height, 0)
    For a.l = PunktAnzahl - 2 To 0 Step -1
      
      Color.l = RGB(128 + (a * 127 / PunktAnzahl), 127 - (a * 127 / PunktAnzahl), 0)      
      c1.l = BenutztePunkte(Platz, a)
      c2.l = BenutztePunkte(Platz, a + 1)
      LineXY(Punkte(c1)\XPos, Punkte(c1)\YPos, Punkte(c2)\XPos, Punkte(c2)\YPos, Color)
      If a = 0
        Circle(Punkte(c1)\XPos, Punkte(c1)\YPos, 3, RGB(255, 255, 255))
      Else
        Plot(Punkte(c1)\XPos, Punkte(c1)\YPos, RGB(255, 255, 255))
      EndIf
    Next
  StopDrawing()
  
  SetGadgetState(0, ImageID())
EndProcedure

Platz.l = 0
SetGadgetState(2, 0)
ZeigePlatz(Platz)

Repeat
  EventID.l = WaitWindowEvent()
  Select EventID
    Case #PB_EventGadget
      Select EventGadgetID()
        Case 2
          a.l = GetGadgetState(2)
          If a <> Platz
            ZeigePlatz(a)
            Platz = a
          EndIf
        Case 3 ;Editor
          MessageRequester("Editor", "Der Punkte-Editor funktioniert leider noch nicht.", 0)
          SetGadgetState(3, 0)
      EndSelect
  EndSelect
Until EventID = #PB_EventCloseWindow

Procedure StartAlgorythmus()
  Shared PunktAnzahl
  ;-- PunktAbstand
  ; Lege ein Array an, in dem die Abstände von jedem Punkt zu jedem anderen Punkt gespeichert sind
  ; Speichere die maximalste Entferung eines Punktes zu einem anderem in MaxEntf.f

  Dim PunktAbstand.f(PunktAnzahl - 1, PunktAnzahl - 1)
  MaxEntf.f
  For a.l = 0 To PunktAnzahl - 1
    For b.l = 0 To PunktAnzahl - 1
      EntfX.f = Abs(Punkte(a)\XPos - Punkte(b)\XPos)
      EntfY.f = Abs(Punkte(a)\YPos - Punkte(b)\YPos)
      PunktAbstand(a, b) = Sqr(Pow(EntfX, 2) + Pow(EntfY, 2))
      If PunktAbstand(a, b) > MaxEntf : MaxEntf = PunktAbstand(a, b) : EndIf
    Next
  Next

  ;-- Kuerzester-Weg-Berechnung
  ; Fange an Index 0 im Array an und gehe immer zum nächstliegendem Punkt weiter und speichere die Summe aller Abstände
  Dim Summe.f(PunktAnzahl - 1)

  ;                    Erster Punkt     Reihenfolge
  Dim BenutztePunkte.l(PunktAnzahl - 1, PunktAnzahl - 1)

  For a.l = 0 To PunktAnzahl - 1             ;Beginne von jedem Punkt aus einmal
    Summe(a) = 0
    BenutztePunkte(a, 0) = a
    Index.l = 0
    
    Repeat
      While WindowEvent() : Wend
      Index + 1
      BenutztePunkte(a, Index) = -1
      MinEntf.f = MaxEntf
      NaechsterPunktI = -1
      
      For b.l = 0 To PunktAnzahl - 1         ;Gehe jeden Punkt, zu dem der Abstand berechnet werden soll, einmal durch
        
        OK.l = 1
        For c.l = 0 To Index - 1             ;Überprüfe, ob der Punkt, schon einmal benutzt wurde
          If BenutztePunkte(a, c) = b : OK = 0 : c = Index - 1 : EndIf
        Next
        
        If OK                                ;Vergleiche seine Entfernung zum vorherigen Punkt mit der bisherigen Minimal-Entfernung
          Entf.f = PunktAbstand(BenutztePunkte(a, Index - 1), b)
          If Entf <= MinEntf : MinEntf = Entf : NaechsterPunktI = b : EndIf
        EndIf
      Next
      
      BenutztePunkte(a, Index) = NaechsterPunktI
      Summe(a) + MinEntf
    Until Index = PunktAnzahl - 1
    SetGadgetState(1, a)
  Next

  ;-- Summensortierung
  ; Sortiere die einzelnen Summen von Entfernungen mit einem einfachen Bubble-Sort-Algorhythmus

  For a.l = 0 To PunktAnzahl - 2
    For b.l = a + 1 To PunktAnzahl - 1
      If Summe(a) > Summe(b)
        Entf.f = Summe(a)
        Summe(a) = Summe(b)
        Summe(b) = Entf
        For c = 0 To PunktAnzahl - 1
          Index.l = BenutztePunkte(a, c)
          BenutztePunkte(a, c) = BenutztePunkte(b, c)
          BenutztePunkte(b, c) = Index
        Next
      EndIf
    Next
  Next
EndProcedure 
; jaPBe Version=1.3.10.10
; Build=0
; FirstLine=135
; CursorPosition=151
; ExecutableFormat=Windows
; Executable=C:\Programme\PureBasic\Programme\Befreundete Zahlen.exe
; DisableDebugger
; EOF