Sort Collection into every Unique Combination

[EdwinP]

I am looking a way to sort a collection into every unique combination. The count of the collection will not alway be the same. For example... Count is 3

1 2 3 - Do something
1 3 2 - Do something
2 1 3 - Do something
2 3 1 - Do something
3 1 2 - Do something
3 2 1 - Do something

Thanks in advance

 

[sunaj]

Hi,

Put a button and a list on a form.
Set N and M = count.


-----------------------------------------------------------
Const M = 3, N = 3
Dim Item(M) As Integer, Flag(M) As Integer, Queue(M) As Integer, Total As Long
Dim I As Integer

Sub Perm(M As Integer, N As Integer, Level As Integer)
Dim I As Integer, J As Integer, tmp As String

For I = 1 To M
If (Flag(I) = 0) Then
Flag(I) = 1
Queue(Level) = I
If (Level < N) Then
Call Perm(M, N, Level + 1)
Else
Total = Total + 1
tmp = &quot;&quot;
For J = 1 To Level
tmp = tmp & CStr(Item(Queue(J)))
Next
List1.AddItem tmp
Print
End If
Flag(I) = 0
End If
Next
End Sub
Private Sub Command1_Click()
For I = 1 To M
Item(I) = I
Next
Call Perm(M, N, 1)
End Sub
-----------------------------------------------------------

;-)Sunaj

 

[sunaj]

PS.
A &quot;Unique Combination&quot; is called a permutation.

 

[MichaelRed]

Interesting.

EdwinP specifically stated that the number of items &quot;N&quot; was not always equal to 3. I 'remember' that the permutations of a set ~ N! Edwin should be advised (cautioned) that for even small values of &quot;N&quot;, this value will create more &quot;permutations )value sets) than will be reasonable to &quot;exercize&quot; in the sense of callling procedures. Just to illustrate the point, I generated the factorials for the integers through 10:

For xx = 1 to 10: ? xx,  basPermute(CInt(xx)): Next xx
 1             1 
 2             2 
 3             6 
 4             24 
 5             120 
 6             720 
 7             5040 
 8             40320 
 9             362880 
 10            3628800

As you may readily observe, even while dwelling in the land of single digits, the task of calling a procedure for each permutation can be quite a hurculean chore. The actual execution time for a collection of (meaningful) procedures could (WOULD?) be sufficient for at least a coffee break!

MichaelRed
mred@att.net

There is never time to do it right but there is always time to do it over

 

[EdwinP]

Hi,
I do not know if it is proper to reply back this way and thank everyone, but here goes.
THANKS!!! This is EXACTLY what I was looking for.
Edwin

 

[strongm]

Sure, the time taken goes up exponentially as the number of items increases, but there are ways to reduce this when you realise that you don't have to search the entire solution space.

With permutations, for example, it is worth realising that (except for the trivial case where you only have one item) half of the permutations are merely mirror images. If we examine EdwinP's example in the original query:

1 2 3 -> 3 2 1
2 1 3 -> 3 1 2
2 3 1 -> 1 3 2

This realisation means that we can halve the time it takes to generate a complete solution. Here's a minor rewrite of sunaj's code to illustrate:

Const M = 3, N = 3
Dim Item(M) As Integer, Flag(M) As Integer, Queue(M) As Integer, Total As Long
Dim I As Integer
Dim StopPoint As Long

Sub Perm(M As Integer, N As Integer, Level As Integer)
Dim I As Integer, J As Integer, tmp As String
Static CheckPoint

If CheckPoint = StopPoint Then Exit Sub
For I = 1 To M
If (Flag(I) = 0) Then
Flag(I) = 1
Queue(Level) = I
If (Level < N) Then
Call Perm(M, N, Level + 1)
Else
Total = Total + 1
tmp = &quot;&quot;
For J = 1 To Level
tmp = tmp & CStr(Item(Queue(J)))
Next
List1.AddItem tmp
List1.AddItem StrReverse(tmp)
CheckPoint = CheckPoint + 1
Print
End If
Flag(I) = 0
End If
Next
End Sub

Private Sub Command1_Click()
StopPoint = factorial(M) / 2
For I = 1 To M
Item(I) = I
Next
Call Perm(M, N, 1)
End Sub

Private Function factorial(ByVal lSeed As Long) As Long

factorial = 1
Do Until lSeed = 0
factorial = factorial * lSeed
lSeed = lSeed - 1
Loop
End Function

 

[MichaelRed]

strongm,

The issue is NOT the generation of the permutations. It is calling N! (non-trivial) procedures. Consider the brief table for N! n = 1 to 10 previously posted. Perhaps through 6! (720) it is only an exercise in tedium to code the 720 items to be called/selected/executed. Even at the next step (7! = 5040), there are probably going to be 'issues' for some users waiting for the process to complete. Assume the processes are of an average execution of &quot;m&quot; milliseconds and set 'm' to 100 (0.1 seconds) This results in a five second &quot;delay&quot; for seven objects, but a 40 second delay for 8 objects.

Since EdwinP did not specify a limit on the number of objects, (in Fact stated that it was VARIABLE, so he may not know wht the upperbound of &quot;N&quot; is!) I think it is a GOOD idea to alert him to potential &quot;issues&quot;.


MichaelRed
mred@att.net

There is never time to do it right but there is always time to do it over

 

[strongm]

Fine; we're talking at cross-purposes. I'm very definitely talking about the generation of the permutations (which in itself can be time-consuming), and the train of thought happened to be triggered by your illustration.

And I agree that it is a good idea to flag potential issues. Would you agree that it is a good idea to share ideas on how improve or adapt algorithms?

 

[MichaelRed]

Of course.
MichaelRed
mred@att.net

There is never time to do it right but there is always time to do it over