Pairs, Triplets, Quads...

[Mike NG]

I know this isn't strictly an excel problem, but there may be some neat
way of doing it

I have an array of characters Chars(cSize) - upper limit being
controlled by a constant. Let's say cSize is 5 and the array contains A
B C D E

I need to output Pairs, Triplets, Quads... dynamically depending on the
value of cSize, e.g.

Pairs
AB AC AD AE BC BD BE CD DE DE

Triplets
ABC ABD ABE BCD BCE CDE

Quads
ABCD ABCE BCDE


Pairs are easy as this will always be
for i = 1 to cSize - 1
for j = i+1 to cSize
msgbox chars(i)&chars(j)
next
next

Triples are similar
for i = 1 to cSize - 2
for j = i+1 to cSize -1
for k = j+1 to cSize
msgbox chars(i)&chars(j)&chars(k)
next
next
next

and so on

I don't really want to be coding for all eventualities, so is there any
way of making this general?

 

[Mike NG]

I know this isn't strictly an excel problem, but there may be some neat
way of doing it

I have an array of characters Chars(cSize) - upper limit being
controlled by a constant. Let's say cSize is 5 and the array contains A
B C D E

I need to output Pairs, Triplets, Quads... dynamically depending on the
value of cSize, e.g.

Pairs
AB AC AD AE BC BD BE CD DE DE

Triplets
ABC ABD ABE BCD BCE CDE

Quads
ABCD ABCE BCDE


Pairs are easy as this will always be
for i = 1 to cSize - 1
for j = i+1 to cSize
msgbox chars(i)&chars(j)
next
next

Triples are similar
for i = 1 to cSize - 2
for j = i+1 to cSize -1
for k = j+1 to cSize
msgbox chars(i)&chars(j)&chars(k)
next
next
next

and so on

I don't really want to be coding for all eventualities, so is there any
way of making this general?

I've just had a thought how to do this, but I just need a bit of help
with binary manipulation....

If I allocate each element a binary digit and count up

A B C D E
0 0 0 0 0 - no bits set, not a valid pair
0 0 0 0 1 - 1 bit set, not a valid pair
0 0 0 1 0 - 1 bit set, not a valid pair
0 0 0 1 1 - 2 bits set, a valid pair
0 0 1 0 0 - 1 bit set, not a valid pair
0 0 1 0 1 - 2 bits set, a valid pair
0 0 1 1 0 - 2 bits set, a valid pair
0 0 1 1 1 - 3 bits set, not a valid pair

Obviously I will be counting up in base 10, so how do I detect the
number of "on Bits" in the value

 

[Mike NG]

Obviously I will be counting up in base 10, so how do I detect the number
of "on Bits" in the value

I found this function written by Chip Pearson which will do the trick

Function DecToBin(D As String) As String
Dim N As Long
Dim Res As String
For N = 31 To 1 Step -1
Res = Res & IIf(CLng(D) And 2 ^ (N - 1), "1", "0")
Next N
N = InStr(1, Res, "1")
DecToBin = Mid(Res, IIf(N > 0, N, Len(Res)))
End Function

 

[Dana DeLouis]

Hi. Just throwing this out. Is ACD & ACE etc. valid for triplets?
How about ABDE etc. for Quads?

 

[Mike NG]

Hi. Just throwing this out. Is ACD & ACE etc. valid for triplets?
How about ABDE etc. for Quads?

Sorry yes they are

Thinking about this, binary may not be an ideal solution cos of the
upper limit on longs

 

[Tushar Mehta]

This is probably best done through a recursive routine. While I find
them easy to write, I also find mapping the recursive routine's output
onto a (non-recursive) medium (worksheet/paper/whatever) the difficult
part.

The following should do the job:

--
Regards,

Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions

 

[Tushar Mehta]

This is probably best done through a recursive routine. While I find
them easy to write, I also find mapping the recursive routine's output
onto a (non-recursive) medium (worksheet/paper/whatever) the difficult
part.

The following should do the job:

