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?
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

Open in new window

LVL 7
VallerianiAsked:
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.

sdstuberCommented:
This is off the cuff, so my syntax might be a little rough.  Give this a shot


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
0
roussoscCommented:
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.
0
VallerianiAuthor Commented:
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!
0
The Ultimate Tool Kit for Technolgy Solution Provi

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy for valuable how-to assets including sample agreements, checklists, flowcharts, and more!

sdstuberCommented:
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
0
VallerianiAuthor Commented:
Yep! thanks!
0
roussoscCommented:
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.
0
sdstuberCommented:
try this...


Option Explicit
 
Private Sub Form_Load()
Dim s As Variant
Dim p As Variant
Dim i As Integer
 
'    i = 0
'    For Each s In ListSwaps("123", "456")
'        i = i + 1
'        debug.print Text1.Text & i & "-" & s
'        Text1.Text = Text1.Text & i & "-" & s & vbCrLf
'    Next
 
 
'    i = 0
'    For Each s In Permutate("123")
'        i = i + 1
'        Debug.Print Text1.Text & i & "-" & s
'        'Text1.Text = Text1.Text & i & "-" & s & vbCrLf
'    Next
 
 
    For Each s In ListSwaps("123", "456")
        For Each p In Permutate(Trim(Str(s)))
            Debug.Print Text1.Text & p
'            Text1.Text = Text1.Text & p & vbCrLf
        Next
    Next
 
 
End Sub
 
Private Function Permutate(pString As String) As Collection
Dim i As Integer
Dim s As Variant
Dim temp As String
 
    If Len(pString) = 0 Then Exit Function
    
    Set Permutate = New Collection
    
    If Len(pString) = 1 Then
        Permutate.Add pString
    Else
        temp = pString
 
        For i = 1 To Len(temp)
            For Each s In Permutate(Mid$(temp, 2))
                Permutate.Add Left$(temp, 1) & s
            Next
            temp = Mid$(temp, 2) & Left$(temp, 1)
        Next
    End If
End Function
 
Private Function ListSwaps(pStr1 As String, pStr2 As String) As Collection
Dim i As Integer
Dim j As Integer
Dim minlen As Integer
Dim temp1 As String
Dim temp2 As String
 
    Set ListSwaps = New Collection
    If Len(pStr1) > Len(pStr2) Then
        minlen = Len(pStr2)
    Else
        minlen = Len(pStr1)
    End If
 
    For i = 1 To (2 ^ minlen)
        temp1 = pStr1
        temp2 = pStr2
        For j = 1 To minlen
            If i And (2 ^ (j - 1)) Then
                temp1 = Left$(temp1, j - 1) & Mid$(pStr2, j, 1) & Mid$(temp1, j + 1)
                temp2 = Left$(temp2, j - 1) & Mid$(pStr1, j, 1) & Mid$(temp2, j + 1)
            End If
        Next
        ListSwaps.Add temp1
    Next
End Function

Open in new window

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.

Start your 7-day free trial
VallerianiAuthor Commented:
Perfect, thank you!
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.