Jump to content

Simulated Annealing - When brute-force takes too long


RTFC
 Share

Recommended Posts

  • Moderators

RTFC,

Wow, I expected something complex but this is going to take a fair while to understand. I am now reading this to try and get some idea of what is going on in there.

M23

Public_Domain.png.2d871819fcb9957cf44f4514551a2935.png Any of my own code posted anywhere on the forum is available for use by others without any restriction of any kind

Open spoiler to see my UDFs:

Spoiler

ArrayMultiColSort ---- Sort arrays on multiple columns
ChooseFileFolder ---- Single and multiple selections from specified path treeview listing
Date_Time_Convert -- Easily convert date/time formats, including the language used
ExtMsgBox --------- A highly customisable replacement for MsgBox
GUIExtender -------- Extend and retract multiple sections within a GUI
GUIFrame ---------- Subdivide GUIs into many adjustable frames
GUIListViewEx ------- Insert, delete, move, drag, sort, edit and colour ListView items
GUITreeViewEx ------ Check/clear parent and child checkboxes in a TreeView
Marquee ----------- Scrolling tickertape GUIs
NoFocusLines ------- Remove the dotted focus lines from buttons, sliders, radios and checkboxes
Notify ------------- Small notifications on the edge of the display
Scrollbars ----------Automatically sized scrollbars with a single command
StringSize ---------- Automatically size controls to fit text
Toast -------------- Small GUIs which pop out of the notification area

 

Link to comment
Share on other sites

@JohnOne: Yeah, best not play too much with it, or you might go blind.;)

@M23: It really works mostly like I describe in the analogy. Rolling the dice = _AskOracle(), using an exponential distribution. We always accept a lower cost, but if it's higher, then we only accept the jump if we sample below our annealing temperature (well technically, cost scaled by temperature), and the temperature itself is gradually lowered. And the name annealing is apt, as the metal is cooled slowly to give the atoms the opportunity to settle into the crystal lattice.

Edited by RTFC
Link to comment
Share on other sites

  • 1 month later...

Added a 3rd example in the first post, a Sudoku Generator & Solver.

Paraphrasing the script remarks section:

This example illustrates how some types of problem can cause Simulated Annealing to get stuck in a local optimum other than the global one. To get around this, we can apply a thorough reshuffle of all non-fixed parameters, and try again. The harder the problem is, the larger the average number of required reshuffles to find the full solution (see listed examples in script).

Sudoku puzzles with very few given clues (or none) are easy to solve, because many paths exist that lead to full solutions (non-unique for number of clues < 17). Sudoku's with many clues are also easy to solve, because there are only relatively few paths left, many of which yield the full solution.

Sudoku's with (or close to) the minimum number of clues that identify a unique solution are the hardest, because many paths do exist, but most lead to a sub-optimal, incomplete solution.:think: The location of the clues also becomes increasingly important the closer we get to this minimum. Reshuffling allows us to explore this landscape from different starting points.

The new example script (#3) displays a temporary result (with timing) each time it gets stuck; when the true solution is found, it plays a sound before exiting. Note that this may take a long time.:yawn:

NB This is obviously not the fastest way to solve a Sudoku; the point of this example is to show that SimAnn can (eventually) find it, without knowing how to solve it, just by getting feedback on its current attempts, and despite the solution space itself being rather large. Furthermore, this example does not imply that all intractable problems can be solved by repeated reshuffle + retry. For example, it would be useless to attempt to quickly generate bitcoins this way.

 

EDIT: after fixing a bug in updating $totalcost, it turns out sudoku isn't a particularly good example of simulated annealing after all (it just takes too long). Until I find a better way to implement it in this context I've removed this example.

Edited by RTFC
Link to comment
Share on other sites

  • 7 years later...

Hey, thanks for providing examples :) I would really like to understand, how TSP works (in AutoIt). 

 

I wanted to try to adapt it to a script of mine, but I find it difficult to follow the example and replace individual parts. Since the cities are global and everything is too connected and the variable names are also a bit hard to read for me. (I am not a very experienced hobby developer^^)

I created a script with a more complicated coordinate system using ChatGPT and a lot of time and implemented a "nearest neighbor" algo. To make it a bit better with my limited knowledge, I tried to use it at least twice, hoping that the script wouldn't do something really stupid at least at the first step.

My hope was somewhat that the "understanding" of the coordinate system is mainly in the calculation of the distance and then I can simply adjust the input (the cities) and replace the function for calculating the distance and then I would be able to progress step by step somehow. But that doesn't work with the structure of the example and since my understanding is running close to the limit, I can't really make any progress or even get started. 

Could someone perhaps help me? I think my example code and the visualization could be used to make the TSP example more comprehensible (using visible coordinates and with this kind of visualisation)... I would be really grateful ^^!

 

My code:

#include <Array.au3>
#include <GUIConstantsEx.au3>
#include <WindowsConstants.au3>
#include <GDIPlus.au3>
#include <EditConstants.au3>

Global $iMapWidth = 60, $iMapHeight = 60, $iMapRoot = 3

; Beispielkoordinaten
Local $aInputArray = ["2:50:9", "2:50:2", "2:50:4", "1:50:3", "1:50:8", "1:49:8", "3:49:4", "3:51:3", "3:51:8", "2:51:7", "1:51:4", "2:48:8", "2:48:4", "1:48:3", "1:48:2", "1:48:1", "3:48:4", "4:49:4", "3:50:6", "4:50:4", "4:50:5", "5:51:1"]
Local $sStartCoordinate = "3:51:1"
Local $sHomeCoordinate = "2:50:8"


;~ Local $aBestRoute = getBestRoute($sStartCoordinate, $aInputArray, 5)
Local $aBestRoute = getBestRoute($sStartCoordinate, $aInputArray, 5, $sHomeCoordinate)

DrawMap($aInputArray, $sStartCoordinate, $aBestRoute, $aBestRoute[UBound($aBestRoute) - 1])

Func getBestRoute($sStartCoordinate, $aTargets, $iNumberOfTargets, $sHomeCoordinate = False)
    Local $aBestRoutes[10], $aBestRoute[0]
    Local $sEndCoordinate = $sHomeCoordinate ? $sHomeCoordinate : $sStartCoordinate
    Local $aPossibleFirstTargets = getNearestTargets($sStartCoordinate, $aTargets)
    Local $aTargetsWithoutStartC = $aTargets
    Local $iIdStartCoordInTargets = _ArraySearch($aTargets, $sStartCoordinate) ; Falls ein Ziel auch der Startpunkt ist

    If $iIdStartCoordInTargets >= 0 Then _ArrayDelete($aTargetsWithoutStartC, $iIdStartCoordInTargets) ; Wenn Ziel auch Startpunkt, darf das nicht für die Suche des weiteren Weges genutzt werden

    ; Finde mit den neuen Startkoordinaten die besten Wege
    For $i = 0 To UBound($aPossibleFirstTargets) - 1
        $aBestRoutes[$i] = getShortRoute($aPossibleFirstTargets[$i], $aTargetsWithoutStartC, $iNumberOfTargets - 1, $sEndCoordinate)
    Next

    ; Lösche leere Einträge, falls es weniger als 10 Ziele gab
    For $i = UBound($aBestRoutes) - 1 To 0 Step -1
        If $aBestRoutes[$i] = "" Then
            _ArrayDelete($aBestRoutes, $i)
        EndIf
    Next

    ; Finde die beste Route
    Local $iShortestDistance = -1
    For $i = 0 To UBound($aBestRoutes) - 1
        Local $aTemp = $aBestRoutes[$i]
        $aTemp[1] += getDistance($sStartCoordinate, $aTemp[2])
        Local $iTotalDistance = $aTemp[1]

        ; Vergleiche die Gesamtentfernung mit der bisher kürzesten Route
        If $iShortestDistance = -1 Or $iTotalDistance < $iShortestDistance Then
            $iShortestDistance = $iTotalDistance
            $aBestRoute = $aTemp ; Aktuelle Route als beste Route speichern
        EndIf
    Next

    _ArrayInsert($aBestRoute, 2, $sStartCoordinate)

    Return $aBestRoute ; Die kürzeste Route wird zurückgegeben
EndFunc

; Finde die bis zu 10 nächsten Koordinaten, die alle potenziell gute Start-Koordinaten für die weitere Suche wären
Func getNearestTargets($sStartCoordinate, $aTargets)
    Local $aNearestTargets[0]
    Local $iMaxTargets = UBound($aTargets) > 10 ? 10 : UBound($aTargets)

    For $i = 1 To $iMaxTargets
        Local $iShortestDistance = -1
        Local $sNearestTarget = ""

        For $j = 0 To UBound($aTargets) - 1
            Local $iDistance = getDistance($sStartCoordinate, $aTargets[$j])

            If $iShortestDistance = -1 Or $iDistance < $iShortestDistance Then
                $iShortestDistance = $iDistance
                $sNearestTarget = $aTargets[$j]
            EndIf
        Next

        If $sNearestTarget <> "" Then
            _ArrayAdd($aNearestTargets, $sNearestTarget)
            _ArrayDelete($aTargets, _ArraySearch($aTargets, $sNearestTarget))
        EndIf
    Next

    Return $aNearestTargets
EndFunc

