"Ordered power set" / "Graph coloring" sets

Question

I want the following to be done in Ocaml but an answer in ex F# could give me enough insight to do the conversion myself.

An ordered power set (from biggest set to the smallest) would make me one step further the problem below which is want I ideally want to be solved.

For a inefficient graph coloring, I need a function which gives me the following:

f({a,b,c,d}):

{{a,b,c,d}}
{{a,b,c},{d}}
{{a,b,d},{c}}
{{a,c,d},{b}}
{{b,c,d},{a}}
{{a,b},{c,d}}
{{a,c},{b,d}}
{{a,d},{b,c}}
{{a},{b,c},{d}}
{{a},{b},{c,d}}
{{a},{b,d},{c}}
...
{{a},{b},{c},{d}}

as a list of sets (or better, as a lazy list/enum of sets)

So I want all variables to be represented in some set. But I want it ordered so I get the one with fewest sets first and the one where all variables is in a set last.

I've one solution which is something like this: f: Take powerset -> iterate -> apply f on the rest <- sort the whole list of possibilities

But I would like to avoid sorting an exponential list. And hopefully I can do it with a lazy list so I avoid iterating all possibilities.

Answer 1

Here's an updated solution, given that the order of subsets is unimportant:

let rec splits = function
| [] -> Seq.singleton([],[])
| x::xs ->
    seq { 
        for l1,l2 in splits xs do
            yield x::l1,l2
            yield l1,x::l2
    }

let parts =
    let rec parts' = function
    | 0,[] -> Seq.singleton []
    | _,[] -> Seq.empty
    | 1,l -> Seq.singleton [l]
    | n,x::xs ->
        seq {
            for l1,l2 in splits xs do
            for p in parts'(n-1, l2) do
                yield (x::l1)::p
        }
    fun l -> seq { 
        for k = 1 to List.length l do 
            yield! parts'(k,l) 
    }

The idea here is pretty straightforward. The splits function gives all ways to partition a list into two sets. Then to calculate the set of partitions of a list x::xs we could go through each split of xs into l1,l2, and for each partition of l2, add x::l1 in front.

However, this won't meet your ordering requirement, so we break the problem down just a little bit further, and use the nested function part' to calculate the partitions of a list l into exactly n pieces. Then we just need to iterate through these lists of partitions in order.

Answer 2

let rec comb n l =
  match n, l with
  | 0, _  -> [[]]
  | _, [] -> []
  | n, x::xs -> List.map (fun l -> x ::l) (comb (n - 1) xs) @ (comb n xs)

let listToSingleSetSet xs = List.map (Set.singleton) xs |> set

let set_2Item_merge (set_set:Set<Set<'T>>) =
  seq {
    let arX = Set.toArray set_set
    let choice_list = comb 2 [0..(arX.Length-1)]
    for [x; y] in choice_list do
      yield begin
        set_set
        |> Set.remove arX.[x]
        |> Set.remove arX.[y]
        |> Set.add (arX.[x] + arX.[y])
      end
  }

let partitions xs =
  let set_set = listToSingleSetSet xs
  let rec aux sq =
    let x = Seq.head sq
    if Set.count x = 1
    then
      Seq.singleton x
    else
      Seq.append sq (Seq.map set_2Item_merge sq |> Seq.concat |> Seq.distinct |> aux)
  aux <| Seq.singleton set_set

DEMO

> partitions ['a'..'d'] |> Seq.iter (printfn "%A");;
set [set ['a']; set ['b']; set ['c']; set ['d']]
set [set ['a'; 'b']; set ['c']; set ['d']]
set [set ['a'; 'c']; set ['b']; set ['d']]
set [set ['a'; 'd']; set ['b']; set ['c']]
set [set ['a']; set ['b'; 'c']; set ['d']]
set [set ['a']; set ['b'; 'd']; set ['c']]
set [set ['a']; set ['b']; set ['c'; 'd']]
set [set ['a'; 'b'; 'c']; set ['d']]
set [set ['a'; 'b'; 'd']; set ['c']]
set [set ['a'; 'b']; set ['c'; 'd']]
set [set ['a'; 'c'; 'd']; set ['b']]
set [set ['a'; 'c']; set ['b'; 'd']]
set [set ['a'; 'd']; set ['b'; 'c']]
set [set ['a']; set ['b'; 'c'; 'd']]
set [set ['a'; 'b'; 'c'; 'd']]
val it : unit = ()

If you want reverse seq then ...

Seq.append sq (Seq.map set_2Item_merge sq |> Seq.concat |> Seq.distinct |> aux)

change to

Seq.append (Seq.map set_2Item_merge sq |> Seq.concat |> Seq.distinct |> aux) sq

result:

set [set ['a'; 'b'; 'c'; 'd']]
set [set ['a'; 'b'; 'c']; set ['d']]
set [set ['a'; 'b'; 'd']; set ['c']]
set [set ['a'; 'b']; set ['c'; 'd']]
set [set ['a'; 'c'; 'd']; set ['b']]
set [set ['a'; 'c']; set ['b'; 'd']]
set [set ['a'; 'd']; set ['b'; 'c']]
set [set ['a']; set ['b'; 'c'; 'd']]
set [set ['a'; 'b']; set ['c']; set ['d']]
set [set ['a'; 'c']; set ['b']; set ['d']]
set [set ['a'; 'd']; set ['b']; set ['c']]
set [set ['a']; set ['b'; 'c']; set ['d']]
set [set ['a']; set ['b'; 'd']; set ['c']]
set [set ['a']; set ['b']; set ['c'; 'd']]
set [set ['a']; set ['b']; set ['c']; set ['d']]

Answer 3

Here is a quick idea.

One well-known trick to lazily generate the powerset of a set of size N is to iterate each number from 0 to (2^N)-1, considering its binary representation. Each iteration produces a partition : you put the i-th element of the set in the current partition if the i-th digit of the current number is 1.

You can do the same in your case: a partition of P is given not by a binary number below 2^N, but by a number below N^N, in base N. Now the trick to get the partitions with the fewest component first is:

• first iterate upto 2^N (this gives you the partitions of 2 components)
• then iterate upto 3^N, rejecting the numbers that don't have both a 0, a 1 and a 2 in their representation (this rules out the previously produced partitions)
• then iterate upto 4^N, taking only numbers with all 4 distinct digits
• etc... upto N^N

Obviously this makes you manipulate quite large numbers. You do not need to encode them as integers/bignum. For example in the powerset case, a list of booleans is just as good. The same idea could be reused in the partition case. Moreover, the K-ary representation of two consecutive numbers are close, so you can probably cache some information to get a more efficient algorithm:

• you can cache a part of your current partitioning (say, you could represent the current partition as an array of lists, and just destructively update the few digits that change)
• you can cache the information of which digits are currently present in the number (to know quickly if you have already seen such a number in a previous iteration)

Quite naive and no code to propose yet, sorry, but I hope my idea is clear and you can make something useful out of it. People That Know certainly have more direct ideas.

In particular there may be a clever way to know if a number below K^N uses all K digits its K-ary representation. For example, you know that no number below K^(K-1) does (they have less than K distinct digits).