Option Explicit
Function ArrLen(Arr)
ArrLen = UBound(Arr) - LBound(Arr) + 1
End Function
Function FirstEmptyCol(FirstCell As Range) As Byte
If IsEmpty(FirstCell.Value) Then
FirstEmptyCol = FirstCell.Column
ElseIf IsEmpty(FirstCell.Offset(0, 1).Value) Then
FirstEmptyCol = FirstCell.Column + 1
Else
FirstEmptyCol = FirstCell.End(xlToRight).Offset(0, 1).Column
End If
End Function
Sub doOneLevel(ByVal preString As String, _
FirstElementIdx As Byte, Arr() As String, FirstCell As Range)
Dim I As Byte, CellIdx As Byte
If FirstElementIdx > UBound(Arr) Then
Else
CellIdx = FirstEmptyCol(FirstCell) - 1
For I = FirstElementIdx To UBound(Arr)
FirstCell.Offset(0, CellIdx).Value = preString & Arr(I)
CellIdx = CellIdx + 1
doOneLevel preString & Arr(I), I + 1, _
Arr(), FirstCell.Offset(1, 0)
Next I
End If
End Sub
Sub getGoing()
Dim Arr(0 To 4) As String
Arr(0) = "A": Arr(1) = "B": Arr(2) = "C": Arr(3) = "D":
Arr(4) = "E"
doOneLevel "", 0, Arr(), ActiveSheet.Cells(1, 1)
End Sub

I also tested it with 6 elements A..F

--
Regards,

Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions

 

[Mike NG]

This is probably best done through a recursive routine. While I find
them easy to write, I also find mapping the recursive routine's output
onto a (non-recursive) medium (worksheet/paper/whatever) the difficult
part.

Ah that wasn't really necessary!

The following should do the job:

Very neat thank you

I also tested it with 6 elements A..F

However I will need to convert this to use memory, since A..I blows it
away as it tries to go beyond the edge of the spreadsheet

 

[Tushar Mehta]

Ah that wasn't really necessary!


Very neat thank you
You are welcome.

However I will need to convert this to use memory, since A..I blows it
away as it tries to go beyond the edge of the spreadsheet

Switching row and column references shouldn't be that difficult. ;-)
Watch out for those 'Byte's

--
Regards,

Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions

 

[Tushar Mehta]

Actually, A..I doesn't 'blow it away.' The number of combinations for
each possible combination is given by COMBIN(9,i) for i=1..9 and the
largest value is 126.

What must have happened is that you ran the code for multiple
combinations one after the other. You have to clear the activesheet's
cell(1,1)'s currentregion before running the main routine.

Also, the main routine can be cleaned up a bit with
Sub getGoing()
'Dim Arr(0 To 5) As String
'Arr(0) = "A": Arr(1) = "B": Arr(2) = "C"
'Arr(3) = "D": Arr(4) = "E": Arr(5) = "F"
Dim Arr() As String
Arr = Split("A,B,C,D,E,F,G,H,I", ",")
doOneLevel "", 0, Arr(), ActiveSheet.Cells(1, 1)
End Sub

Though, now, it only works with VB6 (XL2000 or higher).

--
Regards,

Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions

 

[Mike NG]

Actually, A..I doesn't 'blow it away.' The number of combinations for
each possible combination is given by COMBIN(9,i) for i=1..9 and the
largest value is 126.

Yes sorry

What must have happened is that you ran the code for multiple
combinations one after the other. You have to clear the activesheet's
cell(1,1)'s currentregion before running the main routine.

Yes that was the problem

Also, the main routine can be cleaned up a bit with
Sub getGoing()
'Dim Arr(0 To 5) As String
'Arr(0) = "A": Arr(1) = "B": Arr(2) = "C"
'Arr(3) = "D": Arr(4) = "E": Arr(5) = "F"
Dim Arr() As String
Arr = Split("A,B,C,D,E,F,G,H,I", ",")
doOneLevel "", 0, Arr(), ActiveSheet.Cells(1, 1)
End Sub

Though, now, it only works with VB6 (XL2000 or higher).

That's what I have here