How to List All Multisubsets of a Multiset
A multiset is an unordered collection of items where – unlike with a set – an item can repeat. For example (we will indicate the items by letters),a a b b b c c d d d
The order of the items doesn’t matter.
Problem: Given a multiset find all its multisubsets, that is, all multisets that can be made from its items:a c d
b b b c
a c c d d
etc.
The key to the solution is a certain way of representing multisets. First group the same items together, which can be done by putting them in alphabetical order as above. After doing that the multiset can be represented by the successive counts of items. In the example above the ten items come in four blocks, 2 3 2 3
two A’s, three B’s, two C’s, and three D’s.
Then we can use four numbers r1, r2, r3, r4 to represent a multisubset, where each number goes independently from 0 to the corresponding value above: r1 goes from 0 to 2, r2 from 0 to 3, etc.
The total number of multisets will be (n1 + 1)(n2 + 1) ... where n* represents the original multiset. In our example the total number is 3·4·3·4 = 144.
This generalizes the following problem: given a set (where there are no duplicates) find all subsets of it. Say there are n items in the set. A subset either includes an item or it doesn’t, so it can be represented by a string of length n consisting of 1’s and 0’s. The original set is represented by 1, 1, ... 1 n times. The total number of subsets is 2n.
The program below can be modified for PBWin, Visual Basic, FORTRAN and any other BASIC-like compiler.
Global nblock As Long 'number of blocks in the original multisubset
Global rep0() As Long 'representation of original multiset
'Given the representation of a multisubset, return the multisubset.
Function ConvertToMultiset(rep() As Long) As String
Local i, k As Long, a As String
For i = 1 To nblock
a = a + String$(rep(i), Chr$(97 + k)) '97 = Asc("a")
Incr k
Next
If a = "" Then a = "{}"
Function = a
End Function
'-----------------------------------------------------------------
'Given rep(), increment it and return whether it differs from rep0()
Function IncrMultiset(rep() As Long) As Long 'rep() passed by reference
Local i As Long
For i = nblock To 1 Step -1
If rep(i) < rep0(i) Then
Incr rep(i)
Exit For
Else
rep(i) = 0
End If
Next
Function = (i >= 1) 'changed?
End Function
'-----------------------------------------------------------------
Function Main
Local rep() As Long 'representation of the current submultiset
Local counter As Long 'number of submultisets
Local s As String 'the original string
Local n As Long 'length of s
Local i, j As Long 'general indices
Local u, v As Long 'general values
s = "acab" 'change to suit
n = Len(s)
Dim item(n) As Long 's as an ascii array
For i = 1 To n
item(i) = Asc(s,i)
Next
Array Sort item(1) 'insure that repeated items are together
'Represent a b b b c c d d d for example
' by 1 3 2 3 (one A, three B's, two C's, three D's)
Dim rep0(n) 'original multiset, highest possible value of nblock is n
v = -1 'a non item
nblock = 0 'determine number of blocks of repeated items
For i = 1 To n
u = item(i)
counter = 0
If u = v Then Iterate 'already counted
For j = 1 To n
If item(j) = u Then Incr counter
Next
v = u
Incr nblock
rep0(nblock) = counter
Next
Print s
Print ConvertToMultiset(rep0()) 's in order
'Start rep() at 0 0 0 ... 0, increment until it equals rep0()
Dim rep(nblock) As Long
Print "-----------------" :Print
counter = 0
Do
For i = 1 To nblock
Print Format$(rep(i));
Next
Print " ";
Print ConvertToMultiset(rep())
Incr counter
Loop While IncrMultiset(rep())
Print : Print "-----------------"
Print "count: "; counter
WaitKey$
End Function