Public Tablo As Variant
Option Base 1
Sub Lister_Les_Permutations()
'Tablo = Array("", "33", "66", "55", "23")
'Si Option Base 1
Tablo = Array("33", "66", "55", "23")
GenPermutations UBound(Tablo)
End Sub
Sub GenPermutations(ByVal N As Long)
' [url=http://www.xtremevbtalk.com/showthread.php?t=168296]Lotto Algorithms - Permutations, Combinations - Xtreme Visual Basic Talk[/url]
' "Johnson-Trotter" VB6 implementation by MathImagics (Dec 2004)
' Each permutation is obtained from the previous by
' swapping just ONE pair of adjacent items.
'
Dim Item() As Long ' items to permute
Dim Link() As Long ' 0 = link left, 1 = right
Dim j As Long
Dim K As Long, kSpot As Long ' largest mobile K and its position
Dim P As Long, pSpot As Long ' iterator value P, its position
Dim mobile As Boolean ' "mobility" test flag
Dim kLink As Long
'
' 0. Setup initial state
'
ReDim Item(N), Link(N)
For j = 1 To N
Item(j) = j
Next
i = 0 'adaptation
Do
'
' 1. report current permutation
'
' Debug.Print Item(1);
' For j = 2 To N: Debug.Print ","; Item(j);: Next
' Debug.Print
'-----début adaptation
i = i + 1
For j = 1 To N
Cells(i, j) = Tablo(Item(j)) ': i = i + 1
Next j
'-----fin adaptation
'
' 2. select "mobile" position with highest value
'
K = 0
pSpot = 0
Do While pSpot < N
pSpot = pSpot + 1
P = Item(pSpot)
mobile = False
If Link(pSpot) = 0 Then
If pSpot > 1 Then
If Item(pSpot - 1) < P Then mobile = True
End If
ElseIf pSpot < N Then
If Item(pSpot + 1) < P Then mobile = True
End If
If mobile Then
If P > K Then
K = P
kSpot = pSpot
If K = N Then Exit Do ' look no further
End If
End If
Loop
If K = 0 Then Exit Do ' all done!
'
' 3. Swap item kSpot with "neighbour"
'
kLink = Link(kSpot)
If kLink Then
Item(kSpot) = Item(kSpot + 1): Link(kSpot) = Link(kSpot + 1)
Item(kSpot + 1) = K: Link(kSpot + 1) = 1
Else
Item(kSpot) = Item(kSpot - 1): Link(kSpot) = Link(kSpot - 1)
Item(kSpot - 1) = K: Link(kSpot - 1) = 0
End If
'
' 4. Toggle Links for any items > K
'
For pSpot = 1 To N
If Item(pSpot) > K Then Link(pSpot) = 1 - Link(pSpot)
Next
Loop
End Sub
,