Func getShortRoute($sStartCoordinate, $aInputArray, $iNumberOfTargets, $sEndCoordinate)
    Local $aVisited[0] ; Leeres Array für besuchte Ziele
    Local $iTotalDistance = 0
    Local $sCurrentCoordinate = $sStartCoordinate
    Local $iVisitedTargets = 0

    _ArrayAdd($aVisited, $sStartCoordinate) ; Ist visited, weil das hier ja mit NearestTargets arbeitet, also schon das erste Ziel nach der echten Startkoordinate ist

    Local $iIdOfStartCoordinateInInput = _ArraySearch($aInputArray, $sStartCoordinate)
    If $iIdOfStartCoordinateInInput >= 0 Then _ArrayDelete($aInputArray, $iIdOfStartCoordinateInInput) ; Startkoordinate aus Array für mögliche Ziele entfernen, weil hier dann schon abgelaufen als wirklich erstes Ziel!

    For $i = 1 To $iNumberOfTargets
        Local $iShortestDistance = -1
        Local $sNextCoordinate = ""
        Local $iNextIndex = -1

        For $j = 0 To UBound($aInputArray) - 1
            If Not _ArraySearch($aVisited, $aInputArray[$j]) >= 0 Then
                Local $iDistance = getDistance($sCurrentCoordinate, $aInputArray[$j])

                If $iShortestDistance == -1 Or $iDistance < $iShortestDistance Then
                    $iShortestDistance = $iDistance
                    $sNextCoordinate = $aInputArray[$j]
                    $iNextIndex = $j
                EndIf
            EndIf
        Next

        If $iNextIndex <> -1 Then
            $iTotalDistance += $iShortestDistance
            $sCurrentCoordinate = $sNextCoordinate

            _ArrayAdd($aVisited, $sNextCoordinate)
            _ArrayDelete($aInputArray, $iNextIndex)
            $iVisitedTargets += 1
        Else
            ; Kein weiteres Ziel gefunden, brechen Sie die Schleife ab
            ExitLoop
        EndIf
    Next

    $iTotalDistance += getDistance($aVisited[UBound($aVisited) -1], $sEndCoordinate)

    ; Erstellen Sie das Ergebnisarray
    Local $aResult[2] = [$iVisitedTargets + 1, $iTotalDistance] ; +1, da die Startkoordiante nicht als besuchtes Ziel gilt
    For $i = 0 To $iVisitedTargets
        _ArrayAdd($aResult, $aVisited[$i])
    Next

    _ArrayAdd($aResult, $sEndCoordinate)

    Return $aResult
EndFunc

Func DrawMap($aInputArray, $sStartCoordinate, $aBestRoute, $sEndCoordinate)
    Local $iGridSize = 20
    Local $iGuiWidth = 900
    Local $iGuiHeight = 900
    Local $iLineSpacing = $iGuiWidth / $iGridSize ; Berechnen des Abstands zwischen den Linien

    ; GDI+ initialisieren
    _GDIPlus_Startup()

    ; GUI erstellen
    Local $hGUI = GUICreate("Map Visualization", $iGuiWidth, $iGuiHeight)
    GUISetState(@SW_SHOW)

    ; Grafikobjekt erstellen
    Local $hGraphic = _GDIPlus_GraphicsCreateFromHWND($hGUI)
    Local $hBrushOrange = _GDIPlus_BrushCreateSolid(0xFFFFA500) ; Orange
    Local $hBrushRed = _GDIPlus_BrushCreateSolid(0xFFFF0000) ; Rot
    Local $hBrushBlack = _GDIPlus_BrushCreateSolid(0xFF000000) ; Schwarz
    Local $hBrushGrey = _GDIPlus_BrushCreateSolid(0xFF008000) ; Grau
    Local $hPen = _GDIPlus_PenCreate(0xFF000000, 1) ; Schwarzer Stift mit einer Breite von 1 für das Gitter

    ; Arrays mit 2D-Koordinaten erstellen
    Local $aInputArray2D[0]
    Local $aBestRoute2D[0]

    For $i = 0 To UBound($aInputArray) - 1
        _ArrayAdd($aInputArray2D, convertCoordTo2D($aInputArray[$i]))
    Next

    For $i = 2 To UBound($aBestRoute) - 1
        _ArrayAdd($aBestRoute2D, convertCoordTo2D($aBestRoute[$i]))
    Next

    Local $sMiddle2D = $iGridSize / 2
    Local $aStartCoordinate2D = StringSplit(convertCoordTo2D($sStartCoordinate), ':', 2)
    Local $aEndCoordinate2D = StringSplit(convertCoordTo2D($sEndCoordinate), ':', 2)
    Local $iXDifference = $aStartCoordinate2D[0] - $sMiddle2D
    Local $iYDifference = $aStartCoordinate2D[1] - $sMiddle2D

    For $i = 1 To $iMapWidth * $iMapRoot
        For $j = 1 To $iMapHeight * $iMapRoot
            ; Überprüfen Sie, ob die Koordinate in der besten Route ist
            If _ArraySearch($aBestRoute2D, $i & ":" & $j) >= 0 Then
                Local $iRouteIndex = _ArraySearch($aBestRoute2D, $i & ":" & $j)
                If $iRouteIndex >= 1 Then ; Beachten Sie den Index 1, um den ersten Zielpunkt einzubeziehen
                    _GDIPlus_GraphicsFillRect($hGraphic, ($i - 1 - $iXDifference) * $iLineSpacing, ($j - 1 - $iYDifference) * $iLineSpacing, $iLineSpacing, $iLineSpacing, $hBrushRed)
                    ; Beschriftung mit der Reihenfolge hinzufügen
                    _GDIPlus_GraphicsDrawString($hGraphic, $iRouteIndex & "", ($i - 1 - $iXDifference) * $iLineSpacing + 5, ($j - 1 - $iYDifference) * $iLineSpacing + 5, "Arial", 10, 0, 0xFFFFFFFF)
                EndIf
            ElseIf _ArraySearch($aInputArray2D, $i & ":" & $j) >= 0 Then
;~              ConsoleWrite("Zeichnen aus InputArray:" & @CRLF & $i & ":" & $j & " | " & $aInputArray[_ArraySearch($aInputArray2D, $i & ":" & $j)] & @CRLF)
                ; Koordinate im InputArray, aber nicht in der besten Route
                _GDIPlus_GraphicsFillRect($hGraphic, ($i - 1 - $iXDifference) * $iLineSpacing, ($j - 1 - $iYDifference) * $iLineSpacing, $iLineSpacing, $iLineSpacing, $hBrushOrange)
            EndIf

            ; Endpunkt zeichnen, wenn er nicht die Start-Koordinate ist
            If Not _2DCoordArraysEqual($aStartCoordinate2D, $aEndCoordinate2D) And _2DCoordStringsEqual($i & ":" & $j, convertCoordTo2D($sEndCoordinate)) Then
                _GDIPlus_GraphicsFillRect($hGraphic, ($i - 1 - $iXDifference) * $iLineSpacing, ($j - 1 - $iYDifference) * $iLineSpacing, $iLineSpacing, $iLineSpacing, $hBrushGrey)
                    ; "FIN" in die Koordinaten schreiben
                _GDIPlus_GraphicsDrawString($hGraphic, "FIN", ($i - 1 - $iXDifference) * $iLineSpacing + 5, ($j - 1 - $iYDifference) * $iLineSpacing + 5, "Arial", 10, 0, 0xFFFFFFFF)
            EndIf
        Next
    Next

    ; Startpunkt zeichnen und die Länge des Lösung angebe
    _GDIPlus_GraphicsFillRect($hGraphic, ($sMiddle2D - 1) * $iLineSpacing, ($sMiddle2D - 1) * $iLineSpacing, $iLineSpacing, $iLineSpacing, $hBrushBlack)
    _GDIPlus_GraphicsDrawString($hGraphic, $aBestRoute[1], ($sMiddle2D - 1) * $iLineSpacing + 10, ($sMiddle2D - 1) * $iLineSpacing + 15, "Arial", 12, 0, 0xFFFFFFFF)

    ; Gitter zeichnen
    For $i = 1 To $iGridSize
        For $j = 1 To $iGridSize
            _GDIPlus_GraphicsDrawRect($hGraphic, ($i - 1) * $iLineSpacing, ($j - 1) * $iLineSpacing, $iLineSpacing, $iLineSpacing, $hPen)
        Next
    Next

    ; GUI anzeigen
    GUISetState(@SW_SHOW, $hGUI)

    ; Loop bis der Benutzer die Anwendung schließt.
    Do
    Until GUIGetMsg() = $GUI_EVENT_CLOSE

    ; Ressourcen aufräumen
    CleanupResources($hBrushOrange, $hBrushRed, $hBrushBlack, $hPen, $hGraphic, $hGUI)
EndFunc

Func CleanupResources($hBrushOrange, $hBrushRed, $hBrushBlack, $hPen, $hGraphic, $hGUI)
    _GDIPlus_BrushDispose($hBrushOrange)
    _GDIPlus_BrushDispose($hBrushRed)
    _GDIPlus_BrushDispose($hBrushBlack)
    _GDIPlus_PenDispose($hPen)
    _GDIPlus_GraphicsDispose($hGraphic)
    _GDIPlus_Shutdown()
    GUIDelete($hGUI)
EndFunc

