Generating partitions of a set (given a string)

[Rssilon6]

MS Excel, 2002.

I'm trying to get a macro to write all possible partitions of a set of elements, where the elements are given as a string of letters.

I've searched and found a small number of posts that refer to _breaking_ a word, line, sentence, etc. into two parts by simply chopping it somewhere in the middle. But I need different _permutations_ of elements at the same time.

The input will be strings of letters with no repeats, and the letters should be partitioned into two (non-empty) sets. Find all such partitions.

Example: Given a cell containg the letters ABCD, the output should be (in two columns)

A | BCD
B | ACD
C | ABD
D | ABC
AB | CD
AC | BD
AD | BC

We can stop here because a partition such as "BC | AD" is equivalent to "AD | BC"; that is, it doesn't matter which set is on the left and which is on the right. Also, order does not matter within a set, so that on the first line, "BCD" could be written as "BDC" or any other permutation.

Strings may be any length. As a further example, given the input "ABCDE", there should be 15 partitions generated:

A | BCDE
B | ACDE
C | ABDE
D | ABCE
E | ABCD
AB | CDE
AC | BDE
AD | BCE
AE | BCD
BC | ADE
BD | ACE
BE | ACD
CD | ABE
CE | ABD
DE | ABC

 

[tusharm]

I believe what you want is addressed by
Power Set
http://www.tushar-mehta.com/excel/tips/powerset.html

 

[Rssilon6]

The issue appears to be addressed there, and some VBA code is given. But after looking at it and tinkering with it, I never could get it to work. At this point, I confess that I'm not very fluent in VBA (but at least I gave it a try). Can anyone clear it up for me? Ideally, I want it to simply read the given string from a fixed cell, and then print the list of partitions (each partition consists of two parts) in two columns.

 

[pgc01]

Hi Rssilon6

Try this.
It reads the string in B1 and writes the partitions from D2 on.

Option Base 1
Const InCell = "B1"
Const OutRange = "D1"

' Writes 2 partitions of a string
Sub PartitionString2()
Dim sStr As String, sStrChr(), iComb()
Dim iRow As Long, iCol As Long

' Splits string in chars
sStr = Range(InCell).Value ' Reads string
ReDim sStrChr(Len(sStr))
For i = 1 To UBound(sStrChr)
    sStrChr(i) = Mid(sStr, i, 1)
Next

' Init output Range
iRow = Range(OutRange).Row
iCol = Range(OutRange).Column

' Calculates the partitions
For i = 1 To Int(UBound(sStrChr) / 2)
    ReDim iComb(i)
    Call InitComb(iComb)
    Do While True
        Call GetNextComb(iComb, Len(sStr))
        If iComb(1) = 0 Or ((i = UBound(sStrChr) / 2) And (iComb(1) <> 1)) Then Exit Do
        Call writePartition2(iComb, sStrChr, iRow, iCol)
    Loop
Next

End Sub

' Inits the combinations array
Sub InitComb(iComb)
Dim i As Integer

    For i = 1 To UBound(iComb) - 1
        iComb(i) = i
    Next
    iComb(i) = i - 1
End Sub

' Gets the next combination
Sub GetNextComb(iComb, ByVal n As Integer)
    
    For i = UBound(iComb) To 1 Step -1
        If iComb(i) < n - (UBound(iComb) - i) Then
            iComb(i) = iComb(i) + 1
            For j = i + 1 To UBound(iComb)
                iComb(j) = iComb(j - 1) + 1
            Next
            Exit Sub
        End If
    Next
    iComb(1) = 0

End Sub

Sub writePartition2(iComb, sStrChr, ByRef iRow As Long, ByVal iCol As Long)
Dim sP As String
        
' Write first part
sP = ""
For i = 1 To UBound(iComb)
    sP = sP & sStrChr(iComb(i))
Next
Cells(iRow, iCol) = sP

' Write second part
sP = ""
For i = 1 To UBound(sStrChr)
    For j = 1 To UBound(iComb)
        If iComb(j) = i Then Exit For
    Next
    If j = UBound(iComb) + 1 Then sP = sP & sStrChr(i)
    Next
Cells(iRow, iCol + 1) = sP
iRow = iRow + 1
End Sub

 

[pgc01]

I meant:

It reads the string in B1 and writes the partitions from D1 on.
(You can change the constants ant the beginning)

 

[Rssilon6]

Perfect! That did exactly what I needed it to. Thank you very much (to both).