Hi Dennis,
der wichtigste Schritt wäre die Permutationen erst mal alle generieren zu können.
Dazu kann man sich z.B. eine Klasse schreiben:
'//////////////////////////////////////////////////////////
'// Klasse: CPermutation
'//////////////////////////////////////////////////////////
Option Explicit
'#####################################################################################
Private Const C_ERR_INVALID_ARGUMENT As Long = 5&
'#####################################################################################
Dim m_avdblCurrentPerm As Variant ' aktuelle Permutation (ggf. gleich Empty)
Dim m_dblCount As Double ' Anzahl der Elemente
'#####################################################################################
'## PRIVATE (Konstruktor / Destruktor)
'#####################################################################################
Private Sub Class_Initialize()
m_avdblCurrentPerm = Empty
m_dblCount = 0
End Sub
Private Sub Class_Terminate()
On Error Resume Next
Erase m_avdblCurrentPerm
End Sub
'#####################################################################################
'## PUBLIC
'#####################################################################################
'//////////////////////////////////////////////////////////
'// aktuelle Permutation (ggf. gleich Empty)
Public Property Get Current() As Variant
Current = m_avdblCurrentPerm
End Property
'//////////////////////////////////////////////////////////
'// Erste Permutation
Public Sub Init(ByVal n As Double)
If n < 1 Then
Err.Raise C_ERR_INVALID_ARGUMENT
Exit Sub
End If
Dim i As Double
ReDim m_avdblCurrentPerm(0 To n - 1) As Double
m_dblCount = n
For i = 0 To n - 1
m_avdblCurrentPerm(i) = i
Next
End Sub
'//////////////////////////////////////////////////////////
'// nächste Permutation
Public Function MoveNext() As Boolean
If IsEmpty(m_avdblCurrentPerm) Then
Me.Init m_dblCount
Exit Function
End If
Dim i#, j#
For i = m_dblCount - 2 To 0 Step -1
' linker Index kleiner als der rechte Index?
If m_avdblCurrentPerm(i) < m_avdblCurrentPerm(i + 1) Then Exit For
Next
If i < 0 Then
' keine Permutation mehr möglich
Erase m_avdblCurrentPerm
m_avdblCurrentPerm = Empty
MoveNext = False
Exit Function
End If
For j = m_dblCount - 1 To 0 Step -1
' rechter Index größer als der linke Index ?
If m_avdblCurrentPerm(j) > m_avdblCurrentPerm(i) Then Exit For
Next
Call Swap(i, j)
Call Reverse(i + 1, m_dblCount - 1)
MoveNext = True
End Function
'//////////////////////////////////////////////////////////
'// Permutation als Zeichenkette
Public Function ToString() As String
Dim i#
If Not IsEmpty(m_avdblCurrentPerm) Then
For i = 0 To m_dblCount - 1
ToString = ToString & IIf(ToString <> "", " ", "") & m_avdblCurrentPerm(i)
Next
Else
ToString = "<EOP>"
End If
End Function
'#####################################################################################
'## PRIVATE (Hilfsfunktionen)
'#####################################################################################
'//////////////////////////////////////////////////////////
'// Vertauscht zwei Elemente miteinander
Private Sub Swap(Idx1 As Double, Idx2 As Double)
Dim t As Double
t = m_avdblCurrentPerm(Idx1)
m_avdblCurrentPerm(Idx1) = m_avdblCurrentPerm(Idx2)
m_avdblCurrentPerm(Idx2) = t
End Sub
'//////////////////////////////////////////////////////////
'// Kehrt die Reihenfolge von Elementen um
'// (Bereich wählbar)
Private Sub Reverse(StartIdx As Double, EndIdx As Double)
Dim i#, j#
Dim t#
i = StartIdx
j = EndIdx
While i < j
t = m_avdblCurrentPerm(i)
m_avdblCurrentPerm(i) = m_avdblCurrentPerm(j)
m_avdblCurrentPerm(j) = t
i = i + 1
j = j - 1
Wend
End Sub
Mit Double kann man z.B. mit bis zu 170 Elementen arbeiten (Pi mal Daumen).
Beispiel sähe dann so aus:
' in einem Modul
Option Explicit
Sub testaufruf()
Dim o As CPermutation
Dim c() As Double
Dim n As Double
Set o = New CPermutation
o.Init 4 '4 Elemente = 4! = 4*3*2*1 = 24 Permutationen
Do
n = n + 1 ' Anzahl der Permutationen mitzählen
' aktuelle Permutation
'c = o.Current
' Ausgabe der aktuellen Permutation (sollte mit 9 Elementen oder mehr nicht mehr ausgeführt werden)
Debug.Print "[" & Format$(n, "000") & "] >> " & o.ToString
Loop While o.MoveNext
Debug.Print "Total: " & Format$(n, "#,##0")
Set o = Nothing
End Sub
Der nächste Schritt besteht dann darin für jede Kombination die Wegstrecke zu berechnen (Variable c). Von Permutation zu Permutation merkt man sich die kürzeste Weglänge und natürlich die entsprechende Permutation dazu.
Mit 10 Elementen (Bohrungen) wird das vorraussichtlich nen merkbares Weilchen an Rechenzeit beanspruchen. ;)
Gruß, Trägheit
|