Solved

Function to rumble letters

Posted on 2006-07-06
1
1,267 Views
Last Modified: 2008-02-01
Hi! I need a function that will rumble the possible combination of the letters.

for example... I have the letters a, b, c and d. I want it o rumble all the possible combinations< no repition of letters>.

the above string should produce...

abcd
abdc
adbc
adcb....

so on and so forth

thanks
0
Comment
Question by:JackOfPH
1 Comment
 
LVL 17

Accepted Solution

by:
inthedark earned 200 total points
ID: 17049153
have worked a lot with finite resource allocation I decided to create a class which makes this task easy. The following class will do what you need....see example 2 if you want to work with alphabetic keys.

In some situations, with longer keys, you may want to work with numerics.

01234
01243
etc.

The class will either return a key or an array of numerics.

Simple to use works just like a recordset.

But depending on that task at hand there may be more efficient ways of solving your particular problem. Knowing all of the permutations is not exactly a solution so a real life problem. But this will answer your question.

Hope this helps :~)

-------------------------zPermutations.cls
Option Explicit

' Class: zPermutations
' Author: Nick Young nyoung@vipintersoft.com
' Copyright (c) 2003 Nick Young
' You may use & distribute freely but provided that the author and copyright are acknowledged.

' WARNING: Read The Notes for the item property


'' example 1 using numeric keys
'Dim Px As zPermutations
'Set Px = New zPermutations
'Px.Elements = 3
'Px.AddKey 1
'Px.AddKey 2
'Px.AddKey 3
'Px.Numeric = True
'Px.MoveFirst
'Do While Not Px.EOF
'    Debug.Print Px.CurrentKey
'    Px.MoveNext
'Loop
'Stop
'
'' example 2 using aplha keys
'Set Px = New zPermutations
'Px.Elements = 3
'Px.AddKey "A"
'Px.AddKey "B"
'Px.AddKey "C"
'Px.Numeric = False
'Px.MoveFirst
'Do While Not Px.EOF
'    Debug.Print Px.CurrentKey
'    Px.MoveNext
'Loop
'Stop
'
'' Example 3 using array of values
'Set Px = New zPermutations
'Px.Elements = 3
'Px.AddKey 1
'Px.AddKey 2
'Px.AddKey 3
'Px.Numeric = True
'Px.ArrayBase = 0 ' set
'
'Px.MoveFirst
'
'Dim CurrentKey() As Long
'Dim lc As Long
'
'Do While Not Px.EOF
'    Px.LoadCurrentLongArray CurrentKey()
'    For lc = LBound(CurrentKey) To UBound(CurrentKey)
'        Debug.Print CStr(CurrentKey(lc)); " ";
'    Next lc
'    Debug.Print
'    Px.MoveNext
'Loop
'Stop


Dim mlElements As Long

Dim B() As Boolean
Dim Sequence() As Long


Dim mbComplete As Boolean
Dim mlCurrent As Long

Public ElementsFound As Long

Public Numeric As Boolean


Dim mlKeyCount
Dim mvKeys() As Variant

Dim mlArrayBase As Long

Public Function AddKey(Key)

' adds a key value for the next element

mlKeyCount = mlKeyCount + 1
ReDim Preserve mvKeys(mlKeyCount - 1)
mvKeys(mlKeyCount - 1) = Key

End Function


Public Property Let ArrayBase(plNewValue As Long)
mlArrayBase = plNewValue
End Property

Public Function Char(Item) As String
' converts a binary value into a letter
' so zero is A, 1 is B etc.
Char = Chr(Item + 65)
End Function


Public Function CurrentKey() As String

' display the current key value
' this may key may be meaningless if numeric keys above 9 are used.

If Numeric Then
    Dim sKey As String
    Dim lc As Long
   
    sKey = Space(mlElements + 1)
   
    For lc = 0 To mlElements
        Mid(sKey, lc + 1, 1) = Chr(48 + mvKeys(Sequence(lc)))
    Next lc
    CurrentKey = sKey
Else

   
   
    sKey = ""
   
    For lc = 0 To mlElements
        sKey = sKey & mvKeys(Sequence(lc))
    Next lc
    CurrentKey = sKey
End If

End Function

Public Sub LoadCurrentLongArray(rLongArray() As Long)

