[AccessD] Help discovering algorithm

Arthur,

Found on the Net. Requires 1 Textbox & 1 Listbox
Start with ABCD first :)
----------------------------------------------------------------
Private m_asPermutations() As String ' Array to hold results


Public Function Permutations(ByVal S As String) As String()
    Dim i As Long, N As Long
    Dim aStrs() As String


    ' Prepare array for first element
    ReDim m_asPermutations(0)


    ' Create array of the characters in the string
    N = 1
    ReDim aStrs(1 To Len(S))
    For i = 1 To Len(S)
        aStrs(i) = Mid(S, i, 1)
        N = N * i
    Next
    ReDim m_asPermutations(N - 1)
    Call Iterate(aStrs)


    Permutations = m_asPermutations
End Function


Private Sub Iterate(aStrs)
    Dim i As Integer, j As Integer
    Static NotFirstIteration As Boolean
    Static N As Long
    Static L As Integer
    Static sPerm As String ' Holder for result string
    Static RecLev As Integer ' Recursion level
    Static aaStrs() As Variant
    Static aIndexes() As Integer ' For keeping track of


    ' Code run first iteration only
    If Not NotFirstIteration Then
        L = UBound(aStrs)
        sPerm = String(L, vbNullChar)
        ReDim aaStrs(1 To L)
        ReDim aIndexes(1 To L)
        NotFirstIteration = True
    End If


    RecLev = RecLev + 1 ' Increment recursion level
    aaStrs(RecLev) = aStrs


    For aIndexes(RecLev) = 1 To L - RecLev + 1
        i = aIndexes(RecLev)
        Mid(sPerm, RecLev) = aaStrs(RecLev)(i)
        ' if at lowest level, then ...
        If RecLev = L Then
            ' add it to result array
            m_asPermutations(N) = sPerm
            N = N + 1
        Else
            ' Call Iterate recursively
            ReDim aStrs(1 To L - RecLev)
            For j = 1 To L - RecLev + 1
                If j < i Then
                    aStrs(j) = aaStrs(RecLev)(j)
                ElseIf j > i Then
                    aStrs(j - 1) = aaStrs(RecLev)(j)
                End If
            Next
            Call Iterate(aStrs)
            RecLev = RecLev - 1
        End If
    Next
End Sub

Michael R. Mattys
MapPoint & Access Dev
www.mattysconsulting.com

----- Original Message ----- 
From: <artful at rogers.com>
To: "AccessD at databaseadvisors. com" <AccessD at databaseadvisors.com>
Sent: Friday, March 02, 2007 4:40 PM
Subject: [AccessD] Help discovering algorithm


> For some reason, I cannot deduce what I'm doing when I work out this 
> algorithm. I can work it out by hand, as the following table illustrates, 
> but I am having big problems generalizing what I'm doing to account for a 
> string of inderminate length.
>
> Assume a string of inderminate length. I want to produce all variations of 
> said string. What is so far obvious is that the number of variations is 
> equal to the factorial of the string. I can generate them by hand but I 
> cannot seem to be able to deduce the algorithm that I'm using. The 
> following table uses a 5-character string and presents only the variations 
> that leave the first character alone (for brevity). Obviously to generate 
> the remaining solutions I just rotate the string and repeat.
>
> The first column in the table shows the string's variants. The second 
> column does the same, but uses numbers indicating the the sequence of the 
> characters with relation to the original string. Here is the table:
>
> ABCDE12345
> ABCED12354
> ABDCE12435
> ABDEC12453
> ABECD12534
> ABEDC12543
> ACBDE13245
> ACBED13254
> ACDBE13425
> ACDEB13452
> ACEBD13524
> ACEDB13542
> ADBCE14235
> ADBEC14253
> ADCBE14325
> ADCEB14352
> ADEBC14523
> ADECB14532
> AEBCD15234
> AEBDC15243
> AECBD15324
> AECDB15342
> AEDBC15423
> AEDCB15432
>
>
> Please help me realize what I'm doing here. I have a function that works 
> called Transpose(s as String, i as Integer, j as Integer), which (gasp) 
> will transpose the letters in the string that are located at positions i 
> and j. What I need is the algorithm that I'm using to walk through the 
> string and generate the variations.
>
> Any insights much appreciated.
>
> Arthur
> -- 
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com