Func _2DCoordArraysEqual($coord1, $coord2)
    ; Überprüfen, ob beide Parameter Arrays sind
    If IsArray($coord1) And IsArray($coord2) Then
        ; Überprüfen Sie die Anzahl der Elemente in beiden Arrays
        If UBound($coord1) <> UBound($coord2) Then
            Return False
        EndIf

        ; Vergleichen Sie die Werte in den Arrays
        For $i = 0 To UBound($coord1) - 1
            If $coord1[$i] <> $coord2[$i] Then
                Return False
            EndIf
        Next

        ; Wenn alle Vergleiche erfolgreich sind, geben Sie True zurück
        Return True
    EndIf

    ; Wenn keiner der obigen Fälle zutrifft, geben Sie False zurück
    Return False
EndFunc

Func _2DCoordStringsEqual($coord1, $coord2)
    ; Zerlegen Sie die Koordinaten in Arrays
    Local $aCoord1 = StringSplit($coord1, ':')
    Local $aCoord2 = StringSplit($coord2, ':')

    ; Überprüfen Sie die Anzahl der Elemente in beiden Arrays
    If UBound($aCoord1) <> UBound($aCoord2) Then
        Return False
    EndIf

    ; Vergleichen Sie die Werte in den Arrays
    For $i = 1 To UBound($aCoord1) - 1
        If $aCoord1[$i] <> $aCoord2[$i] Then
            Return False
        EndIf
    Next

    ; Wenn alle Vergleiche erfolgreich sind, geben Sie True zurück
    Return True
EndFunc

Func convertCoordTo2D($sCoord)
    $aCoord = getArrayFromCoordString($sCoord)

    Local $ax = ($aCoord[0][0] - 1) * $iMapRoot + Mod($aCoord[0][2] - 1, $iMapRoot) + 1
    Local $ay = ($aCoord[0][1] - 1) * $iMapRoot + Int(($aCoord[0][2] - 1)/$iMapRoot) + 1

    Return $ax & ":" & $ay
EndFunc

Func convert2DTo3D($sCoord)
    Local $aCoord = StringSplit($sCoord, ':', 2)
    Local $ax = $aCoord[0]
    Local $ay = $aCoord[1]
    Local $ar = Mod(($ax - 1), $iMapRoot) + 1 + Mod(($ay - 1), $iMapRoot) * $iMapRoot
    Local $axx = Ceiling($ax / $iMapRoot)
    Local $ayy = Ceiling($ay / $iMapRoot)
    Return $axx & ":" & $ayy & ":" & $ar
EndFunc

Func getStringFromArrayCoord($aArray)
    Return $aArray[0][0] & ":" & $aArray[0][1] & ":" & $aArray[0][2]
EndFunc

Func getArrayFromCoordString($sString)
    Local $aTmp1 = StringSplit($sString, ':', 2)
    Local $aCoord[1][3] =  [[$aTmp1[0], $aTmp1[1], $aTmp1[2]]]

    Return $aCoord
EndFunc

Func getDistance($sStart, $sTarget)
    Local $aDist[9]

    ; If the start and destination are the same, the distance is 1
    If StringCompare($sStart, $sTarget) = 0 Then Return 1

    Local $aTmp1 = getArrayFromCoordString($sStart), $aTmp2 = getArrayFromCoordString($sTarget)
    Local $x1 = Int($aTmp1[0][0]), $y1 = Int($aTmp1[0][1]), $r1 = Int($aTmp1[0][2])
    Local $x2 = Int($aTmp2[0][0]), $y2 = Int($aTmp2[0][1]), $r2 = Int($aTmp2[0][2])

    $aDist[0] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2 - $iMapWidth) & ':' & ($y2 - $iMapHeight) & ':' & ($r2))
    $aDist[1] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2 - $iMapWidth) & ':' & ($y2)               & ':' & ($r2))
    $aDist[2] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2 - $iMapWidth) & ':' & ($y2 + $iMapHeight) & ':' & ($r2))
    $aDist[3] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2)              & ':' & ($y2 - $iMapHeight) & ':' & ($r2))
    $aDist[4] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2)              & ':' & ($y2)               & ':' & ($r2))
    $aDist[5] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2)              & ':' & ($y2 + $iMapHeight) & ':' & ($r2))
    $aDist[6] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2 + $iMapWidth) & ':' & ($y2 - $iMapHeight) & ':' & ($r2))
    $aDist[7] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2 + $iMapWidth) & ':' & ($y2)               & ':' & ($r2))
    $aDist[8] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2 + $iMapWidth) & ':' & ($y2 + $iMapHeight) & ':' & ($r2))

    Return Min9($aDist[0], $aDist[1], $aDist[2], $aDist[3], $aDist[4], $aDist[5], $aDist[6], $aDist[7], $aDist[8])
EndFunc

Func getDistanceWithBorder($sStart, $sTarget)
    Local $aTmp1 = StringSplit($sStart, ':', 2), $aTmp2 = StringSplit($sTarget, ':', 2)

    Local $x1 = Int($aTmp1[0]), $y1 = Int($aTmp1[1]), $r1 = Int($aTmp1[2])
    Local $x2 = Int($aTmp2[0]), $y2 = Int($aTmp2[1]), $r2 = Int($aTmp2[2])

    Local $ax = ($x1 - 1) * $iMapRoot + Mod($r1 - 1, $iMapRoot)
    Local $ay = ($y1 - 1) * $iMapRoot + Int(($r1 - 1)/$iMapRoot)
    Local $bx = ($x2 - 1) * $iMapRoot + Mod($r2 - 1, $iMapRoot)
    Local $by = ($y2 - 1) * $iMapRoot + Int(($r2 - 1)/$iMapRoot)

    Local $iDist = Min2(Abs($ax - $bx), Abs($ay - $by))

    $ax += $ax > $bx ? -$iDist : $iDist
    $ay += $ay > $by ? -$iDist : $iDist

    Return $iDist + Abs($ax - $bx) + Abs($ay - $by)
EndFunc

Func Min($a, $b)
    Return $a < $b ? $a : $b
EndFunc   ;==>Min

Func Min2($a, $b)
    Return $a < $b ? $a : $b
EndFunc

Func Min3($a, $b, $c)
    Return $a < $b ? $a < $c ? $a : $c : $b < $c ? $b : $c
EndFunc

Func Min9($1, $2, $3, $4, $5, $6, $7, $8, $9)
    Return Min3(Min3($1, $2, $3), Min3($4, $5, $6), Min3($7, $8, $9))
EndFunc

Func Max($a, $b)
    Return $a > $b ? $a : $b
EndFunc

A section of the coordinate system to understand it:

;~ ---------------------------  +  ------------------------  +  ------------------------
;~ 60:60:1 | 60:60:2 | 60:60:3  |  1:60:1 | 1:60:2 | 1:60:3  |  2:60:1 | 2:60:2 | 2:60:3
;~ ---------------------------  |  ------------------------  |  ------------------------
;~ 60:60:4 | 60:60:5 | 60:60:6  |  1:60:4 | 1:60:5 | 1:60:6  |  2:60:4 | 2:60:5 | 2:60:6
;~ ---------------------------  |  ------------------------  |  ------------------------
;~ 60:60:7 | 60:60:8 | 60:60:9  |  1:60:7 | 1:60:8 | 1:60:9  |  2:60:7 | 2:60:8 | 2:60:9
;~ ---------------------------  +  ------------------------  +  ------------------------
;~ 60:1:1  | 60:1:2  | 60:1:3   |  1:1:1  | 1:1:2  | 1:1:3   |  2:1:1  | 2:1:2  | 2:1:3
;~ ---------------------------  |  ------------------------  |  ------------------------
;~ 60:1:4  | 60:1:5  | 60:1:6   |  1:1:4  | 1:1:5  | 1:1:6   |  2:1:4  | 2:1:5  | 2:1:6
;~ ---------------------------  |  ------------------------  |  ------------------------
;~ 60:1:7  | 60:1:8  | 60:1:9   |  1:1:7  | 1:1:8  | 1:1:9   |  2:1:7  | 2:1:8  | 2:1:9
;~ ---------------------------  +  ------------------------  +  ------------------------
;~ 60:2:1  | 60:2:2  | 60:2:3   |  1:2:1  | 1:2:2  | 1:2:3   |  2:2:1  | 2:2:2  | 2:2:3
;~ ---------------------------  |  ------------------------  |  ------------------------
;~ 60:2:4  | 60:2:5  | 60:2:6   |  1:2:4  | 1:2:5  | 1:2:6   |  2:2:4  | 2:2:5  | 2:2:6
;~ ---------------------------  |  ------------------------  |  ------------------------
;~ 60:2:7  | 60:2:8  | 60:2:9   |  1:2:7  | 1:2:8  | 1:2:9   |  2:2:7  | 2:2:8  | 2:2:9
;~ ---------------------------  +  ------------------------  +  ------------------------

Maybe this one helps either, to understand it:
 

#include <Array.au3>

$aTable = Create(60, 60, 3) ; Zum Anzeigen des ganzen Systems als Array
_ArrayDisplay($aTable)

Func Create($iTableHeight = 3, $iTableWidth = 3, $iTableElementsRoot = 3)
    Local $aRet[$iTableHeight * $iTableElementsRoot][$iTableWidth * $iTableElementsRoot]
    For $y = 0 To $iTableHeight - 1 Step 1
        For $x = 0 To $iTableWidth - 1 Step 1
            For $i = 1 To $iTableElementsRoot ^ 2 Step 1
                $aRet[$y * $iTableElementsRoot + Int(($i-1)/$iTableElementsRoot)][$x * $iTableElementsRoot + Mod($i - 1, $iTableElementsRoot)] = $i
            Next
        Next
    Next
    Return $aRet
