Permutation calculations and displays
Woodbowls
possible permutations of a set of figures, e.g any 4 from 10 etc. I am aware of
the PERMUT function but I cannot get a printout of the combinations of figures,
only a statement of the number of perms. Can anyone give a step by step idiots
guide to help me? Many thanks
wood...@aol.com
Harlan Grove
wood...@aol.com (Woodbowls) wrote:
If you're aware of Excel's PERMUT function, you should be aware that
PERMUT(10,4) = 5040, the number of all such permutations. This would be
ideally handled using three VBA functions - one to generate all the
unordered combinations of k items drawn from n, two to generate all the
permutations of k items, and three to combine the other two.
One: the algorithm I learned was recursive: to produce all combinations
of k items from A[1..n], for i from 1 to n-k+1, append A[i] to all
combinations of k-1 items from A[i+1..n].
Two: working with integers 1..k, if k = 1 the only permutation is {1}.
If k = 2, the permutations are {(1,2), (2,1)}. This leads to another
recursive algorithm: for permutations if 1..k, insert k before, between
all, and after each item in each permutation of 1..k-1. Graphically,
note that all permutations of 2 are
1 2
2 1
then all permutations of 3 are
3 1 2
3 2 1
1 3 2
2 3 1
1 2 3
2 1 3
and all permutations of 4 are
4 3 1 2 3 1 4 2
4 3 2 1 3 2 4 1
4 1 3 2 1 3 4 2
4 2 3 1 2 3 4 1
4 1 2 3 1 2 4 3
4 2 1 3 2 1 4 3
3 4 1 2 3 1 2 4
3 4 2 1 3 2 1 4
1 4 3 2 1 3 2 4
2 4 3 1 2 3 1 4
1 4 2 3 1 2 3 4
2 4 1 3 2 1 3 4
Handling intermediate array results from recursive functions is a
nontrivial task in Excel, so I'm stumped for now. However, maybe you or
someone else can render these in VBA more quickly than I.
Sent via Deja.com http://www.deja.com/
Share what you know. Learn what you don't.
Harlan Grove
Harlan Grove <Hrl...@aol.com> wrote:
>In article <19990728155550...@ng-fa1.aol.com>,
> wood...@aol.com (Woodbowls) wrote:
>
>>I am a new user of Excel 5. I would like to get the programme to print
>>all possible permutations of a set of figures, e.g any 4 from 10 etc.
>>I am aware of the PERMUT function but I cannot get a printout of the
>>combinations of figures, only a statement of the number of perms. Can
>>anyone give a step by step idiots guide to help me? Many thanks
>
>If you're aware of Excel's PERMUT function, you should be aware that
>PERMUT(10,4) = 5040, the number of all such permutations. This would be
>ideally handled using three VBA functions - one to generate all the
>unordered combinations of k items drawn from n, two to generate all the
>permutations of k items, and three to combine the other two.
Bad form to reply to myself. Appologies, but here's a function that
generates all permutations of the integers from 1 to n. These could be
used as indices into any array with n entries. I did this just out of
curiousity (OK, also to show I'm not BS-ing), but I'd recommend no one
use this. There are over 40,000 permutations of just 8 items, and over
360,000 of just 9 items. You'll blow through RAM plus your paging file
when n exceeds 12.
[Real statisticians and number theory types avoid churning through all
permutations precisely because it can involve astronomical storage and
processing time for fairly small sets.]
Now I get to try generating all unordered combinations of k items drawn
from n items w/o replacement.
Function Permutations(n As Integer) As Variant
Dim P() As Integer, Q As Variant
Dim i As Integer, j As Integer, k As Integer, m As Long
ReDim P(1 To Application.WorksheetFunction.Fact(n), 1 To n)
If n = 1 Then
P(1, 1) = 1
Else
Q = Permutations(n - 1)
m = Application.WorksheetFunction.Fact(n - 1)
For i = 1 To n
For j = 1 To m
For k = 1 To n
If k < i Then
P((i - 1) * m + j, k) = Q(j, k)
ElseIf k = i Then
P((i - 1) * m + j, k) = n
Else
P((i - 1) * m + j, k) = Q(j, k - 1)
End If
Next k
Next j
Next i
End If
Permutations = P
End Function
Leo Heuser
This is one way of doing it.
Best regards
LeoH
Sub CombinationsFromString()
'leo.h...@get2net.dk August 1999
Dim DestRange As Object
Dim CountOff()
Dim MaxOff()
Dim CombString As String
Dim NewComb As String
Dim NumOfComb As Long
Dim Dummy
Dim SubSet As Long
Dim LenCombString As Long
Dim Counter1 As Long
Dim Counter2 As Long
CombString = "abcdefghijkl"
SubSet = 8
LenCombString = Len(CombString)
NumOfComb = Application.Combin(LenCombString, SubSet)
ReDim CountOff(SubSet)
ReDim MaxOff(SubSet)
For Counter1 = 1 To SubSet
CountOff(Counter1) = Counter1
MaxOff(Counter1) = LenCombString - SubSet + Counter1
Next Counter1
Worksheets.Add
Set DestRange = Range("a1")
For Counter1 = 1 To NumOfComb
NewComb = ""
For Counter2 = 1 To SubSet
NewComb = NewComb & Mid$(CombString, CountOff(Counter2), 1)
Next Counter2
DestRange.Offset(Counter1 - 1) = NewComb
CountOff(SubSet) = CountOff(SubSet) + 1
Dummy = SubSet
While Dummy > 1
If CountOff(Dummy) > MaxOff(Dummy) Then
CountOff(Dummy - 1) = CountOff(Dummy - 1) + 1
For Counter2 = Dummy To SubSet
CountOff(Counter2) = CountOff(Counter2 - 1) + 1
Next Counter2
End If
Dummy = Dummy - 1
Wend
Next Counter1
End Sub
Sub CombinationsFromRange()
'leo.h...@get2net.dk August 1999
Dim DestRange As Object
Dim CountOff()
Dim MaxOff()
Dim CombString As Variant
Dim SepChar As String
Dim NewComb As String
Dim NumOfComb As Long
Dim Dummy
Dim SubSet As Long
Dim NumOfElements As Long
Dim Counter1 As Long
Dim Counter2 As Long
CombString = Range("A1:A13").Value
SubSet = 8
SepChar = ","
NumOfElements = UBound(CombString)
NumOfComb = Application.Combin(NumOfElements, SubSet)
ReDim CountOff(SubSet)
ReDim MaxOff(SubSet)
For Counter1 = 1 To SubSet
CountOff(Counter1) = Counter1
MaxOff(Counter1) = NumOfElements - SubSet + Counter1
Next Counter1
Worksheets.Add
Set DestRange = Range("a1")
For Counter1 = 1 To NumOfComb
NewComb = ""
For Counter2 = 1 To SubSet
NewComb = NewComb & CombString(CountOff(Counter2), 1) & SepChar
Next Counter2
DestRange.Offset(Counter1 - 1) = Left(NewComb, Len(NewComb) - Len(SepChar))
CountOff(SubSet) = CountOff(SubSet) + 1
Dummy = SubSet
While Dummy > 1
If CountOff(Dummy) > MaxOff(Dummy) Then
CountOff(Dummy - 1) = CountOff(Dummy - 1) + 1
For Counter2 = Dummy To SubSet
CountOff(Counter2) = CountOff(Counter2 - 1) + 1
Next Counter2
End If
Dummy = Dummy - 1
Wend
Next Counter1
End Sub
-------------------------------------
Harlan Grove skrev i meddelelsen <7o0qal$d6s$1...@nnrp1.deja.com>...
Leo Heuser
Combining (NPI) one of the below combination routines with one
of the permutation routines will do the job.
*All* combinations and permutations are found, which means, that if any duplicates exist
in the string(s), you will have duplicates in the solution as well.
Best regards
LeoH
ReDim CountOff(SubSet)
ReDim MaxOff(SubSet)
ReDim CountOff(SubSet)
ReDim MaxOff(SubSet)
Sub PermutationsFromString()
'leo.h...@get2net.dk August 1999
Dim DestRange As Object
Dim PermString As String
Dim LenPermString As Integer
Dim NumOfPerm As Double
Dim Factorial(1 To 13)
Dim Counter1 As Long
Dim Counter2 As Long
Dim Rotate As Integer
Dim Dummy
'Max 13 elements in PermString
PermString = "abcde"
LenPermString = Len(PermString)
NumOfPerm = Application.Fact(LenPermString)
For Counter1 = 1 To LenPermString
Factorial(Counter1) = Application.Fact(LenPermString - Counter1)
Next Counter1
Worksheets.Add
Set DestRange = Range("a1")
DestRange.Value = PermString
For Counter1 = 2 To NumOfPerm
If Counter1 / 2 = Int(Counter1 / 2) Then
Rotate = LenPermString - 1
Else
For Counter2 = 1 To LenPermString - 2
If Counter1 Mod Factorial(Counter2) = 1 Then
Rotate = Counter2
Exit For
End If
Next Counter2
End If
For Counter2 = 1 To Int((LenPermString - Rotate + 1) / 2)
Dummy = Mid$(PermString, Rotate + Counter2 - 1, 1)
Mid$(PermString, Rotate + Counter2 - 1, 1) = Mid$(PermString, Len(PermString) - Counter2 + 1, 1)
Mid$(PermString, LenPermString - Counter2 + 1, 1) = Dummy
Next Counter2
DestRange.Offset(Counter1 - 1) = PermString
Next Counter1
Set DestRange = Nothing
End Sub
'If the below line is used instead of the Mod-line
'Factorial can be dimensioned as (1 to 19), giving max 19 elements
'but who cares :-)
'If Counter1 - Int(Counter1 / Factorial(Counter2)) * Factorial(Counter2) = 1 Then
Sub PermutationsFromRange()
'leo.h...@get2net.dk August 1999
Dim DestRange As Object
Dim PermString As Variant
Dim NewPerm As String
Dim SepChar As String
Dim NumOfElements As Integer
Dim NumOfPerm As Double
Dim Factorial(1 To 13)
Dim Counter1 As Long
Dim Counter2 As Long
Dim Rotate As Integer
Dim Dummy
'Max 13 elements in PermString
PermString = Range("A1:A4")
SepChar = ","
NumOfElements = UBound(PermString)
NumOfPerm = Application.Fact(NumOfElements)
For Counter1 = 1 To NumOfElements
Factorial(Counter1) = Application.Fact(NumOfElements - Counter1)
Next Counter1
Worksheets.Add
Set DestRange = Range("a1")
For Counter1 = 1 To NumOfElements
NewPerm = NewPerm & PermString(Counter1, 1) & SepChar
Next Counter1
DestRange.Value = Left(NewPerm, Len(NewPerm) - Len(SepChar))
For Counter1 = 2 To NumOfPerm
NewPerm = ""
If Counter1 / 2 = Int(Counter1 / 2) Then
Rotate = NumOfElements - 1
Else
For Counter2 = 1 To NumOfElements - 2
If Counter1 Mod Factorial(Counter2) = 1 Then
Rotate = Counter2
Exit For
End If
Next Counter2
End If
For Counter2 = 1 To Int((NumOfElements - Rotate + 1) / 2)
Dummy = PermString(Rotate + Counter2 - 1, 1)
PermString(Rotate + Counter2 - 1, 1) = PermString(NumOfElements - Counter2 + 1, 1)
PermString(NumOfElements - Counter2 + 1, 1) = Dummy
Next Counter2
For Counter2 = 1 To NumOfElements
NewPerm = NewPerm & PermString(Counter2, 1) & SepChar
Next Counter2
DestRange.Offset(Counter1 - 1) = Left(NewPerm, Len(NewPerm) - Len(SepChar))
Next Counter1
Set DestRange = Nothing
End Sub
'If the below line is used instead of the Mod-line
'Factorial can be dimensioned as (1 to 19), giving max 19 elements
'but who cares :-)
'If Counter1 - Int(Counter1 / Factorial(Counter2)) * Factorial(Counter2) = 1 Then
----------------------------------------------------------------------------------
Woodbowls skrev i meddelelsen <19990728155550...@ng-fa1.aol.com>...
>I am a new user of Excel 5. I would like to get the programme to print all
>possible permutations of a set of figures, e.g any 4 from 10 etc. I am aware of
>the PERMUT function but I cannot get a printout of the combinations of figures,
>only a statement of the number of perms. Can anyone give a step by step idiots
>guide to help me? Many thanks
Harlan Grove
"Leo Heuser" <leo.h...@get2net.dk> wrote:
> This is one way of doing it.
<snip>
<slight reformatting>
> DestRange.Offset(Counter1 - 1) = Left(NewComb, Len(NewComb) - _
Len(SepChar))
> CountOff(SubSet) = CountOff(SubSet) + 1
> Dummy = SubSet
> While Dummy > 1
> If CountOff(Dummy) > MaxOff(Dummy) Then
> CountOff(Dummy - 1) = CountOff(Dummy - 1) + 1
> For Counter2 = Dummy To SubSet
> CountOff(Counter2) = CountOff(Counter2 - 1) + 1
> Next Counter2
> End If
> Dummy = Dummy - 1
> Wend
> Next Counter1
>End Sub
<snip>
Thank you for giving me the opportunity to respond to someone other
than myself. I didn't think this could be done without recursion. Good
job. For completeness, here's my solution implemented as a function
using a private recursive subroutine function. This design allows me to
use Combinations() as a worksheet function without having to worry
about error checking optional arguments needed in recursive calls.
Function Combinations(a As Variant, k As Integer) As Variant
Dim b() As Variant, c() As Variant
If k <= UBound(a) Then
If TypeName(a) = "Range" Then a = a.Value
If k > 1 Then ReDim b(1 To k - 1)
ReDim c(1 To pCombinCount(UBound(a), k), 1 To k)
Combinations = pCombins(a, k, b, c, 1, 1, 1)
Else
Combinations = CVErr(xlErrValue)
End If
End Function
'Wrapper Function
Private Function pCombinCount(n As Integer, k As Integer) As Long
pCombinCount = Application.WorksheetFunction.Combin(n, k)
End Function
Private Function pCombins(ByRef a As Variant, pk As Integer, _
ByRef b As Variant, ByRef c As Variant, m As Integer, s As Integer, _
cn As Long) As Variant
Dim i As Integer, j As Integer, pn As Integer
pn = UBound(a)
For i = s To pn - pk + 1
If pk = 1 Then
For j = 1 To m - 1
c(cn, j) = b(j)
Next j
c(cn, m) = a(i)
cn = cn + 1
Else
b(m) = a(i)
cn = pCombins(a, pk - 1, b, c, m + 1, i + 1, cn)
End If
Next i
If m = 1 Then pCombins = c Else pCombins = cn
Leo Heuser
nobody is likely to interfere with your correspondence :-)
Best regards
LeoH