PDA

View Full Version : Solved: determine all combinations in a string



ALe
07-25-2006, 06:52 AM
Hi all,

I have 4 letters (a,b,c,d) that can be combined in a string

I'm trying to create a function/sub that lists all the different combinations of the 4 letters such as:
1. a, b, c, d
2. aa, ab, ac, ad, ba, bb, bc, bd, ca, cb, cc, cd, da, db, dc, dd
3. aaa, aab, aac, abc, bac, ddd, ...

I worked on it a while and my head is going crazy. Any ideas?
:banghead:

OBP
07-25-2006, 07:09 AM
sorry, you have lost me. If the string is a,b,c,d how do you arrive at aa or aaa ?
there is only one a in the string. Combinations of the string as it is are
abcd
bacd
bcad
bcda
just for the positions of a.

compariniaa
07-25-2006, 07:13 AM
that's a mathematical function (either a permutation or a combination, I always get them confused), represented by nPr or nCr on your calculator
a quick google search would give you the proper formulas, if it's not a function already in excel

compariniaa
07-25-2006, 07:15 AM
ok, i found it...you want a permutation (nPr), and it is an excel function: PERMUT

EDIT: I just noticed that you wanted them listed out, and the PERMUT will only tell you how many different ways you can do it. Sorry

ALe
07-25-2006, 08:01 AM
I had a look but couldn't find any site with permutation in VBA, probably because I don't fully understand what to look for.
I'm starting to realize the reason why I always had E in maths.:think:

compariniaa
07-25-2006, 08:23 AM
it's a worksheet function, so
application.worksheetfunction.permut (4,4)
'or I think you can drop the worksheet function part:
application.permut (4,4)
the (4,4) is 4 items in all (a,b,c,d) arranged in groups of 4 (b,a,c,d or d,b,c,a etc). unfortunately, this will only tell you how many different combinations you can do, it won't actually list them out for you

ALe
07-25-2006, 08:54 AM
I don't need the number of combinations but a list of all the combinations.

Killian
07-25-2006, 09:12 AM
PERMUT is more useful for calculating the number of possibilities from a larger range of numbers (like winning the lottery picking x numbers from y possible selections)
PERMUT(n,n) is the same as the factorial of n (!n).

However, as pointed out, this doen't follow an "all permutations" algorithm because the letters can be repeated.

To return all those results, you need to loop through the members then nest another loop for each member then append the outputDim a
Dim w As Long, x As Long, y As Long, z As Long
Dim iFileNum As Long

a = Array("a", "b", "c", "d")

iFileNum = FreeFile
Open "C:\TEMP\testoutput.txt" For Append As #iFileNum

For w = LBound(a) To UBound(a)
Print #iFileNum, a(w)
For x = LBound(a) To UBound(a)
Print #iFileNum, a(w) & a(x)
For y = LBound(a) To UBound(a)
Print #iFileNum, a(w) & a(x) & a(y)
For z = LBound(a) To UBound(a)
Print #iFileNum, a(w) & a(x) & a(y) & a(z)
Next
Next
Next
Next

Close #iFileNum

Emily
07-26-2006, 12:27 AM
Lotto Algorithms - Permutations, Combinations
http://www.xtremevbtalk.com/showthread.php?t=168296

ALe
07-26-2006, 02:40 AM
Emily thank you! It is exactly what I was looking for!

The fact is that I'm trying to apply it to my string (abcd) without results.

Any idea how to apply these functions to my case?

Thanx

Emily
07-26-2006, 07:13 AM
Hi all,

I have 4 letters (a,b,c,d) that can be combined in a string

I'm trying to create a function/sub that lists all the different combinations of the 4 letters such as:
1. a, b, c, d
2. aa, ab, ac, ad, ba, bb, bc, bd, ca, cb, cc, cd, da, db, dc, dd
3. aaa, aab, aac, abc, bac, ddd, ...

I worked on it a while and my head is going crazy. Any ideas?
:banghead:


' Remark: I can't remember who is the orginal code writter
Option Explicit

Dim vAllItems As Variant
Dim Buffer() As String
Dim BufferPtr As Long
Dim Results As Worksheet


Sub ListPermutations()
Dim Rng As Range
Dim PopSize As Integer
Dim SetSize As Integer
Dim Which As String
Dim N As Double
Const BufferSize As Long = 4096
Sheet1.Range("A1").Select
Set Rng = Selection.Columns(1).Cells
If Rng.Cells.Count = 1 Then
Set Rng = Range(Rng, Rng.End(xlDown))
End If

PopSize = Rng.Cells.Count - 2
If PopSize < 2 Then GoTo DataError

SetSize = Rng.Cells(2).Value
If SetSize > PopSize Then GoTo DataError