EndFunc

 

Edited by Acanis
Link to comment
Share on other sites

Posted (edited)

@Acanis: As they say in German: "Da gibt's noch Luft  nach oben." :D You're making things faaaaaar too complicated (I'm not even going to go into how you're setting up/evaluating your 3D/2D grid...:huh2:). Was this ChatGPT's idea? But you earn some points for at least annotating your code. Or was that ChatGPT as well?

I edited the TSP example on the assumption that the desired number of intermediate points is fixed, and point duplication is not allowed. You can play with $tempfactor (and $maxStepsWithoutImprovement) to adjust how much exploration of the solution space is allowed. If $verbose = true (default false now), the best sequence of journey legs so far is ArrayDisplayed every time a better solution is found (press <Esc> (every time) to continue); press <Space> to terminate prematurely.

This is all I'm going to write for you here; visualisation and any changes you'll have to implement yourself.:P Hope it helps.

Spoiler
; a Simulated Annealing example (combinatorial minimisation), by RTFC (05 March 2024)
; Adapted from Press et al. Numerical Recipes, 2nd ed., pp.438-443.

; Note that the algorithm converges on A local minimum (in terms of the
; user-defined cost-function(s)), which is not necessarily THE global minimum.
; Note also that the search path, duration, and final result may differ from run to run (city coordinates change every time).
; Several parameters and weights can be tweaked to adjust this.

#include <Array.au3>
#include <Math.au3>

; press <SPACE> to terminate early
HotKeySet("{SPACE}", "_EarlyOut")
Global $earlyout=False
Global $verbose=False       ; T: show best so far whenever improved (then press <ESC> to continue)
SRandom(@MSEC+@AutoItPID); initialise randomising seed

Global $iMapWidth = 60, $iMapHeight = 60, $iMapRoot = 3

; Beispielkoordinaten
Global $positions = [ "2:50:9", "2:50:2", "2:50:4", "1:50:3", "1:50:8", _
    "1:49:8", "3:49:4", "3:51:3", "3:51:8", "2:51:7", "1:51:4", "2:48:8", _
    "2:48:4", "1:48:3", "1:48:2", "1:48:1", "3:48:4", "4:49:4", "3:50:6", _
    "4:50:4", "4:50:5", "5:51:1" ]

Global $sStartCoordinate = "3:51:1"
Global $sHomeCoordinate = "2:50:8"
Global $iNumberOfTargets = 5    ; number of intermediate points

; NOTE: adjust this value down to allow more initial exploration of the solution space
Global $tempfactor=0.2
; NOTE: if you do this, you'll need to allow more time before quitting, so increase this value
Global $maxStepsWithoutImprovement = 25 ; early-out
; NOTE: as the minimum distance = 1, we can define an early-out condition here
Global $mincost=$iNumberOfTargets

$index=_ArraySearch($positions,$sStartCoordinate)
if $index>=0 Then _ArrayDelete($positions,$index)
_ArrayAdd($positions,$sStartCoordinate) ; ensure startpos is listed, but beyond maxpos

$index=_ArraySearch($positions,$sHomeCoordinate)
if $index>=0 Then _ArrayDelete($positions,$index)
_ArrayAdd($positions,$sHomeCoordinate)  ; ensure endpos is listed, but beyond maxpos


; related global vars
Global $maxpos=UBound($positions)-3 ; total points to pick from (base-0)
Global $maxcity=$iNumberOfTargets + 2   ; actual path sequence length
Global $lastcity=$maxcity-1 ; index of endpoint

If $maxpos<$maxcity*2 Then
    ConsoleWrite("Not enough points to work with; aborting" & @CRLF)
    Exit        ; we need something to work with
EndIf


; Simulated Annealing vars
Global $temperat,$pathcost,$kk,$nswap,$nswapstep,$cost,$tempstep,$tempsteps
Global $absimp,$lowestcost,$costdiff,$initcost,$lowestcost

; path length-related arrays
Global $current[$maxcity],$altorder[$maxcity],$bestorder[$maxcity],$bestPoints[$maxcity][3]
Global $currentcost[$maxcity],$altcost[$maxcity]

$currentcost[0]=0
$altcost[0]=0
For $cc=1 to $iNumberOfTargets
    $current[$cc]=-1
    $currentcost[$cc]=0
    $altcost[$cc]=0
Next

_GetBestRoute($sStartCoordinate, $sHomeCoordinate)


Func _GetBestRoute($sStartCoordinate, $sHomeCoordinate = False)

Local $aBestRoute[0]
Local $sEndCoordinate = $sHomeCoordinate ? $sHomeCoordinate : $sStartCoordinate
Local $index1,$index2,$tmp

; prep the buffers
$current[0]=_ArraySearch($positions,$sStartCoordinate)
$current[$iNumberOfTargets+1]=_ArraySearch($positions,$sEndCoordinate)
For $cc=1 to $iNumberOfTargets
    $current[$cc]=_GetRandomIndexExcludeArray($current) ; replace all points inbetween
Next

$altorder=$current
$bestorder=$current

;______START OF ANNEALING ROUTINE____________
If not $verbose Then ConsoleWrite("Startinng Simulated Annealing routine..." & @CRLF & "Press <Space> to terminate prematurely." & @CRLF & @CRLF)

$nover=100*$maxpos      ; maximum number of paths at any temperature
$nlimit=10*$maxpos      ; maximum number of successful path changes before continuing
$nwrite=Int($nover/5)   ; default status update interval if verbose=.t.
$tempsteps=100          ; number of temperature steps to try
$tfactor=0.90           ; annealing schedule: temperature is reduced by this factor after each step

    $temperat=0.5       ; initial temperature; smaller = more aggressive + more myopic search
    $absimp=0           ; counter
    $nswapstepzero=0    ; counter

    ; prep the cost vars
    $pathcost=_CalcPathLength(0)    ; calculate from startpoint (index 0)
    $currentcost = $altcost
    $initcost=$pathcost
    $lowestcost=$pathcost

    ; main loop starts here
    For $tempstep=1 to $tempsteps       ; try up to N temperature steps
        $nswap=0
        $nswapstep=0

        For $kk=1 to $nover
            $altorder = $current

            ; decide whether to try a new point or swap internally (equal chances)
            $doTransport=(Random()<=0.5)    ; adjust value down to favour swap; up to favour replacePoint

            switch $doTransport
                Case True   ; try a new point
                    $index1=Random(1,$maxcity-2,1)
                    $altorder[$index1]=_GetRandomIndexExcludeArray($current)
                    $pathcost=_CalcPathLength($index1-1)    ; start at last unchanged position

                Case Else       ; try an internal swap of current points instead
                    $index1=Random(1,$maxcity-2,1)
                    Do
                        $index2=Random(1,$maxcity-2,1)
                    Until $index1 <> $index2

                    ; swap points internally
                    $tmp=$altorder[$index1]
                    $altorder[$index1]=$altorder[$index2]
                    $altorder[$index2]=$tmp

                    $pathcost=_CalcPathLength(_Min($index1,$index2)-1); start at last unchanged position
            EndSwitch

            ; Listen to the wind, talk to the trees...
            Switch _AskOracle()
                Case True   ; path change accepted
                    $nswap+=1
                    $current=$altorder
                    $currentcost = $altcost

                    If $lowestcost>$pathcost Then
                        $nswapstep+=1
                        $absimp+=1
                        $lowestcost=$pathcost
                        $bestorder = $altorder
                        If $verbose Then _FillBestPoints()
                    EndIf

                    If $nswap>=$nlimit then ExitLoop
            EndSwitch

            if $earlyout=true Then ExitLoop
        Next

        _ScreenOut($tempstep)
        If $nswapstep=0 then $nswapstepzero+=1
        If $nswapstepzero=$maxStepsWithoutImprovement then ExitLoop     ; no more improvements in the last N temperature steps
        If $lowestcost<=$mincost Then ExitLoop

        ; reduce temperature = likelihood of following a trajectory away from the nearest LOCAL optimum (in the hope of getting nearer to the GLOBAL optimum)
        $temperat*=$tfactor
    Next

    _FillBestPoints()
EndFunc


Func _FillBestPoints()

    $altorder = $bestorder
    _CalcPathLength(0)

    For $cc=0 to $iNumberOfTargets+1
        $bestPoints[$cc][0]=$bestorder[$cc]
        $bestPoints[$cc][1]=$positions[$bestorder[$cc]]
        $bestPoints[$cc][2]=$altcost[$cc]
    Next

    ; show final result
    _ArrayDisplay($bestPoints, "Shortest: " & $lowestcost)

EndFunc

Func _AskOracle()

    If $costdiff<0 Then
        Return True
    Else        ; this is where all the magic happens!
        Return (random()<Exp(-($tempfactor*$costdiff/$temperat)))
    Endif

EndFunc


Func _CalcPathLength($start)

    $altcost = $currentcost
    Local $sum=$currentcost[$start]

    For $cc=$start To $lastcity-1
        $sum+=getDistance($positions[$altorder[$cc]],$positions[$altorder[$cc+1]])
        $altcost[$cc+1]=$sum    ; store cumulative sum at leg's endpoint
    Next
    $costdiff=$altcost[$lastcity]-$currentcost[$lastcity]   ; new - previous result

    Return $altcost[$lastcity]  ; total cost
EndFunc