' display the current key value
' this may key may be meaningless if numeric keys above 9 are used.
Static bDone As Boolean
If Not bDone Then
    bDone = True
    ReDim rLongArray(mlArrayBase To mlArrayBase + mlElements)
End If

Dim sKey As String
Dim lc As Long

sKey = ""

For lc = 0 To mlElements
    rLongArray(lc + mlArrayBase) = mvKeys(Sequence(lc))
Next lc


End Sub
Public Function EOF() As Boolean

' returns true if all possibles been found?

EOF = mbComplete
End Function
Public Property Get Item(Element) As Variant

' ** WARNING: READ THESE NOTES:
' make this the default proeprty
' Select Tools, Provedure attributes, select the Item propery,
' then Advanced, change the procedure ID to Default,
' then click APPLY

' this will return the key value for an element
' or if no keys were specified it will return
' the numeric value of the sequence

If mlKeyCount > 0 Then
    Item = mvKeys(Sequence(Element))
Else
    Item = Sequence(Element)
End If

End Property

Public Property Get Value(Element) As Long

' this will return the numeric value for an element

Value = Sequence(Element)

End Property

Public Sub MoveFirst()

' move to the start of the sequence

ReDim B(mlElements)
ReDim Sequence(mlElements)

Dim lc As Long

' SET UP LOWEST POSSIBLE VALUE
For lc = 0 To mlElements
    Sequence(lc) = lc
Next

' setup starting point for next move
mlCurrent = mlElements
ElementsFound = 1
mbComplete = False

End Sub

Public Sub MoveNext()

' setup key values for the next item

Dim bInvalid As Boolean
Dim lc As Long
Dim lVal As Long

' keep looping until the next valid permutation is found

' example 42345 is invalid so add 1
' butthe thing that makes this routine fast
' is that it knows that the 2nd 4 is repeated and must be changed next

Do
       
    Advance
   
    If mbComplete Then Exit Sub
   
   
    ' now see if the current sequence is a valid permutation
   
    ' clear an incidator so see if a value has been found
    For lc = 0 To mlElements
        B(lc) = False
    Next
   
   
   
    bInvalid = False
   
    For lc = 0 To mlElements
        lVal = Sequence(lc)
        If B(lVal) Then
            bInvalid = True
            Exit For
        Else
            B(lVal) = True
        End If
    Next
   
    If Not bInvalid Then
        ' make sure next advance will work on the last change
        mlCurrent = mlElements
        Exit Do
    End If
   
Loop
   
ElementsFound = ElementsFound + 1

End Sub


Private Sub Advance()

' to see what this functions does is imagine you
' are working in base 10 and you have the number
' 12349
' add 1 to this number and you get 12350
' this function does the same but in the specified base

' ABC
' ACA
' ACB

Do
    ' add 1 to the last returned sequence
    Sequence(mlCurrent) = Sequence(mlCurrent) + 1
    If Sequence(mlCurrent) <= mlElements Then
        mlCurrent = mlElements
       ' Form1.List1.AddItem "N: " + CurrentKey
        Exit Sub
    End If
    Sequence(mlCurrent) = 0
    mlCurrent = mlCurrent - 1
    If mlCurrent < 0 Then
        mbComplete = True
        Exit Sub
    End If
Loop

End Sub
Public Property Get Elements() As Long

' returns the number of elements

Elements = mlElements + 1

End Property


Public Property Let Elements(NewValue As Long)

' Sets the number of elements to be used

' example value passed as 5
' is elements 0 to 4 so the number 4 is stored

' but don't allow less than 2 elements
If NewValue < 2 Then
    mlElements = 1
Else
    mlElements = NewValue - 1
End If

ReDim mvKeys(mlElements)
Dim lc As Long
For lc = 0 To mlElements
    mvKeys(lc) = Chr(65 + lc)
Next lc
mlKeyCount = 0

MoveFirst

End Property



Public Property Get Permutations() As Double

' calculate the possibilities

Dim P As Double
Dim lc As Double

P = 1
For lc = mlElements + 1 To 2 Step -1
    P = P * lc
Next

Permutations = P

End Property


Private Sub Class_Initialize()
    mlArrayBase = 0
End Sub


0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

867 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now