x
Solved

# Function to rumble letters

Posted on 2006-07-06
Medium Priority
1,310 Views
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

so on and so forth

thanks
0
Question by:JackOfPH
1 Comment

LVL 17

Accepted Solution

inthedark earned 800 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.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.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.Numeric = True
'Px.ArrayBase = 0 ' set
'
'Px.MoveFirst
'
'Dim CurrentKey() As Long
'Dim lc As Long
'
'Do While Not Px.EOF
'    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

' 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

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

' 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

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

## Join & Write a Comment Already a member? Login.

If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
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…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
###### Suggested Courses
Course of the Month7 days, 16 hours left to enroll

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

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