Func _ScreenOut($tempstep)

    ConsoleWrite("Simulated Annealing. Initial Cost: " & $initcost & @CRLF)
    ConsoleWrite("Step: " & $tempstep & " of " & $tempsteps & "; Temperature: " & $temperat & @CRLF)
    ConsoleWrite("Executed Swaps: " & $nswap & "; lowest cost: " & $lowestcost & @CRLF)
    ConsoleWrite("Total Improvements: " & $absimp & "; Improvements this step: " & $nswapstep & @CRLF  & @CRLF)

EndFunc


Func getDistance($sStart, $sTarget)
    Local $aDist[9]

    ; If the start and destination are the same, the distance is 1
    If StringCompare($sStart, $sTarget) = 0 Then Return 1

    Local $aTmp1 = getArrayFromCoordString($sStart), $aTmp2 = getArrayFromCoordString($sTarget)
    Local $x1 = Int($aTmp1[0][0]), $y1 = Int($aTmp1[0][1]), $r1 = Int($aTmp1[0][2])
    Local $x2 = Int($aTmp2[0][0]), $y2 = Int($aTmp2[0][1]), $r2 = Int($aTmp2[0][2])

    $aDist[0] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2 - $iMapWidth) & ':' & ($y2 - $iMapHeight) & ':' & ($r2))
    $aDist[1] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2 - $iMapWidth) & ':' & ($y2)               & ':' & ($r2))
    $aDist[2] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2 - $iMapWidth) & ':' & ($y2 + $iMapHeight) & ':' & ($r2))
    $aDist[3] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2)              & ':' & ($y2 - $iMapHeight) & ':' & ($r2))
    $aDist[4] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2)              & ':' & ($y2)               & ':' & ($r2))
    $aDist[5] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2)              & ':' & ($y2 + $iMapHeight) & ':' & ($r2))
    $aDist[6] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2 + $iMapWidth) & ':' & ($y2 - $iMapHeight) & ':' & ($r2))
    $aDist[7] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2 + $iMapWidth) & ':' & ($y2)               & ':' & ($r2))
    $aDist[8] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2 + $iMapWidth) & ':' & ($y2 + $iMapHeight) & ':' & ($r2))

    Return _ArrayMin($aDist)    ; NOTE: a function for this exists
EndFunc


Func getDistanceWithBorder($sStart, $sTarget)
    Local $aTmp1 = StringSplit($sStart, ':', 2), $aTmp2 = StringSplit($sTarget, ':', 2)

    Local $x1 = Int($aTmp1[0]), $y1 = Int($aTmp1[1]), $r1 = Int($aTmp1[2])
    Local $x2 = Int($aTmp2[0]), $y2 = Int($aTmp2[1]), $r2 = Int($aTmp2[2])

    Local $ax = ($x1 - 1) * $iMapRoot + Mod($r1 - 1, $iMapRoot)
    Local $ay = ($y1 - 1) * $iMapRoot + Int(($r1 - 1)/$iMapRoot)
    Local $bx = ($x2 - 1) * $iMapRoot + Mod($r2 - 1, $iMapRoot)
    Local $by = ($y2 - 1) * $iMapRoot + Int(($r2 - 1)/$iMapRoot)

    Local $iDist = _Min(Abs($ax - $bx), Abs($ay - $by)) ; NOTE: a function for this exists

    $ax += $ax > $bx ? -$iDist : $iDist
    $ay += $ay > $by ? -$iDist : $iDist

    Return $iDist + Abs($ax - $bx) + Abs($ay - $by)
EndFunc


Func getArrayFromCoordString($sString)
    Local $aTmp1 = StringSplit($sString, ':', 2)
    Local $aCoord[1][3] =  [[$aTmp1[0], $aTmp1[1], $aTmp1[2]]]

    Return $aCoord
EndFunc


Func _GetRandomIndexExcludeArray(ByRef $excludedIndices)
    Local $index
    Do
        $index=Random(0,$maxpos,1)
    Until _ArraySearch($excludedIndices,$index)<0

    Return $index
EndFunc

func _EarlyOut()
    $earlyout=true
EndFunc

 

 

Edited by RTFC
minor efficiency optimisation in code
Link to comment
Share on other sites

27 minutes ago, RTFC said:

@Acanis: As they say in German: "Da gibt's noch Luft  nach oben." :D You're making things faaaaaar too complicated (I'm not even going to go into how you're setting up/evaluating your 3D/2D grid...:huh2:). Was this ChatGPT's idea? But you earn some points for at least annotating your code. Or was that ChatGPT as well?

I edited the TSP example on the assumption that the desired number of intermediate points is fixed, and point duplication is not allowed. You can play with $tempfactor (and $maxStepsWithoutImprovement) to adjust how much exploration of the solution space is allowed. If $verbose = true (default false now), the best sequence of journey legs so far is ArrayDisplayed every time a better solution is found (press <Esc> (every time) to continue); press <Space> to terminate prematurely.

This is all I'm going to write for you here; visualisation and any changes you'll have to implement yourself.:P Hope it helps.

Hehe, Iam german and your right... ;) But I try to improve :D

The grid stuff is really old and I got some help of a more experienced programmer to finish it... ^^ (And I liked it, because it was there and understandable for me^^) ChatGPT did help me with the visualisation, because I never used GDI+ before ^^ I try to annotate my code, but ChatGPT did help, too :D

I planned the desired number of intermediate points to be an input to the function. But if Iam able to understand your code, Ill try to change that myself. :)

In any case, MANY THANKS in advance!

Ill add the visualisation stuff later and test it a lot to understand the code and the impact of the parameters. :) Really cool! :)

Edited by Acanis
Link to comment
Share on other sites

I still dont understand everything, but working on it :) I reduced the global variables, put all the stuff into an function and renamed a lot of the variables. Maybe its worse for experienced eyes, but it helps me a lot :D

It seems that after the refactoring everything still works as before and I was able to customize it so that the drawing function can be used again without further customization. 

Ill play around with the parameters and compare the solutions with the one of my own try; but it feels pretty good for the example data :)! Ill post the updated code, so other interested people can use it :)
 

Spoiler
#include <Array.au3>
#include <Math.au3>
#include <GUIConstantsEx.au3>
#include <WindowsConstants.au3>
#include <GDIPlus.au3>
#include <EditConstants.au3>

; press <SPACE> to terminate early
HotKeySet("{SPACE}", "_EarlyOut")
SRandom(@MSEC + @AutoItPID) ; initialise randomising seed

Global $iMapWidth = 60, $iMapHeight = 60, $iMapRoot = 3

; Beispielkoordinaten
Local $aPositions = ["2:50:9", "2:50:2", "2:50:4", "1:50:3", "1:50:8", _
        "1:49:8", "3:49:4", "3:51:3", "3:51:8", "2:51:7", "1:51:4", "2:48:8", _
        "2:48:4", "1:48:3", "1:48:2", "1:48:1", "3:48:4", "4:49:4", "3:50:6", _
        "4:50:4", "4:50:5", "5:51:1"]

Local $sStartCoordinate = "3:51:1"
Local $sHomeCoordinate = "2:50:8"

#Region - call the function
Local $aResult = _GetBestRoute($sStartCoordinate, $aPositions, 5, $sHomeCoordinate)
;~ _ArrayDisplay($aResult)

DrawMap($aPositions, $sStartCoordinate, $aResult, $aResult[UBound($aResult) - 1])
#EndRegion

; Lower tempfactor => allow more initial exploration of the solution space | early out after x steps without improvement
Func _GetBestRoute($sStartCoordinate, $aPositions, $iNumberOfTargets, $sHomeCoordinate = False, $tempfactor = 0.2, $maxStepsWithoutImprovement = 8, $bEarlyOut = False, $bVerbose = False)
    Global $g_aCostDiff ; Needs to stay global
    
    Local $aBestRoute[0]
    Local $sEndCoordinate = $sHomeCoordinate ? $sHomeCoordinate : $sStartCoordinate
    Local $iIndex1, $iIndex2, $tmp
    Local $iTempstep, $iInitCost, $iTempsteps, $dTemperat, $iSwap, $iLowestCost, $iAbsImp, $iSwapStep, $iPathCost, $iMinCost
    
    Local $iMaxPos=UBound($aPositions)-1 ; total points to pick from (base-0)
    Local $iMaxCity=$iNumberOfTargets + 2   ; actual path sequence length
    Local $iLastCity=$iMaxCity-1 ; index of endpoint

    ; path length-related arrays // Need to stay global
    Global $g_aCurrent[$iMaxCity], $g_aAltOrder[$iMaxCity],$g_aBestOrder[$iMaxCity],$g_aBestPoints[$iMaxCity][3]
    Global $g_aCurrentCost[$iMaxCity],$g_aAltCost[$iMaxCity]    

    If $iMaxPos<$iMaxCity*2 Then
        ConsoleWrite("Not enough points to work with: aborting" & @CRLF)
        Exit        ; we need something to work with
    EndIf

    $iIndex=_ArraySearch($aPositions,$sStartCoordinate)
    if $iIndex>=0 Then _ArrayDelete($aPositions,$iIndex)
    _ArrayAdd($aPositions,$sStartCoordinate) ; ensure startpos is listed, but beyond maxpos

    $iIndex=_ArraySearch($aPositions,$sHomeCoordinate)
    if $iIndex>=0 Then _ArrayDelete($aPositions,$iIndex)
    _ArrayAdd($aPositions,$sHomeCoordinate)  ; ensure endpos is listed, but beyond maxpos

    $g_aCurrentCost[0]=0
    $g_aAltCost[0]=0
    For $cc=1 to $iNumberOfTargets
        $g_aCurrent[$cc]=-1
        $g_aCurrentCost[$cc]=0
        $g_aAltCost[$cc]=0
    Next
    
    ; as the minimum distance = 1, we can define an early-out condition here
    $iMinCost = $iNumberOfTargets

    ; prep the buffers
    $g_aCurrent[0] = _ArraySearch($aPositions, $sStartCoordinate)
    $g_aCurrent[$iNumberOfTargets + 1] = _ArraySearch($aPositions, $sEndCoordinate)
    For $cc = 1 To $iNumberOfTargets
        $g_aCurrent[$cc] = _GetRandomIndexExcludeArray($g_aCurrent, $iMaxPos) ; replace all points inbetween
    Next

    $g_aAltOrder = $g_aCurrent
    $g_aBestOrder = $g_aCurrent

    ;______START OF ANNEALING ROUTINE____________
    If Not $bVerbose Then ConsoleWrite("Startinng Simulated Annealing routine..." & @CRLF & "Press <Space> to terminate prematurely." & @CRLF & @CRLF)

    $iMaxPaths = 100 * $iMaxPos ; maximum number of paths at any temperature
    $iSucessfulPathLimit = 10 * $iMaxPos ; maximum number of successful path changes before continuing
