# Permutation with "n" numbers

I have three "slots". I have "n" numbers (at least three). I have to place these numbers into the slots in all available variation, without leaving empty slots. Like if I get the numbers 1, 2 and 3, the variations are: 1 2 3; 1 3 2; 2 1 3
2 3 1; 3 1 2; 3 2 1.
The question is what is the code for that? With 4 numbers or 5 or ANY.
Naturally, a "slot" can hold any numbers, but at least one!
###### Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Author Commented:
If i get the numbers 1, 2 and 2 there's 6 solutions too. The user can enter anything. I have to separate'em.
0
Commented:
>If i get the numbers 1, 2 and 2 there's 6 solutions too
What 6 solutions?
0
progCommented:
use this allanags routine, sends them to the debug window at the moment

Option Explicit

Private Function bubble(x() As String, i As Long)

Dim c As Long
Dim bF As Boolean
Dim z As String

Dim y() As String

ReDim y(i)

Do

bF = True
For c = 1 To i - 1

If x(c) > x(c + 1) Then
bF = False
z = x(c)
x(c) = x(c + 1)
x(c + 1) = z
End If
Next
Loop Until bF

End Function

Private Function factorial(i As Integer) As Long

Dim c As Integer

factorial = 1
For c = 2 To i
factorial = factorial * c
Next

End Function

Private Function perm(x() As String, sString, number)

Dim iLen As Integer
Dim sTarget As String
Dim lCount As Long
Dim c As Integer
Dim d As Long
Dim l, r

iLen = Len(sString)

If iLen = 1 Then

x(1) = sString
number = 1

Else

Dim a() As String
ReDim a(factorial(iLen))

For c = 1 To iLen

If c > 1 Then
l = Mid(sString, 1, c - 1)
Else
l = ""
End If
If c < iLen Then
r = Mid(sString, c + 1, iLen - c)
Else
r = ""
End If

sTarget = l & r
lCount = 0
Call perm(a, sTarget, lCount)
For d = 1 To lCount
number = number + 1
x(number) = Mid(sString, c, 1) & a(d)
Next

Next

End If

End Function

Private Sub allanags(sstr As String)

Dim x() As String
Dim number As Long
Dim c As Long

ReDim x(factorial(Len(sstr)))

Call perm(x(), sstr, number)

Call bubble(x, number)

For c = 1 To number

Debug.Print x(c)

Next
Stop

End Sub

Private Sub Command1_Click()

Call allanags("1234")

End Sub
0
Commented:
Here is the theory on how to do it

1)  Calculate how many permutations there are.  Basically the calculation is:

Size = N! / (A! * (N-A)!)

Where N is the total number, and A is the container size (! is factorial)

2)  Build a 2 dimensional array:

redim x(1 to N, 1 to A) as integer

3)  Populate the array with this code

k = 0 'offset
for i = 1 to Size
for j = 1 to A
x(i,j) = (((i - 1) mod n) + 1)
if j = 1 then
x(i,j) = x(i,j) + k
k = k + 1
if k >= n then k = 0
end if
next j
next i

Now the array will contain all of the combinations, "vertically".

For example, perm #1 is

x(1, 1) & x(1, 2) & ... & x(1,n)

Make sense?
0
Commented:
Interesting question...I think anthonyc has a good, simple algorithm.
0
Commented:
Psycho1,

Here's my suggestion:

Sub SlotMachine()
Dim n As Long, s1 As Long, s2 As Long, s3 As Long, c As Long
n = 3
Debug.Print "List of possible combinations"
For s1 = 1 To n
For s2 = 1 To n
For s3 = 1 To n
If s1 <> s2 And s1 <> s3 And s2 <> s3 Then
c = c + 1
Debug.Print s1, s2, s3
End If
Next s3
Next s2
Next s1
Debug.Print "Number of combinations: "; c
End Sub

Ture Magnusson
0
Author Commented:
Thanks but (how I wrote) I have to place them into that three slots (a simple List). So if the user gave me four numbers the solutions can be (for example):

1  2  3
4

or

1  3  4
2

and so on.

The "permutation-section" not solves this exactly.
0
Author Commented:
deighton:

I'm increased the points to 200.
0
Commented:
Psycho1,

Do you mean that you want to save all combinations in an array? Here is a procedure that does that. and shows the array afterwards.

Sub TuresSlotMachine()
Dim slots() As Long
Dim n As Long, s1 As Long, s2 As Long, s3 As Long, c As Long, r As Long
n = 3

'Save all possible combinations to an array
For s1 = 1 To n
For s2 = 1 To n
For s3 = 1 To n
If s1 <> s2 And s1 <> s3 And s2 <> s3 Then
c = c + 1
ReDim Preserve slots(1 To 3, 1 To c)
slots(1, c) = s1
slots(2, c) = s2
slots(3, c) = s3
End If
Next s3
Next s2
Next s1

