<< Computer Algorithms
Use  Ctrl +  or    to enlarge or reduce text size.

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 doesnt 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

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 As, three Bs, two Cs, and three Ds.

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  3434 = 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 doesnt, so it can be represented by a string of length  n  consisting of 1s and 0s. 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
  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
      rep(i) = 0
    End If
  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)
  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
    v = u
    Incr nblock
    rep0(nblock) = counter

  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
    For i = 1 To nblock
      Print Format$(rep(i));
    Print "  ";
    Print ConvertToMultiset(rep())
    Incr counter
  Loop While IncrMultiset(rep())
  Print : Print "-----------------"
  Print "count: "; counter

End Function