;~  $nwrite = Int($iMaxPaths / 5) ; default status update interval if verbose=.t.; Not used
    $iTempsteps = 100    ; number of temperature steps to try
    $dTempReduceFactor = 0.90     ; annealing schedule: temperature is reduced by this factor after each step

    $dTemperat = 0.5     ; initial temperature; smaller = more aggressive + more myopic search
    $iAbsImp = 0         ; counter
    $iSwapStepZero = 0  ; counter

    ; prep the cost vars
    $iPathCost = _CalcPathLength(0, $aPositions, $iLastCity)  ; calculate from startpoint (index 0)
    $g_aCurrentCost = $g_aAltCost
    $iInitCost = $iPathCost
    $iLowestCost = $iPathCost

    ; main loop starts here
    For $iTempstep = 1 To $iTempsteps     ; try up to N temperature steps
        $iSwap = 0
        $iSwapStep = 0

        For $kk = 1 To $iMaxPaths
            $g_aAltOrder = $g_aCurrent

            ; decide whether to try a new point or swap internally (equal chances)
            $doTransport = (Random() <= 0.5) ; adjust value down to favour swap; up to favour replacePoint

            Switch $doTransport
                Case True   ; try a new point
                    $iIndex1 = Random(1, $iMaxCity - 2, 1)
                    $g_aAltOrder[$iIndex1] = _GetRandomIndexExcludeArray($g_aCurrent, $iMaxPos)
                    $iPathCost = _CalcPathLength($iIndex1 - 1, $aPositions, $iLastCity) ; start at last unchanged position

                Case Else       ; try an internal swap of current points instead
                    $iIndex1 = Random(1, $iMaxCity - 2, 1)
                    Do
                        $iIndex2 = Random(1, $iMaxCity - 2, 1)
                    Until $iIndex1 <> $iIndex2

                    ; swap points internally
                    $tmp = $g_aAltOrder[$iIndex1]
                    $g_aAltOrder[$iIndex1] = $g_aAltOrder[$iIndex2]
                    $g_aAltOrder[$iIndex2] = $tmp

                    $iPathCost = _CalcPathLength(_Min($iIndex1, $iIndex2) - 1, $aPositions, $iLastCity) ; start at last unchanged position
            EndSwitch

            ; Listen to the wind, talk to the trees...
            Switch _AskOracle($tempfactor, $dTemperat)
                Case True   ; path change accepted
                    $iSwap += 1
                    $g_aCurrent = $g_aAltOrder
                    $g_aCurrentCost = $g_aAltCost

                    If $iLowestCost > $iPathCost Then
                        $iSwapStep += 1
                        $iAbsImp += 1
                        $iLowestCost = $iPathCost
                        $g_aBestOrder = $g_aAltOrder
                        If $bVerbose Then Return _FillBestPoints($aPositions, $iLastCity, $iNumberOfTargets)
                    EndIf

                    If $iSwap >= $iSucessfulPathLimit Then ExitLoop
            EndSwitch

            If $bEarlyOut = True Then ExitLoop
        Next

        _ScreenOut($iTempstep, $iInitCost, $iTempsteps, $dTemperat, $iSwap, $iLowestCost, $iAbsImp, $iSwapStep)
        If $iSwapStep = 0 Then $iSwapStepZero += 1
        If $iSwapStepZero = $maxStepsWithoutImprovement Then ExitLoop   ; no more improvements in the last N temperature steps
        If $iLowestCost <= $iMinCost Then ExitLoop

        ; reduce temperature = likelihood of following a trajectory away from the nearest LOCAL optimum (in the hope of getting nearer to the GLOBAL optimum)
        $dTemperat *= $dTempReduceFactor
    Next

    Return _FillBestPoints($aPositions, $iLastCity, $iNumberOfTargets)
EndFunc   ;==>_GetBestRoute

Func _FillBestPoints($aPositions, $iLastCity, $iNumberOfTargets)
    $g_aAltOrder = $g_aBestOrder
    _CalcPathLength(0, $aPositions, $iLastCity)
    
    #Region - Reduces informations to match the original output // Adds informations to match the original output
    Dim $g_aBestPoints[UBound($g_aBestPoints)]
    
    For $cc = 0 To $iNumberOfTargets + 1
        $g_aBestPoints[$cc] = $aPositions[$g_aBestOrder[$cc]]
    Next    
    
    _ArrayInsert($g_aBestPoints, 0, UBound($g_aBestPoints) -2) ; add number of targets (without start-/endpoint)
    _ArrayInsert($g_aBestPoints, 1, $g_aAltCost[$iNumberOfTargets + 1]) ; add number of total costs
    #EndRegion
    
    #Region - More informations, not needed atm
;~  For $cc = 0 To $iNumberOfTargets + 1
;~      $g_aBestPoints[$cc][0] = $g_aBestOrder[$cc]
;~      $g_aBestPoints[$cc][1] = $aPositions[$g_aBestOrder[$cc]]
;~      $g_aBestPoints[$cc][2] = $g_aAltCost[$cc]
;~  Next    
    #EndRegion

    Return $g_aBestPoints
EndFunc   ;==>_FillBestPoints

Func _AskOracle($tempfactor, $dTemperat)
    If $g_aCostDiff < 0 Then
        Return True
    Else        ; this is where all the magic happens!
        Return (Random() < Exp(-($tempfactor * $g_aCostDiff / $dTemperat)))
    EndIf
EndFunc   ;==>_AskOracle

Func _CalcPathLength($iStart, $aPositions, $iLastCity)
    $g_aAltCost = $g_aCurrentCost
    Local $iSum = $g_aCurrentCost[$iStart]

    For $cc = $iStart To $iLastCity - 1
        $iSum += getDistance($aPositions[$g_aAltOrder[$cc]], $aPositions[$g_aAltOrder[$cc + 1]])
        $g_aAltCost[$cc + 1] = $iSum ; store cumulative sum at legs endpoint
    Next
    $g_aCostDiff = $g_aAltCost[$iLastCity] - $g_aCurrentCost[$iLastCity] ; new - previous result

    Return $g_aAltCost[$iLastCity]  ; total cost
EndFunc   ;==>_CalcPathLength

Func _ScreenOut($iTempstep, $iInitCost, $iTempsteps, $dTemperat, $iSwap, $iLowestCost, $iAbsImp, $iSwapStep)
    ConsoleWrite("Simulated Annealing. Initial Cost: " & $iInitCost & @CRLF)
    ConsoleWrite("Step: " & $iTempstep & " of " & $iTempsteps & "; Temperature: " & $dTemperat & @CRLF)
    ConsoleWrite("Executed Swaps: " & $iSwap & "; lowest cost: " & $iLowestCost & @CRLF)
    ConsoleWrite("Total Improvements: " & $iAbsImp & "; Improvements this step: " & $iSwapStep & @CRLF & @CRLF)
EndFunc   ;==>_ScreenOut

Func getDistance($sStart, $sTarget)
    Local $aDist[9]

    ; If the start and destination are the same, the distance is 1
    If StringCompare($sStart, $sTarget) = 0 Then Return 1

    Local $aTmp1 = getArrayFromCoordString($sStart), $aTmp2 = getArrayFromCoordString($sTarget)
    Local $x1 = Int($aTmp1[0][0]), $y1 = Int($aTmp1[0][1]), $r1 = Int($aTmp1[0][2])
    Local $x2 = Int($aTmp2[0][0]), $y2 = Int($aTmp2[0][1]), $r2 = Int($aTmp2[0][2])

    $aDist[0] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2 - $iMapWidth) & ':' & ($y2 - $iMapHeight) & ':' & ($r2))
    $aDist[1] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2 - $iMapWidth) & ':' & ($y2) & ':' & ($r2))
    $aDist[2] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2 - $iMapWidth) & ':' & ($y2 + $iMapHeight) & ':' & ($r2))
    $aDist[3] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2) & ':' & ($y2 - $iMapHeight) & ':' & ($r2))
    $aDist[4] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2) & ':' & ($y2) & ':' & ($r2))
    $aDist[5] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2) & ':' & ($y2 + $iMapHeight) & ':' & ($r2))
    $aDist[6] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2 + $iMapWidth) & ':' & ($y2 - $iMapHeight) & ':' & ($r2))
    $aDist[7] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2 + $iMapWidth) & ':' & ($y2) & ':' & ($r2))
    $aDist[8] = getDistanceWithBorder($x1 & ':' & $y1 & ':' & $r1, ($x2 + $iMapWidth) & ':' & ($y2 + $iMapHeight) & ':' & ($r2))

    Return _ArrayMin($aDist)    ; NOTE: a function for this exists
