Solved

Function to rumble letters

Posted on 2006-07-06
1
1,262 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

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
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…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

705 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