Link to home
Start Free TrialLog in
Avatar of Valleriani
VallerianiFlag for Sweden

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

Avatar of Sean Stuber
Sean Stuber

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
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.
Avatar of Valleriani

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 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
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.
ASKER CERTIFIED SOLUTION
Avatar of Sean Stuber
Sean Stuber

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Perfect, thank you!