EndFunc   ;==>getDistance

Func getDistanceWithBorder($sStart, $sTarget)
    Local $aTmp1 = StringSplit($sStart, ':', 2), $aTmp2 = StringSplit($sTarget, ':', 2)

    Local $x1 = Int($aTmp1[0]), $y1 = Int($aTmp1[1]), $r1 = Int($aTmp1[2])
    Local $x2 = Int($aTmp2[0]), $y2 = Int($aTmp2[1]), $r2 = Int($aTmp2[2])

    Local $ax = ($x1 - 1) * $iMapRoot + Mod($r1 - 1, $iMapRoot)
    Local $ay = ($y1 - 1) * $iMapRoot + Int(($r1 - 1) / $iMapRoot)
    Local $bx = ($x2 - 1) * $iMapRoot + Mod($r2 - 1, $iMapRoot)
    Local $by = ($y2 - 1) * $iMapRoot + Int(($r2 - 1) / $iMapRoot)

    Local $iDist = _Min(Abs($ax - $bx), Abs($ay - $by)) ; NOTE: a function for this exists

    $ax += $ax > $bx ? -$iDist : $iDist
    $ay += $ay > $by ? -$iDist : $iDist

    Return $iDist + Abs($ax - $bx) + Abs($ay - $by)
EndFunc   ;==>getDistanceWithBorder

Func getArrayFromCoordString($sString)
    Local $aTmp1 = StringSplit($sString, ':', 2)
    Local $aCoord[1][3] = [[$aTmp1[0], $aTmp1[1], $aTmp1[2]]]

    Return $aCoord
EndFunc   ;==>getArrayFromCoordString

Func _GetRandomIndexExcludeArray(ByRef $excludedIndices, $iMaxPos)
    Local $iIndex
    Do
        $iIndex = Random(0, $iMaxPos, 1)
    Until _ArraySearch($excludedIndices, $iIndex) < 0

    Return $iIndex
EndFunc   ;==>_GetRandomIndexExcludeArray

Func _EarlyOut()
    $bEarlyOut = True
EndFunc   ;==>_EarlyOut

Func DrawMap($aInputArray, $sStartCoordinate, $aBestRoute, $sEndCoordinate)
    Local $iGridSize = 20
    Local $iGuiWidth = 900
    Local $iGuiHeight = 900
    Local $iLineSpacing = $iGuiWidth / $iGridSize ; Berechnen des Abstands zwischen den Linien

    ; GDI+ initialisieren
    _GDIPlus_Startup()

    ; GUI erstellen
    Local $hGUI = GUICreate("Map Visualization", $iGuiWidth, $iGuiHeight)
    GUISetState(@SW_SHOW)

    ; Grafikobjekt erstellen
    Local $hGraphic = _GDIPlus_GraphicsCreateFromHWND($hGUI)
    Local $hBrushOrange = _GDIPlus_BrushCreateSolid(0xFFFFA500) ; Orange
    Local $hBrushRed = _GDIPlus_BrushCreateSolid(0xFFFF0000) ; Rot
    Local $hBrushBlack = _GDIPlus_BrushCreateSolid(0xFF000000) ; Schwarz
    Local $hBrushGrey = _GDIPlus_BrushCreateSolid(0xFF008000) ; Grau
    Local $hPen = _GDIPlus_PenCreate(0xFF000000, 1) ; Schwarzer Stift mit einer Breite von 1 für das Gitter

    ; Arrays mit 2D-Koordinaten erstellen
    Local $aInputArray2D[0]
    Local $aBestRoute2D[0]

    For $i = 0 To UBound($aInputArray) - 1
        _ArrayAdd($aInputArray2D, convertCoordTo2D($aInputArray[$i]))
    Next

    For $i = 2 To UBound($aBestRoute) - 1
        _ArrayAdd($aBestRoute2D, convertCoordTo2D($aBestRoute[$i]))
    Next

    Local $sMiddle2D = $iGridSize / 2
    Local $aStartCoordinate2D = StringSplit(convertCoordTo2D($sStartCoordinate), ':', 2)
    Local $aEndCoordinate2D = StringSplit(convertCoordTo2D($sEndCoordinate), ':', 2)
    Local $iXDifference = $aStartCoordinate2D[0] - $sMiddle2D
    Local $iYDifference = $aStartCoordinate2D[1] - $sMiddle2D

    For $i = 1 To $iMapWidth * $iMapRoot
        For $j = 1 To $iMapHeight * $iMapRoot
            ; Überprüfen Sie, ob die Koordinate in der besten Route ist
            If _ArraySearch($aBestRoute2D, $i & ":" & $j) >= 0 Then
                Local $iRouteIndex = _ArraySearch($aBestRoute2D, $i & ":" & $j)
                If $iRouteIndex >= 1 Then ; Beachten Sie den Index 1, um den ersten Zielpunkt einzubeziehen
                    _GDIPlus_GraphicsFillRect($hGraphic, ($i - 1 - $iXDifference) * $iLineSpacing, ($j - 1 - $iYDifference) * $iLineSpacing, $iLineSpacing, $iLineSpacing, $hBrushRed)
                    ; Beschriftung mit der Reihenfolge hinzufügen
                    _GDIPlus_GraphicsDrawString($hGraphic, $iRouteIndex & "", ($i - 1 - $iXDifference) * $iLineSpacing + 5, ($j - 1 - $iYDifference) * $iLineSpacing + 5, "Arial", 10, 0, 0xFFFFFFFF)
                EndIf
            ElseIf _ArraySearch($aInputArray2D, $i & ":" & $j) >= 0 Then
;~              ConsoleWrite("Zeichnen aus InputArray:" & @CRLF & $i & ":" & $j & " | " & $aInputArray[_ArraySearch($aInputArray2D, $i & ":" & $j)] & @CRLF)
                ; Koordinate im InputArray, aber nicht in der besten Route
                _GDIPlus_GraphicsFillRect($hGraphic, ($i - 1 - $iXDifference) * $iLineSpacing, ($j - 1 - $iYDifference) * $iLineSpacing, $iLineSpacing, $iLineSpacing, $hBrushOrange)
            EndIf

            ; Endpunkt zeichnen, wenn er nicht die Start-Koordinate ist
            If Not _2DCoordArraysEqual($aStartCoordinate2D, $aEndCoordinate2D) And _2DCoordStringsEqual($i & ":" & $j, convertCoordTo2D($sEndCoordinate)) Then
                _GDIPlus_GraphicsFillRect($hGraphic, ($i - 1 - $iXDifference) * $iLineSpacing, ($j - 1 - $iYDifference) * $iLineSpacing, $iLineSpacing, $iLineSpacing, $hBrushGrey)
                    ; "FIN" in die Koordinaten schreiben
                _GDIPlus_GraphicsDrawString($hGraphic, "FIN", ($i - 1 - $iXDifference) * $iLineSpacing + 5, ($j - 1 - $iYDifference) * $iLineSpacing + 5, "Arial", 10, 0, 0xFFFFFFFF)
            EndIf
        Next
    Next

    ; Startpunkt zeichnen und die Länge des Lösung angebe
    _GDIPlus_GraphicsFillRect($hGraphic, ($sMiddle2D - 1) * $iLineSpacing, ($sMiddle2D - 1) * $iLineSpacing, $iLineSpacing, $iLineSpacing, $hBrushBlack)
    _GDIPlus_GraphicsDrawString($hGraphic, $aBestRoute[1], ($sMiddle2D - 1) * $iLineSpacing + 10, ($sMiddle2D - 1) * $iLineSpacing + 15, "Arial", 12, 0, 0xFFFFFFFF)

    ; Gitter zeichnen
    For $i = 1 To $iGridSize
        For $j = 1 To $iGridSize
            _GDIPlus_GraphicsDrawRect($hGraphic, ($i - 1) * $iLineSpacing, ($j - 1) * $iLineSpacing, $iLineSpacing, $iLineSpacing, $hPen)
        Next
    Next

    ; GUI anzeigen
    GUISetState(@SW_SHOW, $hGUI)

    ; Loop bis der Benutzer die Anwendung schließt.
    Do
    Until GUIGetMsg() = $GUI_EVENT_CLOSE

    ; Ressourcen aufräumen
    CleanupResources($hBrushOrange, $hBrushRed, $hBrushBlack, $hPen, $hGraphic, $hGUI)
EndFunc

Func CleanupResources($hBrushOrange, $hBrushRed, $hBrushBlack, $hPen, $hGraphic, $hGUI)
    _GDIPlus_BrushDispose($hBrushOrange)
    _GDIPlus_BrushDispose($hBrushRed)
    _GDIPlus_BrushDispose($hBrushBlack)
    _GDIPlus_PenDispose($hPen)
    _GDIPlus_GraphicsDispose($hGraphic)
    _GDIPlus_Shutdown()
    GUIDelete($hGUI)
