I am looking for information on the permutation of an array. I have searched 
this website and have not found what I am looking for. There are many 
articles that will figure out all possible combinations of a string but they 
all return strings in which characters are repeated.
EG: 1234 will return 1224 etc. 

I am looking for information on how to only list combinations that use the 
characters in the string the same number of times that they are in the 
original string.

I did find an article at (http://www.vbi.org/Items/article.asp?id=133) that 
sounds promising but the link to download the source code 
(http://www.vbi.org/Items/link.asp?id=355) comes back with an error saying 
unable to connect.
All messages and emails to the various links on the vbi.org site have been 
returned as undeliverable.

Any help with the logic on how to code the above or any information on the 
vbi.org code sample is greatly appreciated

"Gary Pollard" <GaryPollard@discussions.microsoft.com> wrote
> I am looking for information on the permutation of an array. I have searched
> this website and have not found what I am looking for. There are many
> articles that will figure out all possible combinations of a string but they
> all return strings in which characters are repeated.
> EG: 1234 will return 1224 etc.

We  had someone here at the start of last month looking for something
very similar.  You can view the whole thread if you want to see how it
progressed (from what you state above) to something of a scrabble
shuffler.  (Which is about what you are asking for....)

One solution can be found here:
http://groups.google.com/group/microsoft.public.vb.general.discussion/msg/de54b7c3ed172019?hl=en

HTH
LFS

"Gary Pollard" <GaryPollard@discussions.microsoft.com> wrote in message 
news:2F6C43D1-6648-45FA-9FB2-3EF71143DE4F@microsoft.com...
> I am looking for information on the permutation of an array. I have 
> searched
> this website and have not found what I am looking for. There are many
> articles that will figure out all possible combinations of a string but 
> they
> all return strings in which characters are repeated.
> EG: 1234 will return 1224 etc.
>
> I am looking for information on how to only list combinations that use the
> characters in the string the same number of times that they are in the
> original string.
>
> I did find an article at (http://www.vbi.org/Items/article.asp?id=133) 
> that
> sounds promising but the link to download the source code
> (http://www.vbi.org/Items/link.asp?id=355) comes back with an error saying
> unable to connect.
> All messages and emails to the various links on the vbi.org site have been
> returned as undeliverable.
>
> Any help with the logic on how to code the above or any information on the
> vbi.org code sample is greatly appreciated
>

Not really sure what you want...the code for the example on the article you 
mention is listed directly in the article.  All that is required is to call 
the code.

Assuming that your issue was in not understanding how to implement the 
functions presented in the article, I went ahead and threw together a quick 
example.  Simply start up VB, start a new standard exe project and place the 
following code in the form that is created by default...then run the app.

Option Explicit

Private lblCaption As VB.Label
Private txtNumElements As VB.TextBox
Private lstPermutations As VB.ListBox
Private WithEvents cmdChars As VB.CommandButton
Private WithEvents cmdNums As VB.CommandButton

Private Sub Form_Load()

    Me.Visible = False

    Set lblCaption = Me.Controls.Add("VB.Label", "lblCaption", Me)
    Set txtNumElements = Me.Controls.Add("VB.TextBox", "txtNumElements", Me)
    Set lstPermutations = Me.Controls.Add("VB.ListBox", "lstPermutations", 
Me)
    Set cmdChars = Me.Controls.Add("VB.CommandButton", "cmdChars", Me)
    Set cmdNums = Me.Controls.Add("VB.CommandButton", "cmdNums", Me)

    lblCaption.Move 120, 180, 2115, 255
    lblCaption.Caption = "Number of elements:"
    lblCaption.Visible = True

    txtNumElements.Move 2400, 180, 3255, 315
    txtNumElements.Text = "0"
    txtNumElements.Visible = True

    lstPermutations.Move 120, 660, 5535, 6300
    lstPermutations.Clear
    lstPermutations.Visible = True

    cmdChars.Move 5880, 180, 1215, 495
    cmdChars.Caption = "Permutate characters"
    cmdChars.Visible = True

    cmdNums.Move 5880, 840, 1215, 495
    cmdNums.Caption = "Permutate numbers"
    cmdNums.Visible = True

    Me.Width = 7530
    Me.Height = 7815

    Me.Visible = True

End Sub

Private Sub cmdNums_Click()
    DoPermutations False
End Sub

Private Sub cmdChars_Click()
    DoPermutations True
End Sub

Private Sub DoPermutations(Optional blnAsChars As Boolean = False)
Dim i As Long
Dim lngNumElems As Long
Dim Elems() As Long
Dim Order() As Long
Dim Orders As New Collection
Dim Item As Variant
Dim strTemp As String

    lstPermutations.Clear

    lngNumElems = Val(txtNumElements.Text)
    ReDim Elems(1 To lngNumElems)
    ReDim Order(1 To lngNumElems)
    For i = 1 To lngNumElems
        If blnAsChars Then
            Elems(i) = 96 + i
        Else
            Elems(i) = i
        End If
    Next

    Permutate lngNumElems, Elems(), Order(), Orders

    For Each Item In Orders
        strTemp = vbNullString
        For i = LBound(Item) To UBound(Item)
            If blnAsChars Then
                strTemp = strTemp & Chr(Item(i))
            Else
                strTemp = strTemp & Item(i)
            End If
        Next
        lstPermutations.AddItem strTemp
    Next

End Sub

Public Sub Permutate( _
   ByVal ArrayCount As Long, _
   ByRef Elements() As Long, _
   ByRef Order() As Long, _
   ByRef Orders As Collection)

Dim Position   As Long
Dim Element    As Long
Dim i          As Long
Dim ArrayLen   As Long

   ' The length of the Elements array. We need this
   ' for our calculations later on.
   ArrayLen = (UBound(Elements) - LBound(Elements) + 1)

   ' Position in the Order array of the first element in
   ' the permutated arrays.
   '
   ' Example: Given the array(a,b,c,d), where we want to permutate
   ' (b,c,d), the position in the new array for the first element
   ' will be 2 (since (a) will take up the first position).
   ' Likewise, when we permutate (c,d), the position of the first
   ' element will be 3, since the first two spots are taken by
   ' (a,b).
   Position = ArrayCount - ArrayLen + 1

   If ArrayLen = 1 Then
      ' The most primitive array we will permutate.
      ' The result is the array itself, and the result
      ' is inserted in the last position of the Order array.
      Order(Position) = Elements(LBound(Elements))

      ' This Order is now complete, since the final element has
      ' been filled in.
      Orders.Add Order
   Else
      ' The permutation of Elements is each distinct Element
      ' + all permutations of the remaining elements.
      For i = LBound(Elements) To UBound(Elements)
         Element = Elements(i)
         Order(Position) = Element
         Permutate ArrayCount, RemoveFromArray(Elements, Element), Order, 
Orders
      Next i

   End If

End Sub

Public Function RemoveFromArray(ByRef Elements() As Long, ByVal Element As 
Long) As Long()
Dim NewArray() As Long
Dim i          As Long
Dim newi       As Long

   ' Will create a new array where Element has been left out.
   ReDim NewArray(LBound(Elements) To UBound(Elements) - 1)
   For i = LBound(Elements) To UBound(Elements)
      If Elements(i) <> Element Then
         newi = newi + 1
         NewArray(newi) = Elements(i)
      End If
   Next

   RemoveFromArray = NewArray

End Function
 

This works well if the number of character in the sting is 8  or less, 
processed a 8 character sting in about 1.5 minutes.
If I go to a 9 character string the project window goes blank and it appears 
that it is some kind of endless loop. I stopped it after 15 minutes. 
I am about to try Steve's solution.
Thanks for your input.
Gary


"Larry Serflaten" wrote:

> 
> "Gary Pollard" <GaryPollard@discussions.microsoft.com> wrote
> > I am looking for information on the permutation of an array. I have searched
> > this website and have not found what I am looking for. There are many
> > articles that will figure out all possible combinations of a string but they
> > all return strings in which characters are repeated.
> > EG: 1234 will return 1224 etc.
> 
> We  had someone here at the start of last month looking for something
> very similar.  You can view the whole thread if you want to see how it
> progressed (from what you state above) to something of a scrabble
> shuffler.  (Which is about what you are asking for....)
> 
> One solution can be found here:
> http://groups.google.com/group/microsoft.public.vb.general.discussion/msg/de54b7c3ed172019?hl=en
> 
> HTH
> LFS
> 
> 
> .
> 

Gary Pollard wrote:
> This works well if the number of character in the sting is 8  or less,
> processed a 8 character sting in about 1.5 minutes.
> If I go to a 9 character string the project window goes blank and it appears
> that it is some kind of endless loop. I stopped it after 15 minutes.


The following class only takes a few seconds (on an old computer) to 
write all permutations of a 9 character string to a file...

HTH


VERSION 1.0 CLASS
BEGIN
   MultiUse = -1  'True
   Persistable = 0  'NotPersistable
   DataBindingBehavior = 0  'vbNone
   DataSourceBehavior  = 0  'vbNone
   MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CPermutations"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Option Base 0

Private mnFF As Integer
Private msFileOut As String
Private msData As String
Private mnPositionArrayPointer As Integer
Private manPositionArray() As Integer
Private msPermutation As String

Public Sub Init(ByVal sData As String, ByVal sFileOut As String)
     msData = sData
     msFileOut = sFileOut
End Sub

Private Sub Permutations(ByVal nElement As Integer)

     Dim i As Integer

     mnPositionArrayPointer = mnPositionArrayPointer + 1
     manPositionArray(nElement) = mnPositionArrayPointer

     If mnPositionArrayPointer = Len(msData) Then
         msPermutation = ""
         For i = 0 To UBound(manPositionArray)
             msPermutation = msPermutation & Mid$(msData, 
manPositionArray(i), 1)
         Next i

         If Len(msPermutation) Then
             Print #mnFF, msPermutation
         End If
     Else
         For i = 0 To Len(msData) - 1
             If manPositionArray(i) = 0 Then Call Permutations(i)
         Next i
     End If

     mnPositionArrayPointer = mnPositionArrayPointer - 1
     manPositionArray(nElement) = 0

End Sub

Public Sub RecursivePermutations()

     mnPositionArrayPointer = -1

     ReDim manPositionArray(Len(msData) - 1)

     mnFF = FreeFile

     Open msFileOut For Output As #mnFF
     'Print #mnFF, "* Recursive Permutations for... " & msData

     Call Permutations(0)

     'Print #mnFF, "* Finished!"
     Close #mnFF

End Sub

"Gary Pollard" <GaryPollard@discussions.microsoft.com> wrote
> This works well if the number of character in the sting is 8  or less,
> processed a 8 character sting in about 1.5 minutes.
> If I go to a 9 character string the project window goes blank and it appears
> that it is some kind of endless loop. I stopped it after 15 minutes.
> I am about to try Steve's solution.
> Thanks for your input.
> Gary

The algorithm is a brute force method, it runs through ALL combinations
(and then some) to pick out those that match the criteria.  As you saw,
eventually, trying ALL combinations gets to be some very large numbers:

 (Use X letters in Y combinations to get Z unique results)
Use       in             to get
2               8             2
 3              81             6
 4            1024            24
 5           15625           120
 6          279936           720
 7         5764801          5040
 8   134217728         40320
 9      3486784401        362880
10    100000000000       3628800


While 8 letters only produces 134 million different iterations to check,
9 letters will yield 3.4 billion or about 26 times as many more.  If 8 letters
took 1.5 minutes, 9 should take about 39 minutes, if you care to wait.....

Obviously there should be another algorithm that would be better suited
for the job.  This has to have been solved before, it sounds so basic of
an idea, but I don't recall seeing the solution.  If you keep searching you
may turn up something....

Good luck!
LFS

"Steve" <sredmyer@sndirect.com> wrote in message 
news:i0i3bh$7ao$1@news.eternal-september.org...
>
> "Gary Pollard" <GaryPollard@discussions.microsoft.com> wrote in message 
> news:2F6C43D1-6648-45FA-9FB2-3EF71143DE4F@microsoft.com...
>> I am looking for information on the permutation of an array. I have 
>> searched
>> this website and have not found what I am looking for. There are many
>> articles that will figure out all possible combinations of a string but 
>> they
>> all return strings in which characters are repeated.
>> EG: 1234 will return 1224 etc.
>>
>> I am looking for information on how to only list combinations that use 
>> the
>> characters in the string the same number of times that they are in the
>> original string.
>>
>> I did find an article at (http://www.vbi.org/Items/article.asp?id=133) 
>> that
>> sounds promising but the link to download the source code
>> (http://www.vbi.org/Items/link.asp?id=355) comes back with an error 
>> saying
>> unable to connect.
>> All messages and emails to the various links on the vbi.org site have 
>> been
>> returned as undeliverable.
>>
>> Any help with the logic on how to code the above or any information on 
>> the
>> vbi.org code sample is greatly appreciated
>>
>
> Not really sure what you want...the code for the example on the article 
> you mention is listed directly in the article.  All that is required is to 
> call the code.
>
> Assuming that your issue was in not understanding how to implement the 
> functions presented in the article, I went ahead and threw together a 
> quick example.  Simply start up VB, start a new standard exe project and 
> place the following code in the form that is created by default...then run 
> the app.
>
> Option Explicit
>
> Private lblCaption As VB.Label
> Private txtNumElements As VB.TextBox
> Private lstPermutations As VB.ListBox
> Private WithEvents cmdChars As VB.CommandButton
> Private WithEvents cmdNums As VB.CommandButton
>
> Private Sub Form_Load()
>
>    Me.Visible = False
>
>    Set lblCaption = Me.Controls.Add("VB.Label", "lblCaption", Me)
>    Set txtNumElements = Me.Controls.Add("VB.TextBox", "txtNumElements", 
> Me)
>    Set lstPermutations = Me.Controls.Add("VB.ListBox", "lstPermutations", 
> Me)
>    Set cmdChars = Me.Controls.Add("VB.CommandButton", "cmdChars", Me)
>    Set cmdNums = Me.Controls.Add("VB.CommandButton", "cmdNums", Me)
>
>    lblCaption.Move 120, 180, 2115, 255
>    lblCaption.Caption = "Number of elements:"
>    lblCaption.Visible = True
>
>    txtNumElements.Move 2400, 180, 3255, 315
>    txtNumElements.Text = "0"
>    txtNumElements.Visible = True
>
>    lstPermutations.Move 120, 660, 5535, 6300
>    lstPermutations.Clear
>    lstPermutations.Visible = True
>
>    cmdChars.Move 5880, 180, 1215, 495
>    cmdChars.Caption = "Permutate characters"
>    cmdChars.Visible = True
>
>    cmdNums.Move 5880, 840, 1215, 495
>    cmdNums.Caption = "Permutate numbers"
>    cmdNums.Visible = True
>
>    Me.Width = 7530
>    Me.Height = 7815
>
>    Me.Visible = True
>
> End Sub
>
> Private Sub cmdNums_Click()
>    DoPermutations False
> End Sub
>
> Private Sub cmdChars_Click()
>    DoPermutations True
> End Sub
>
> Private Sub DoPermutations(Optional blnAsChars As Boolean = False)
> Dim i As Long
> Dim lngNumElems As Long
> Dim Elems() As Long
> Dim Order() As Long
> Dim Orders As New Collection
> Dim Item As Variant
> Dim strTemp As String
>
>    lstPermutations.Clear
>
>    lngNumElems = Val(txtNumElements.Text)
>    ReDim Elems(1 To lngNumElems)
>    ReDim Order(1 To lngNumElems)
>    For i = 1 To lngNumElems
>        If blnAsChars Then
>            Elems(i) = 96 + i
>        Else
>            Elems(i) = i
>        End If
>    Next
>
>    Permutate lngNumElems, Elems(), Order(), Orders
>
>    For Each Item In Orders
>        strTemp = vbNullString
>        For i = LBound(Item) To UBound(Item)
>            If blnAsChars Then
>                strTemp = strTemp & Chr(Item(i))
>            Else
>                strTemp = strTemp & Item(i)
>            End If
>        Next
>        lstPermutations.AddItem strTemp
>    Next
>
> End Sub
>
> Public Sub Permutate( _
>   ByVal ArrayCount As Long, _
>   ByRef Elements() As Long, _
>   ByRef Order() As Long, _
>   ByRef Orders As Collection)
>
> Dim Position   As Long
> Dim Element    As Long
> Dim i          As Long
> Dim ArrayLen   As Long
>
>   ' The length of the Elements array. We need this
>   ' for our calculations later on.
>   ArrayLen = (UBound(Elements) - LBound(Elements) + 1)
>
>   ' Position in the Order array of the first element in
>   ' the permutated arrays.
>   '
>   ' Example: Given the array(a,b,c,d), where we want to permutate
>   ' (b,c,d), the position in the new array for the first element
>   ' will be 2 (since (a) will take up the first position).
>   ' Likewise, when we permutate (c,d), the position of the first
>   ' element will be 3, since the first two spots are taken by
>   ' (a,b).
>   Position = ArrayCount - ArrayLen + 1
>
>   If ArrayLen = 1 Then
>      ' The most primitive array we will permutate.
>      ' The result is the array itself, and the result
>      ' is inserted in the last position of the Order array.
>      Order(Position) = Elements(LBound(Elements))
>
>      ' This Order is now complete, since the final element has
>      ' been filled in.
>      Orders.Add Order
>   Else
>      ' The permutation of Elements is each distinct Element
>      ' + all permutations of the remaining elements.
>      For i = LBound(Elements) To UBound(Elements)
>         Element = Elements(i)
>         Order(Position) = Element
>         Permutate ArrayCount, RemoveFromArray(Elements, Element), Order, 
> Orders
>      Next i
>
>   End If
>
> End Sub
>
> Public Function RemoveFromArray(ByRef Elements() As Long, ByVal Element As 
> Long) As Long()
> Dim NewArray() As Long
> Dim i          As Long
> Dim newi       As Long
>
>   ' Will create a new array where Element has been left out.
>   ReDim NewArray(LBound(Elements) To UBound(Elements) - 1)
>   For i = LBound(Elements) To UBound(Elements)
>      If Elements(i) <> Element Then
>         newi = newi + 1
>         NewArray(newi) = Elements(i)
>      End If
>   Next
>
>   RemoveFromArray = NewArray
>
> End Function
>
>

I did not think about the speed of the routine I merely used the routines on 
the site you mentioned and put a GUI wrapper (similar to what was shown in 
the article) to show how to use the routines.  However after reading some of 
these post I thought I would check out the speed of the routine.

To list the permutations (all 362,880 of them) of a 9 character string took 
26.5 seconds.  However if I comment out the filling of the list box it only 
takes 4.5 seconds...not sure if you need the listbox or not but if you can 
do without it then I would think this solution would be plenty fast.

Steve 

Hi Larry,

Larry Serflaten schrieb:

> ...
> Obviously there should be another algorithm that would be better suited
> for the job.  This has to have been solved before, it sounds so basic of
> an idea, but I don't recall seeing the solution.  If you keep searching you
> may turn up something....
> ...

Perhaps mine could do. It generates permutations (when compiled to 
native code) at a rate of about 60 millions per second.

Public Sub Test(ByVal N As Long)
Dim Idxs() As Long, i As Long, k As Long

ReDim Idxs(0 To N - 1)
For k = 0 To N - 1
   Idxs(k) = k
Next k

Do
   i = i + 1
   Debug.Print i;
   For k = 0 To N - 1
     Debug.Print Idxs(k);
   Next k
   Debug.Print ""
Loop While Permute(Idxs, N)

End Sub

Public Function Permute(ByRef Idxs() As Long, ByVal N As Long) _
        As Boolean
Static k As Long, j As Long, r As Long, Temp As Long

r = N - 1
For k = r - 1 To 0 Step -1
   If Idxs(k) < Idxs(k + 1) Then
     For j = r To 0 Step -1
       If Idxs(k) < Idxs(j) Then
         Temp = Idxs(k): Idxs(k) = Idxs(j): Idxs(j) = Temp
         k = k + 1
         While (r > k)
           Temp = Idxs(r): Idxs(r) = Idxs(k): Idxs(k) = Temp
           r = r - 1
           k = k + 1
         Wend
         Permute = True
         Exit Function
       End If
     Next j
   End If
Next k

End Function

Permute takes an index array filled with numbers (no duplicates) and on 
each call shuffles them around until the numbers are sorted descending.

Example output for Test 4:

  1  0  1  2  3
  2  0  1  3  2
  3  0  2  1  3
  4  0  2  3  1
  5  0  3  1  2
  6  0  3  2  1
  7  1  0  2  3
  8  1  0  3  2
  9  1  2  0  3
  10  1  2  3  0
  11  1  3  0  2
  12  1  3  2  0
  13  2  0  1  3
  14  2  0  3  1
  15  2  1  0  3
  16  2  1  3  0
  17  2  3  0  1
  18  2  3  1  0
  19  3  0  1  2
  20  3  0  2  1
  21  3  1  0  2
  22  3  1  2  0
  23  3  2  0  1
  24  3  2  1  0

The sequence of permutations generated are in sorted order (sorted 
ascending).

There are other algorithms too. Especially interesting are those using a 
"generator" array. Those allow to identify each individual permutation 
by its number, eg. for a 4 element index array there are 24 different 
permutations and so each permutation is associated to a number from 1 to 24.

The beauty of the generators is that one can start with any permutation 
by just giving its number. Eg if you have a 10 elements array with 
3628800 possible permutations you can just say "give me permutation 
numbered 1814400". And the algorithm is even faster than that from above 
when creating further permutations.

-- 
Ulrich Korndoerfer

VB tips, helpers, solutions -> http://www.prosource.de/Downloads/
MS Newsgruppen Alternativen -> http://www.prosource.de/ms-ng-umzug.html

This worked and I think I can modify it to meet my needs. 
I got up to a 12 character string when I ran out of memory. Hopefully I 
never have to go that far.
Thanks for your input.
Gary

"Steve" wrote:

> 
> "Gary Pollard" <GaryPollard@discussions.microsoft.com> wrote in message 
> news:2F6C43D1-6648-45FA-9FB2-3EF71143DE4F@microsoft.com...
> > I am looking for information on the permutation of an array. I have 
> > searched
> > this website and have not found what I am looking for. There are many
> > articles that will figure out all possible combinations of a string but 
> > they
> > all return strings in which characters are repeated.
> > EG: 1234 will return 1224 etc.
> >
> > I am looking for information on how to only list combinations that use the
> > characters in the string the same number of times that they are in the
> > original string.
> >
> > I did find an article at (http://www.vbi.org/Items/article.asp?id=133) 
> > that
> > sounds promising but the link to download the source code
> > (http://www.vbi.org/Items/link.asp?id=355) comes back with an error saying
> > unable to connect.
> > All messages and emails to the various links on the vbi.org site have been
> > returned as undeliverable.
> >
> > Any help with the logic on how to code the above or any information on the
> > vbi.org code sample is greatly appreciated
> >
> 
> Not really sure what you want...the code for the example on the article you 
> mention is listed directly in the article.  All that is required is to call 
> the code.
> 
> Assuming that your issue was in not understanding how to implement the 
> functions presented in the article, I went ahead and threw together a quick 
> example.  Simply start up VB, start a new standard exe project and place the 
> following code in the form that is created by default...then run the app.
> 
> Option Explicit
> 
> Private lblCaption As VB.Label
> Private txtNumElements As VB.TextBox
> Private lstPermutations As VB.ListBox
> Private WithEvents cmdChars As VB.CommandButton
> Private WithEvents cmdNums As VB.CommandButton
> 
> Private Sub Form_Load()
> 
>     Me.Visible = False
> 
>     Set lblCaption = Me.Controls.Add("VB.Label", "lblCaption", Me)
>     Set txtNumElements = Me.Controls.Add("VB.TextBox", "txtNumElements", Me)
>     Set lstPermutations = Me.Controls.Add("VB.ListBox", "lstPermutations", 
> Me)
>     Set cmdChars = Me.Controls.Add("VB.CommandButton", "cmdChars", Me)
>     Set cmdNums = Me.Controls.Add("VB.CommandButton", "cmdNums", Me)
> 
>     lblCaption.Move 120, 180, 2115, 255
>     lblCaption.Caption = "Number of elements:"
>     lblCaption.Visible = True
> 
>     txtNumElements.Move 2400, 180, 3255, 315
>     txtNumElements.Text = "0"
>     txtNumElements.Visible = True
> 
>     lstPermutations.Move 120, 660, 5535, 6300
>     lstPermutations.Clear
>     lstPermutations.Visible = True
> 
>     cmdChars.Move 5880, 180, 1215, 495
>     cmdChars.Caption = "Permutate characters"
>     cmdChars.Visible = True
> 
>     cmdNums.Move 5880, 840, 1215, 495
>     cmdNums.Caption = "Permutate numbers"
>     cmdNums.Visible = True
> 
>     Me.Width = 7530
>     Me.Height = 7815
> 
>     Me.Visible = True
> 
> End Sub
> 
> Private Sub cmdNums_Click()
>     DoPermutations False
> End Sub
> 
> Private Sub cmdChars_Click()
>     DoPermutations True
> End Sub
> 
> Private Sub DoPermutations(Optional blnAsChars As Boolean = False)
> Dim i As Long
> Dim lngNumElems As Long
> Dim Elems() As Long
> Dim Order() As Long
> Dim Orders As New Collection
> Dim Item As Variant
> Dim strTemp As String
> 
>     lstPermutations.Clear
> 
>     lngNumElems = Val(txtNumElements.Text)
>     ReDim Elems(1 To lngNumElems)
>     ReDim Order(1 To lngNumElems)
>     For i = 1 To lngNumElems
>         If blnAsChars Then
>             Elems(i) = 96 + i
>         Else
>             Elems(i) = i
>         End If
>     Next
> 
>     Permutate lngNumElems, Elems(), Order(), Orders
> 
>     For Each Item In Orders
>         strTemp = vbNullString
>         For i = LBound(Item) To UBound(Item)
>             If blnAsChars Then
>                 strTemp = strTemp & Chr(Item(i))
>             Else
>                 strTemp = strTemp & Item(i)
>             End If
>         Next
>         lstPermutations.AddItem strTemp
>     Next
> 
> End Sub
> 
> Public Sub Permutate( _
>    ByVal ArrayCount As Long, _
>    ByRef Elements() As Long, _
>    ByRef Order() As Long, _
>    ByRef Orders As Collection)
> 
> Dim Position   As Long
> Dim Element    As Long
> Dim i          As Long
> Dim ArrayLen   As Long
> 
>    ' The length of the Elements array. We need this
>    ' for our calculations later on.
>    ArrayLen = (UBound(Elements) - LBound(Elements) + 1)
> 
>    ' Position in the Order array of the first element in
>    ' the permutated arrays.
>    '
>    ' Example: Given the array(a,b,c,d), where we want to permutate
>    ' (b,c,d), the position in the new array for the first element
>    ' will be 2 (since (a) will take up the first position).
>    ' Likewise, when we permutate (c,d), the position of the first
>    ' element will be 3, since the first two spots are taken by
>    ' (a,b).
>    Position = ArrayCount - ArrayLen + 1
> 
>    If ArrayLen = 1 Then
>       ' The most primitive array we will permutate.
>       ' The result is the array itself, and the result
>       ' is inserted in the last position of the Order array.
>       Order(Position) = Elements(LBound(Elements))
> 
>       ' This Order is now complete, since the final element has
>       ' been filled in.
>       Orders.Add Order
>    Else
>       ' The permutation of Elements is each distinct Element
>       ' + all permutations of the remaining elements.
>       For i = LBound(Elements) To UBound(Elements)
>          Element = Elements(i)
>          Order(Position) = Element
>          Permutate ArrayCount, RemoveFromArray(Elements, Element), Order, 
> Orders
>       Next i
> 
>    End If
> 
> End Sub
> 
> Public Function RemoveFromArray(ByRef Elements() As Long, ByVal Element As 
> Long) As Long()
> Dim NewArray() As Long
> Dim i          As Long
> Dim newi       As Long
> 
>    ' Will create a new array where Element has been left out.
>    ReDim NewArray(LBound(Elements) To UBound(Elements) - 1)
>    For i = LBound(Elements) To UBound(Elements)
>       If Elements(i) <> Element Then
>          newi = newi + 1
>          NewArray(newi) = Elements(i)
>       End If
>    Next
> 
>    RemoveFromArray = NewArray
> 
> End Function
>  
> 
> .
> 

Jason
I have never worked with classes and right now I don't have a clue as to how 
to use this code - I will have to do some reading before trying to implement  
it.
Thanks 
Gary

"Jason Keats" wrote:

> Gary Pollard wrote:
> > This works well if the number of character in the sting is 8  or less,
> > processed a 8 character sting in about 1.5 minutes.
> > If I go to a 9 character string the project window goes blank and it appears
> > that it is some kind of endless loop. I stopped it after 15 minutes.
> 
> 
> The following class only takes a few seconds (on an old computer) to 
> write all permutations of a 9 character string to a file...
> 
> HTH
> 
> 
> VERSION 1.0 CLASS
> BEGIN
>    MultiUse = -1  'True
>    Persistable = 0  'NotPersistable
>    DataBindingBehavior = 0  'vbNone
>    DataSourceBehavior  = 0  'vbNone
>    MTSTransactionMode  = 0  'NotAnMTSObject
> END
> Attribute VB_Name = "CPermutations"
> Attribute VB_GlobalNameSpace = False
> Attribute VB_Creatable = True
> Attribute VB_PredeclaredId = False
> Attribute VB_Exposed = False
> Option Explicit
> Option Base 0
> 
> Private mnFF As Integer
> Private msFileOut As String
> Private msData As String
> Private mnPositionArrayPointer As Integer
> Private manPositionArray() As Integer
> Private msPermutation As String
> 
> Public Sub Init(ByVal sData As String, ByVal sFileOut As String)
>      msData = sData
>      msFileOut = sFileOut
> End Sub
> 
> Private Sub Permutations(ByVal nElement As Integer)
> 
>      Dim i As Integer
> 
>      mnPositionArrayPointer = mnPositionArrayPointer + 1
>      manPositionArray(nElement) = mnPositionArrayPointer
> 
>      If mnPositionArrayPointer = Len(msData) Then
>          msPermutation = ""
>          For i = 0 To UBound(manPositionArray)
>              msPermutation = msPermutation & Mid$(msData, 
> manPositionArray(i), 1)
>          Next i
> 
>          If Len(msPermutation) Then
>              Print #mnFF, msPermutation
>          End If
>      Else
>          For i = 0 To Len(msData) - 1
>              If manPositionArray(i) = 0 Then Call Permutations(i)
>          Next i
>      End If
> 
>      mnPositionArrayPointer = mnPositionArrayPointer - 1
>      manPositionArray(nElement) = 0
> 
> End Sub
> 
> Public Sub RecursivePermutations()
> 
>      mnPositionArrayPointer = -1
> 
>      ReDim manPositionArray(Len(msData) - 1)
> 
>      mnFF = FreeFile
> 
>      Open msFileOut For Output As #mnFF
>      'Print #mnFF, "* Recursive Permutations for... " & msData
> 
>      Call Permutations(0)
> 
>      'Print #mnFF, "* Finished!"
>      Close #mnFF
> 
> End Sub
> 
> .
> 

I did a project on permutations a long while ago. I will look to see where 
it is and upload it so you can look at it.

-- 
The Top Inno Setup Script Generator - http://www.randem.com/innoscript.html 

Ah, Here it is...

http://www.randem.com/cgi-bin/randem/countdown.cgi?Permutations.zip

See if this helps any.
-- 
The Top Inno Setup Script Generator - http://www.randem.com/innoscript.html 

Gary Pollard wrote:
> Jason
> I have never worked with classes and right now I don't have a clue as to how
> to use this code - I will have to do some reading before trying to implement
> it.
> Thanks
> Gary


To use what I gave you:
1. Cut and paste to Notepad
2. Save as: CPermutations.cls
3. Add the above file to your project using the menu: Project, Add Class 
Module
4. Execute the following:

Dim oPermutations As CPermutations

Set oPermutations = New CPermutations
oPermutations.Init "NINECHARS", App.Path & "\output.txt"
oPermutations.RecursivePermutations
Set oPermutations = Nothing

The results will be in the file output.txt in your project's directory.

HTH

Now if you like the permutations program you may like some of these 
http://www.randem.com/freesoftutil.html


-- 
The Top Inno Setup Script Generator - http://www.randem.com/innoscript.html 

Sorry about that that was the data for the code. Here is the code 
http://www.randem.com/cgi-bin/randem/countdown.cgi?PermutationsCode.zip

-- 
The Top Inno Setup Script Generator - http://www.randem.com/innoscript.html