Valleriani
asked on
Permutations - An advance way?
I have a basic permutations script, which allows you to input a string of letters/numbers, etc and it will give you all the different variations.. But I want to go further then that. Let's say I have two 6 letter words... NNTMMP, PMLANP.. Randomish right?
Okay, so generally I'd do a permuation (the script I'm attaching) to both of them. But theres a twist I wanted to addon. Basicly it would be:
NNTMMP
PMLANP
I also would want it to take the letters and mix and match, BUT, the letters have to be SWAPPED.. and still in the same POSITION. for example
PNTMMP
NMLANP
(swapped N/P..) or..
PNLMMP
NMTANP
(swapped N/P and L/T)...
NNLMNP
PMTAMP
(swapped L/T, M/N)
Anyways... it would THEN have to get the permutations of each new 6 letter word, unless no differ (as you see the two p's would make no differ), but neverless it can still go through and create duplicates, it's not a huge deal, it all gets weaved out in the end anyways. Whatever would be easier.
How would this be solved? Is there any examples around/help?
Okay, so generally I'd do a permuation (the script I'm attaching) to both of them. But theres a twist I wanted to addon. Basicly it would be:
NNTMMP
PMLANP
I also would want it to take the letters and mix and match, BUT, the letters have to be SWAPPED.. and still in the same POSITION. for example
PNTMMP
NMLANP
(swapped N/P..) or..
PNLMMP
NMTANP
(swapped N/P and L/T)...
NNLMNP
PMTAMP
(swapped L/T, M/N)
Anyways... it would THEN have to get the permutations of each new 6 letter word, unless no differ (as you see the two p's would make no differ), but neverless it can still go through and create duplicates, it's not a huge deal, it all gets weaved out in the end anyways. Whatever would be easier.
How would this be solved? Is there any examples around/help?
Option Explicit
Private StrArray(0 To 8) As String
Private Sub Form_Load()
Dim w
StrArray(0) = ""
StrArray(1) = ""
StrArray(2) = "ABC"
StrArray(3) = "GHI"
StrArray(4) = "JKL"
StrArray(5) = "MNO"
StrArray(6) = "PQRS"
StrArray(7) = "TUV"
StrArray(8) = "WXYZ"
For Each w In Permutate("234567")
Debug.Print w
Next
End Sub
Private Function Permutate(User As String) As Collection
Dim idx As Long, siz As Long
Dim halt As String, word As String
' Test input
Set Permutate = New Collection
If User Like "*[!0-8]*" Then Exit Function
' Init variables
siz = Len(User)
word = Space$(siz)
' Init odometer, convert input to mumerical values
ReDim odm(1 To siz) As Byte
ReDim usr(1 To siz) As Byte
For idx = 1 To siz
odm(idx) = 1
usr(idx) = Val(Mid$(User, idx, 1))
Next
' Run counting loop
Do
' Build word, save it
For idx = 1 To siz
Mid(word, idx, 1) = Mid$(StrArray(usr(idx)), odm(idx), 1)
Next
Permutate.Add word
' Increment odometer
odm(siz) = odm(siz) + 1
' Handle rollovers
idx = siz
Do While odm(idx) > Len(StrArray(usr(idx)))
odm(idx) = 1
idx = idx - 1
If idx = 0 Then Exit Function
odm(idx) = odm(idx) + 1
Loop
Loop
End Function
I am not certain I understand the question. Since you already have code to do the permutations are you looking for code to identify all possible letter swap combinations?
I.e., swap the letters in position 1 or the letters in position 2, etc. or
the letters in positions 1 and 2; 1 and 3, etc. or
the letters in positions 1, 2, and 3; 1, 2 and 4, etc.
If this is what you want there is a simple solution I believe.
I.e., swap the letters in position 1 or the letters in position 2, etc. or
the letters in positions 1 and 2; 1 and 3, etc. or
the letters in positions 1, 2, and 3; 1, 2 and 4, etc.
If this is what you want there is a simple solution I believe.
ASKER
Yes basicly swap combinations, thats what I ment to say. But also be able to swap more then one number at a time. So you can swap one/two/three/four/five.. But they must swap only down and up, as in 1 and 4 cannot swap, but 1 and 2 can.. heres what I mean.. lets pretend the numbers are letters. There are supposed to be 6 letters per word, but I've only done five so I can use all the numbers only once:
So ignoring the permuatations:
01234
56789
Are the set. Basicly numbers can swap up and down, but not across.... For example 0 and 5 can swap, but not 0 and 6 (or any other number)... 2 and 7 can swap, 4 and 9 can swap, since there in the same range.... So for example you can do:
51784
06239
So they can move up and down just not left and right. And after each up and down movement I'll be calling the permuatations script.
It's basicly like a permuatation script for swapping up and down, since I would basicly need all combinations.
Thanks for the reply!
So ignoring the permuatations:
01234
56789
Are the set. Basicly numbers can swap up and down, but not across.... For example 0 and 5 can swap, but not 0 and 6 (or any other number)... 2 and 7 can swap, 4 and 9 can swap, since there in the same range.... So for example you can do:
51784
06239
So they can move up and down just not left and right. And after each up and down movement I'll be calling the permuatations script.
It's basicly like a permuatation script for swapping up and down, since I would basicly need all combinations.
Thanks for the reply!
So you need a procedure that will take 2 parameters and generate all the permutations of both including the special swap rules?
ok will post shortly
ok will post shortly
ASKER
Yep! thanks!
It appears to me that each operation can be expressed by a 5 bit binary number. For example, if you want to swap the elements in positions 1 3 and 5, say
ABCDE
FGHJK
to produce
FBHDK
AGCJE
The you are using the bit pattern 10101
Every 5 bit pattern corresponds to a valid swap unless it is repetitious due to repetitions in letters.
So, all you need to do is generate every 5 bit pattern.
These are, of course, the numbers from 1 to 31 in binary.
I hope this is of use.
ABCDE
FGHJK
to produce
FBHDK
AGCJE
The you are using the bit pattern 10101
Every 5 bit pattern corresponds to a valid swap unless it is repetitious due to repetitions in letters.
So, all you need to do is generate every 5 bit pattern.
These are, of course, the numbers from 1 to 31 in binary.
I hope this is of use.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Perfect, thank you!
Private Function Permutate(User As String) As Collection
Dim i As Long
Dim p as String
' Test input
Set Permutate = New Collection
If User Like "*[!0-8]*" Then Exit Function
For i = 1 to Len(User)
For Each p In Permutate(Mid$(User,2))
Permutate.Add Left$(User,1) & p
Next
User = Mid$(User,2) & Left$(User,1)
Next
End Function