EndFunc

Func convertCoordTo2D($sCoord)
    $aCoord = getArrayFromCoordString($sCoord)

    Local $ax = ($aCoord[0][0] - 1) * $iMapRoot + Mod($aCoord[0][2] - 1, $iMapRoot) + 1
    Local $ay = ($aCoord[0][1] - 1) * $iMapRoot + Int(($aCoord[0][2] - 1)/$iMapRoot) + 1

    Return $ax & ":" & $ay
EndFunc

Func _2DCoordStringsEqual($coord1, $coord2)
    ; Zerlegen Sie die Koordinaten in Arrays
    Local $aCoord1 = StringSplit($coord1, ':')
    Local $aCoord2 = StringSplit($coord2, ':')

    ; Überprüfen Sie die Anzahl der Elemente in beiden Arrays
    If UBound($aCoord1) <> UBound($aCoord2) Then
        Return False
    EndIf

    ; Vergleichen Sie die Werte in den Arrays
    For $i = 1 To UBound($aCoord1) - 1
        If $aCoord1[$i] <> $aCoord2[$i] Then
            Return False
        EndIf
    Next

    ; Wenn alle Vergleiche erfolgreich sind, geben Sie True zurück
    Return True
EndFunc

Func _2DCoordArraysEqual($coord1, $coord2)
    ; Überprüfen, ob beide Parameter Arrays sind
    If IsArray($coord1) And IsArray($coord2) Then
        ; Überprüfen Sie die Anzahl der Elemente in beiden Arrays
        If UBound($coord1) <> UBound($coord2) Then
            Return False
        EndIf

        ; Vergleichen Sie die Werte in den Arrays
        For $i = 0 To UBound($coord1) - 1
            If $coord1[$i] <> $coord2[$i] Then
                Return False
            EndIf
        Next

        ; Wenn alle Vergleiche erfolgreich sind, geben Sie True zurück
        Return True
    EndIf

    ; Wenn keiner der obigen Fälle zutrifft, geben Sie False zurück
    Return False
EndFunc

 

 

Edited by Acanis
Link to comment
Share on other sites

Posted (edited)

In path searches through a subset of points more generally (for simulated annealing or any other time-consuming algorithm), it may be of significant advantage (speedwise, that is) to compute all point-to-point distances in advance, and store these in a single look-up reference (table or matrix). Here's a simple, generic example of doing just that using matrices:

Spoiler
; this example shows how to generate a distance matrix from a list of points
#include ".\Eigen4AutoIt.au3"

Global $totalPoints = 30
Global $dimensions = 3
Global $maxCoord = 100

_Eigen_StartUp()
_Eigen_RanSeed(0)   ; 0 = use current data/time values

; create a list of points with coordinates in the range 0 to $maxCoord
; we can alternatively read these in from file, AutoIt array, excel worksheet, etc.
$points=_Eigen_CreateMatrix_Random($totalPoints, $dimensions)   ; initial range: -1 to +1
_Eigen_CwiseUnaryOp_InPlace($points,"abs")  ; take absolute values
_Eigen_CwiseScalarOp_InPlace($points, "*", $maxCoord)   ; multiply by range

; show off these amazing points!
_Eigen_MatrixDisplay($points, "our points")

$tstart=TimerInit()

; create a few buffers
$buffer=_Eigen_CloneMatrix($points, False)  ; to collect squared differences per axis
$vector =_Eigen_CreateVector($totalPoints)  ; for sum and sqrt

; our point-to-point distances will be stored in this square matrix
; the diagonal will be zero, and upper/lower triangular parts will mirror each other
$distances=_Eigen_CreateMatrix($totalPoints, $totalPoints)

;____________________________
; process all distances w.r.t. each point, per point (pc)
For $pc=0 to $totalPoints-1

    ; subtract the current point's coordinates from all point coordinates, per coordinate
    _Eigen_CwiseBinaryOp_RowwiseRow($points, $pc, "-", $points, $buffer)    ; store differences per coordinate in the buffer

    ; square all differences
    _Eigen_CwiseUnaryOp_InPlace($buffer, "square")

    ; sum the squared diffs per row (point) in temp vector
    _Eigen_GetSum_Rowwise($buffer, $vector)

    ; store sqrt per row (point) in temp vector
    _Eigen_CwiseUnaryOp_InPlace($vector, "sqrt")

    ; store all distances for the current point
    _Eigen_Copy_Acol_ToBcol($vector, $distances, 0, $pc)    ; a ColVector has one column (with index 0)
Next

_Eigen_ReleaseMatrix($buffer)   ; no longer needed
_Eigen_ReleaseMatrix($vector)   ; ditto
$tstart=round(TimerDiff($tstart)/1000,3)

; show final result
_Eigen_MatrixDisplay($distances, "all point-to point distances; time = " & $tstart)
; the distance between any point1/2 can hereafter be retrieved with:
; $dist = _EigenReadMatrixValue($distances, $point1, $point2)

_Eigen_CleanUp()

 

This example is, however, far from optimised. One improvement would be to get rid of the final column vector copy to the output matrix, and instead repeatedly re-map a column in the final output as our vector to directly collect results in.

Spoiler
#include ".\Eigen4AutoIt.au3"

Global $totalPoints = 30
Global $dimensions = 3
Global $maxCoord = 100

_Eigen_StartUp()
_Eigen_RanSeed(0)

$points=_Eigen_CreateMatrix_Random($totalPoints, $dimensions)
_Eigen_CwiseUnaryOp_InPlace($points,"abs")
_Eigen_CwiseScalarOp_InPlace($points, "*", $maxCoord)

$tstart=TimerInit()
$buffer=_Eigen_CloneMatrix($points, False)
$distances=_Eigen_CreateMatrix($totalPoints, $totalPoints)

For $pc=0 to $totalPoints-1
    _Eigen_CwiseBinaryOp_RowwiseRow($points, $pc, "-", $points, $buffer)
    _Eigen_CwiseUnaryOp_InPlace($buffer, "square")

    ; RE-MAP one column of our output matrix as storage vector
    $vector=_Eigen_Remap_MatrixCols ($distances, $pc, 1)
    _Eigen_GetSum_Rowwise($buffer, $vector) ; writes directly to output

    _Eigen_CwiseUnaryOp_InPlace($vector, "sqrt")
    _Eigen_ReleaseMatrix($vector)   ; this mapping is no longer needed
Next
_Eigen_ReleaseMatrix($buffer)

$tstart=round(TimerDiff($tstart)/1000,3)
_Eigen_MatrixDisplay($distances, "all point-to point distances; time = " & $tstart)
_Eigen_CleanUp()

 

This is faster, but still evaluates each point individually. A more efficient approach would be to create separate matrices for each coordinate dimension, and perform each math operation once per dimension only, collecting final results in the first dimension's container. Note that this much faster solution requires more memory.

Spoiler
#include ".\Eigen4AutoIt.au3"

Global $totalPoints = 30
Global $dimensions = 3
Global $maxCoord = 100

_Eigen_StartUp()
_Eigen_RanSeed(0)

$points=_Eigen_CreateMatrix_Random($totalPoints, $dimensions)
_Eigen_CwiseUnaryOp_InPlace($points,"abs")
_Eigen_CwiseScalarOp_InPlace($points, "*", $maxCoord)

$tstart=TimerInit()
Global $buffer1[$dimensions]
Global $buffer2[$dimensions]

For $dc=0 to $dimensions-1
    $vector=_Eigen_Remap_MatrixCols ($points, $dc, 1)
    $buffer1[$dc]=_Eigen_CreateMatrix_FromA_Tiled($vector, 1, $totalPoints)
    $buffer2[$dc]=_Eigen_CreateMatrix($totalPoints, $totalPoints)
    _Eigen_ReleaseMatrix($vector)   ; this mapping is no longer needed
Next

; duplicate same coord value in an entire column of buffer2[dimension]
For $dc=0 to $dimensions-1
    For $pc=0 to $totalPoints-1
        _Eigen_SetConstant_Col($buffer2[$dc],$pc, _Eigen_ReadMatrixValue($points,$pc,$dc))
    Next
Next

; perform ONE subtraction and ONE sqr per dimension
_Eigen_CwiseBinaryOp_InPlace($buffer1[0], "-", $buffer2[0])
_Eigen_CwiseUnaryOp_InPlace($buffer1[0], "square")
_Eigen_ReleaseMatrix($buffer2[0])

; add all results for higher dimensions to the first
For $dc=1 to $dimensions-1
    _Eigen_CwiseBinaryOp_InPlace($buffer1[$dc], "-", $buffer2[$dc])
    _Eigen_CwiseUnaryOp_InPlace($buffer1[$dc], "square")
    _Eigen_CwiseBinaryOp_InPlace($buffer1[0], "+", $buffer1[$dc])

    _Eigen_ReleaseMatrix($buffer1[$dc]) ; done with these
    _Eigen_ReleaseMatrix($buffer2[$dc])
Next

; perform ONE sqrt on the first buffer
_Eigen_CwiseUnaryOp_InPlace($buffer1[0], "sqrt")

$tstart=round(TimerDiff($tstart)/1000,3)
_Eigen_MatrixDisplay($buffer1[0], "all point-to point distances; time = " & $tstart)
_Eigen_CleanUp()

 

 

Edited by RTFC
more examples added
Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share

×
×
  • Create New...