"有序功率集"/"图形着色"设置

Question

我希望在Ocaml中完成以下操作,但是前F#中的答案可以让我有足够的洞察力来自己进行转换.

一个有序的电源组(从最大设置到最小设置)将使我更进一步解决下面的问题,我希望理想地想要解决.

对于效率低下的图形着色,我需要一个函数,它给出了以下内容:

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

作为集合的列表(或更好,作为集合的惰性列表/枚举)

所以我想要在一些集合中表示所有变量.但是我希望它有序,所以我得到的是最先设置最少的那个,以及所有变量最后都设置的那个.

我有一个解决方案是这样的: f: Take powerset -> iterate -> apply f on the rest <- sort the whole list of possibilities

但我想避免排序指数列表.希望我可以用懒惰的列表来做到这一点,所以我避免迭代所有可能性.

Answer 1

这是一个更新的解决方案,因为子集的顺序并不重要:

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) 
    }

这里的想法很简单.该splits函数提供了将列表分为两组的所有方法.然后,为了计算列表的分区集,x::xs我们可以通过每个分区xs进入l1,l2,并为每个分区l2添加x::l1前面.

但是,这不符合您的订购要求,因此我们将问题进一步解决,并使用嵌套函数part'将列表的分区计算l成精确的n部分.然后我们只需按顺序遍历这些分区列表.

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

演示版

> 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 = ()

如果你想要反向序列那么......

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

改成

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

结果：

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']]