'Now, let's see the list
Debug.Print "List of possible combinations:"
For r = 1 To c
Debug.Print slots(1, r), slots(2, r), slots(3, r)
Next r
Debug.Print "Number of combinations: "; c
End Sub

/Ture
0
Author Commented:
deighton:

Another thing! The user can enter ANY numbers. Like 34, 125, 1987065, 1, 9 etc.
0
Commented:
Psycho1,

It seems as if you are communicating only with deighton. Are the rest of us completely off target?

/Ture
0
Commented:
My procedure again, modified to enter all possible combinations of a list of numbers into the three slots.

Sub TuresSlotMachine()
Dim numbers, slots() As Long
Dim s1 As Long, s2 As Long, s3 As Long, c As Long, r As Long

numbers = Array(5, 11, 793, 1024)

'Save all possible combinations to an array
For s1 = 0 To UBound(numbers)
For s2 = 0 To UBound(numbers)
For s3 = 0 To UBound(numbers)
If s1 <> s2 And s1 <> s3 And s2 <> s3 Then
c = c + 1
ReDim Preserve slots(1 To 3, 1 To c)
slots(1, c) = numbers(s1)
slots(2, c) = numbers(s2)
slots(3, c) = numbers(s3)
End If
Next s3
Next s2
Next s1

'Now, let's see the list
Debug.Print "List of possible combinations:"
For r = 1 To c
Debug.Print slots(1, r), slots(2, r), slots(3, r)
Next r
Debug.Print "Number of combinations: "; c
End Sub

/Ture
0
Author Commented:
ture:

It works, but (I wrote it before) I need all the combinations. Any slot can hold any numbers(at least one). So with your example (5, 11, 793, 1024) one of the solutions is:

slot1  slot2  slot3
5      11     793
1024

If you give me another code wich one is doing this thing I'll unlock the question for you and the points are yours.
0
Commented:
Psycho1,

Thanks for responding.

I think that I misunderstood you before. Is this interpretation correct?

1. Each slot can hold one OR SEVERAL numbers.

2. In each combination, ALL the numbers should be put into slots.

What result do you want? A three-dimensional array with all combinations? Or perhaps it's enough with just a count of the number of combinations?

/Ture
0
progCommented:
'Here it is

Dim N As Integer 'number of numbers
Dim iSlot() As Integer
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim O() As Integer
Dim c As Long
Dim bSorted As Boolean, b As Boolean
Dim d As Long
Dim temp1, temp2, temp3

N = 4
ReDim iSlot(1 To 3, factorial(N))
ReDim O(1 To N)

O(1) = 1
O(2) = 4
O(3) = 4
O(4) = 4

For x = 1 To N
For y = 1 To N
For z = 1 To N

If x <> y And y <> z And x <> z Then

c = c + 1
iSlot(1, c) = O(x)
iSlot(2, c) = O(y)
iSlot(3, c) = O(z)

End If

Next z, y, x

Do
bSorted = True
For d = 1 To c - 1
b = False
If iSlot(1, d) > iSlot(1, d + 1) Then
b = True
ElseIf iSlot(1, d) = iSlot(1, d + 1) Then
If iSlot(2, d) > iSlot(2, d + 1) Then
b = True
ElseIf iSlot(2, d) = iSlot(2, d + 1) Then
If iSlot(3, d) > iSlot(3, d + 1) Then
b = True
End If
End If
End If
If b Then
temp1 = iSlot(1, d)
temp2 = iSlot(2, d)
temp3 = iSlot(3, d)
iSlot(1, d) = iSlot(1, d + 1)
iSlot(2, d) = iSlot(2, d + 1)
iSlot(3, d) = iSlot(3, d + 1)
iSlot(1, d + 1) = temp1
iSlot(2, d + 1) = temp2
iSlot(3, d + 1) = temp3
bSorted = False
End If
Next
Loop Until bSorted

temp1 = iSlot(1, 1)
temp2 = iSlot(2, 1)
temp3 = iSlot(3, 1)

'islot holds all different permutations
'print a list without repeated permutations
'seems wise

Debug.Print "**"
Debug.Print temp1, temp2, temp3
For d = 2 To c
If temp1 <> iSlot(1, d) Or _
temp2 <> iSlot(2, d) Or _
temp3 <> iSlot(3, d) Then
Debug.Print iSlot(1, d), iSlot(2, d), iSlot(3, d)
temp1 = iSlot(1, d)
temp2 = iSlot(2, d)
temp3 = iSlot(3, d)

End If
Next

0
Commented:
0
Author Commented:
ture:

I want a 3 dimensional array with all the combinations.

for example:

1  2  3          |BUT! This one's are 4                |the same!:
|
1  2  3          |1  2  3
4             |4
|
etc.             |4  2  3
|1

I have to sort out the right side's solutions because they are the same.
And I need all the possible combinations with using every time all the numbers, and all the slots (can't be an empty slot).

deighton:
It looks like ture can give me a much smaller code.

I've increased the points to 250!
0
Author Commented:
The example again, 'cause it looks dizzy... Sorry. :-(

1 2 3
4

1 2 3
4
etc.

INCORRECT:

1 2 3
4

4 2 3
1

The first slot contains the same solution.
0
Commented:
guys..  Don't use 3 dimensional arrays.  Use collections or something instead.  There is never a need for a 3 dimensional array.  Not for something this trivial.

Did you read my theory, or just skip it because it didn't contain code?
0
Commented:
>guys..  Don't use 3 dimensional arrays.
I am not using it. :)
0
Commented:
Psycho1,

Here's another one for you!

Sub TuresSlotMachine()
'Declare variables
Dim Numbers As Variant
Dim CountOfNumbers As Integer
Dim Slots() As Long
Dim CountOfNumbersInSlot(1 To 3) As Integer
Dim SlotForThisNumber() As Integer

Dim Counter As Long
Dim WhichNumber As Integer
Dim SlotNumber As Integer
Dim SlotRowNumber As Integer

Dim x As Long
Dim r As Long

'Initialize variables
Numbers = Array(5, 11, 793, 1024)
CountOfNumbers = UBound(Numbers) + 1
ReDim SlotForThisNumber(1 To CountOfNumbers)
ReDim Slots(1 To 3, 1 To CountOfNumbers, 1 To 1)

'Initialize SlotForThisNumber to 1 for all numbers
For WhichNumber = 1 To CountOfNumbers
SlotForThisNumber(WhichNumber) = 1
Next WhichNumber

Do
'Increase number of combinations and expand the Slots array
Counter = Counter + 1
ReDim Preserve Slots(1 To 3, 1 To CountOfNumbers, 1 To Counter)

'Clear the number of entries in each Slot
For SlotNumber = 1 To 3
CountOfNumbersInSlot(SlotNumber) = 0
Next SlotNumber

'Loop through all numbers from 1 to CountOfNumbers
For WhichNumber = 1 To CountOfNumbers
SlotNumber = SlotForThisNumber(WhichNumber)
CountOfNumbersInSlot(SlotNumber) = CountOfNumbersInSlot(SlotNumber) + 1
SlotRowNumber = CountOfNumbersInSlot(SlotNumber)
Slots(SlotNumber, SlotRowNumber, Counter) = Numbers(WhichNumber - 1)
Next WhichNumber

'Clear the Slots array for the last combination
'and decrease Counter with 1 if any slots are empty
For SlotNumber = 1 To 3
If CountOfNumbersInSlot(SlotNumber) = 0 Then
For SlotRowNumber = 1 To CountOfNumbers
Slots(1, SlotRowNumber, Counter) = 0
Slots(2, SlotRowNumber, Counter) = 0
Slots(3, SlotRowNumber, Counter) = 0
Next SlotRowNumber
Counter = Counter - 1
Exit For
End If
Next SlotNumber

'Exit loop if all entries in SlotForThisNumber are 3
For WhichNumber = 1 To CountOfNumbers
If SlotForThisNumber(WhichNumber) <> 3 Then Exit For
Exit Do
Next WhichNumber

'Increase SlotForThisNumber counters
SlotForThisNumber(CountOfNumbers) = SlotForThisNumber(CountOfNumbers) + 1
For WhichNumber = CountOfNumbers To 2 Step -1
If SlotForThisNumber(WhichNumber) = 4 Then
SlotForThisNumber(WhichNumber) = 1
SlotForThisNumber(WhichNumber - 1) = SlotForThisNumber(WhichNumber - 1) + 1
End If
Next WhichNumber
Loop

'Now, let's see the list
Debug.Print "List of possible combinations:"
For x = 1 To Counter
Debug.Print "Combination #"; x
For SlotRowNumber = 1 To CountOfNumbers
If (Slots(1, SlotRowNumber, x) + Slots(2, SlotRowNumber, x) + Slots(3, SlotRowNumber, x)) <> 0 Then
For SlotNumber = 1 To 3
Debug.Print Slots(SlotNumber, SlotRowNumber, x),
Next SlotNumber
Debug.Print
End If
Next SlotRowNumber
Next x
End Sub

/Ture
0
Author Commented:
Ture:

It gaves me 24 solutions. I think it have to be 36? Am I right?
'Cause with 4 numbers # of solutions are:

(3 'on' 4 - 3 slots and 4 numbers)

(3*3*3*3 - (3*(2*2*2*2))) + 3

And it gives you 36. I fake it somewhere or your code is not perfect(yet :-)?
0
Commented:
My code is not perfect yet. It still reports both of these as different combinations:

1 2 3
4

4 2 3
1

/Ture
0
Author Commented:
Ture:

I hope that you want to make it perfect, because I want to give you that points! :-))
Anyway! With four numbers there's must be 36 solutions! I'm sure.
0
Author Commented:
Another comment for Ture:

Do not forget that the three slots are different! So this is a good group:

slot #1 #2 #3
1  2  3
4

2  3  4
1

That's why 36 solutions exists with 4 numbers.
0
Commented:
Psycho1,

This code correctly produces 36 combinations for the four numbers given.
The problem with the previous code was that it ended before looping through all possible combinations.

Sub TuresSlotMachine()
'Declare variables
Dim Numbers As Variant
Dim CountOfNumbers As Integer
Dim Slots() As Long
Dim CountOfNumbersInSlot(1 To 3) As Integer
Dim SlotForThisNumber() As Integer
Dim Counter As Long
Dim WhichNumber As Integer
Dim SlotNumber As Integer
Dim SlotRowNumber As Integer
Dim x As Long

'Initialize variables
Numbers = Array(5, 11, 793, 1024)
CountOfNumbers = UBound(Numbers) + 1
ReDim SlotForThisNumber(1 To CountOfNumbers)
ReDim Slots(1 To 3, 1 To CountOfNumbers, 1 To 1)

For WhichNumber = 1 To CountOfNumbers
SlotForThisNumber(WhichNumber) = 1
Next WhichNumber

Do
'Exit loop if all entries in SlotForThisNumber are 3
x = 0
For WhichNumber = 1 To CountOfNumbers
x = x + SlotForThisNumber(WhichNumber)
Next WhichNumber
If x = CountOfNumbers * 3 Then Exit Do

'Increase number of combinations and expand the Slots array
Counter = Counter + 1
ReDim Preserve Slots(1 To 3, 1 To CountOfNumbers, 1 To Counter)

'Clear the number of entries in each Slot
For SlotNumber = 1 To 3
CountOfNumbersInSlot(SlotNumber) = 0
Next SlotNumber

'Loop through all numbers from 1 to CountOfNumbers
For WhichNumber = 1 To CountOfNumbers
SlotNumber = SlotForThisNumber(WhichNumber)
CountOfNumbersInSlot(SlotNumber) = CountOfNumbersInSlot(SlotNumber) + 1
SlotRowNumber = CountOfNumbersInSlot(SlotNumber)
Slots(SlotNumber, SlotRowNumber, Counter) = Numbers(WhichNumber - 1)
Next WhichNumber

'Clear the Slots array for the last combination
'and decrease Counter with 1 if any slots are empty
For SlotNumber = 1 To 3
If CountOfNumbersInSlot(SlotNumber) = 0 Then
For SlotRowNumber = 1 To CountOfNumbers
Slots(1, SlotRowNumber, Counter) = 0
Slots(2, SlotRowNumber, Counter) = 0
Slots(3, SlotRowNumber, Counter) = 0
Next SlotRowNumber
Counter = Counter - 1
Exit For
End If
Next SlotNumber

'Increase SlotForThisNumber counters
SlotForThisNumber(CountOfNumbers) = SlotForThisNumber(CountOfNumbers) + 1
For WhichNumber = CountOfNumbers To 2 Step -1
If SlotForThisNumber(WhichNumber) = 4 Then
SlotForThisNumber(WhichNumber) = 1
SlotForThisNumber(WhichNumber - 1) = SlotForThisNumber(WhichNumber - 1) + 1
End If
Next WhichNumber
Loop

'Now, let's see the list
Debug.Print "List of possible combinations:"
For x = 1 To Counter
Debug.Print "Combination #"; x
For SlotRowNumber = 1 To CountOfNumbers
If (Slots(1, SlotRowNumber, x) + Slots(2, SlotRowNumber, x) + Slots(3, SlotRowNumber, x)) <> 0 Then
For SlotNumber = 1 To 3
Debug.Print Slots(SlotNumber, SlotRowNumber, x),
Next SlotNumber
Debug.Print
End If
Next SlotRowNumber
Next x
End Sub

/Ture
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Commented:
*******************************************************************
0
Commented:
what exactly are you trying to do. What will your program be used for - maybe I'll beable to give you a solution if I know what's going to happen with the results?
0
Author Commented:
ture:

It's PERFECT! Thank You very much! You've saved my life! These points are yours!

0
Author Commented:
Thanks again...
0
###### It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.