Which = UCase$(Rng.Cells(1).Value)
Select Case Which
Case "C"
N = Application.WorksheetFunction.Combin(PopSize, SetSize)
Case "P"
N = Application.WorksheetFunction.Permut(PopSize, SetSize)
Case Else
GoTo DataError
End Select
If N > Cells.Count Then GoTo DataError

Application.ScreenUpdating = False

Set Results = Worksheets.Add

vAllItems = Rng.Offset(2, 0).Resize(PopSize).Value
ReDim Buffer(1 To BufferSize) As String
BufferPtr = 0

If Which = "C" Then
AddCombination PopSize, SetSize
Else
AddPermutation PopSize, SetSize
End If
vAllItems = 0

Application.ScreenUpdating = True
Exit Sub

DataError:
If N = 0 Then
Which = "Enter your data in a vertical range of at least 4 cells. " _
& String$(2, 10) _
& "Top cell must contain the letter C or P, 2nd cell is the number " _
& "of items in a subset, the cells below are the values from which " _
& "the subset is to be chosen."

Else
Which = "This requires " & Format$(N, "#,##0") & _
" cells, more than are available on the worksheet!"
End If
MsgBox Which, vbOKOnly, "DATA ERROR"
Exit Sub
End Sub


Private Sub AddPermutation(Optional PopSize As Integer = 0, _
Optional SetSize As Integer = 0, _
Optional NextMember As Integer = 0)

Static iPopSize As Integer
Static iSetSize As Integer
Static SetMembers() As Integer
Static Used() As Integer
Dim i As Integer

If PopSize <> 0 Then
iPopSize = PopSize
iSetSize = SetSize
ReDim SetMembers(1 To iSetSize) As Integer
ReDim Used(1 To iPopSize) As Integer
NextMember = 1
End If

For i = 1 To iPopSize
If Used(i) = 0 Then
SetMembers(NextMember) = i
If NextMember <> iSetSize Then
Used(i) = True
AddPermutation , , NextMember + 1
Used(i) = False
Else
SavePermutation SetMembers()
End If
End If
Next i

If NextMember = 1 Then
SavePermutation SetMembers(), True
Erase SetMembers
Erase Used
End If

End Sub 'AddPermutation


Private Sub AddCombination(Optional PopSize As Integer = 0, _
Optional SetSize As Integer = 0, _
Optional NextMember As Integer = 0, _
Optional NextItem As Integer = 0)

Static iPopSize As Integer
Static iSetSize As Integer
Static SetMembers() As Integer
Dim i As Integer

If PopSize <> 0 Then
iPopSize = PopSize
iSetSize = SetSize
ReDim SetMembers(1 To iSetSize) As Integer
NextMember = 1
NextItem = 1
End If

For i = NextItem To iPopSize
SetMembers(NextMember) = i
If NextMember <> iSetSize Then
AddCombination , , NextMember + 1, i + 1
Else
SavePermutation SetMembers()
End If
Next i

If NextMember = 1 Then
SavePermutation SetMembers(), True
Erase SetMembers
End If

End Sub 'AddCombination


Private Sub SavePermutation(ItemsChosen() As Integer, _
Optional FlushBuffer As Boolean = False)

Dim i As Integer, sValue As String
Static RowNum As Long, ColNum As Long

If RowNum = 0 Then RowNum = 1
If ColNum = 0 Then ColNum = 1

If FlushBuffer = True Or BufferPtr = UBound(Buffer()) Then
If BufferPtr > 0 Then
If (RowNum + BufferPtr - 1) > Rows.Count Then
RowNum = 1
ColNum = ColNum + 1
If ColNum > 256 Then Exit Sub
End If

Results.Cells(RowNum, ColNum).Resize(BufferPtr, 1).Value _
= Application.WorksheetFunction.Transpose(Buffer())
RowNum = RowNum + BufferPtr
End If

BufferPtr = 0
If FlushBuffer = True Then
Erase Buffer
RowNum = 0
ColNum = 0
Exit Sub
Else
ReDim Buffer(1 To UBound(Buffer))
End If

End If

'construct the next set
For i = 1 To UBound(ItemsChosen)
sValue = sValue & ", " & vAllItems(ItemsChosen(i), 1)
Next i

'and save it in the buffer
BufferPtr = BufferPtr + 1
Buffer(BufferPtr) = Mid$(sValue, 3)
End Sub 'SavePermutation



Example:
A1: P or C , P = Permutations; C = Combination
A2: Choose number i.e. 1 , 2 , 3 , 4
A3: A6 , data i.e a, b, c, d

Run ListPermutations

ALe
07-26-2006, 08:14 AM
great!

thanx

makako
12-04-2006, 02:56 PM
sorry, wrong post