<< 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
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 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 is written for PowerBasic PBCC  and can easily 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 PBMain
  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