Prev: Saving decision tree
Next: what to do with an old IIS webclass application
From: Larry Serflaten on 1 Jul 2010 12:20

"Gary Pollard" <GaryPollard(a)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


From: Steve on 1 Jul 2010 13:11

"Steve" <sredmyer(a)sndirect.com> wrote in message
news:i0i3bh$7ao$1(a)news.eternal-september.org...
>
> "Gary Pollard" <GaryPollard(a)discussions.microsoft.com> wrote in message
> news:2F6C43D1-6648-45FA-9FB2-3EF71143DE4F(a)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

From: Ulrich Korndoerfer on 1 Jul 2010 18:48
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
From: Gary Pollard on 1 Jul 2010 19:37
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(a)discussions.microsoft.com> wrote in message
> news:2F6C43D1-6648-45FA-9FB2-3EF71143DE4F(a)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
>
>
> .
>
From: Gary Pollard on 1 Jul 2010 19:37
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
>
> .
>
First  |  Prev  |  Next  |  Last
Pages: 1 2 3
Prev: Saving decision tree
Next: what to do with an old IIS webclass application