2008-11-13 98 views
14

受此questionanswer的启发,我如何在F#中创建通用排列算法?谷歌没有给出任何有用的答案。在F中计算排列#

编辑:我提供我的最好的答案下面,但我怀疑托马斯的更好

回答

18

你也可以写这样的事情:

let rec permutations list taken = 
    seq { if Set.count taken = List.length list then yield [] else 
     for l in list do 
      if not (Set.contains l taken) then 
      for perm in permutations list (Set.add l taken) do 
       yield l::perm } 

的“清单”的说法包含了所有你想要置换和“取”的数字是一组包含数字已使用。当所有数字都被采用时,该函数返回空列表。 否则,它遍历所有仍然可用的数字,获取其余数字的所有可能排列(递归地使用'permutations')并在返回(l :: perm)之前将当前数字附加到它们中的每个数字。

要运行这个,你给它一个空集,因为没有数字是在开始时使用:

permutations [1;2;3] Set.empty;; 
+0

FYI - Set.mem已更名为Set.contains – 2010-07-05 14:56:12

+0

@Stephen,我编辑了代码以适合... – Benjol 2011-04-28 05:53:52

1

我的最新最好的答案

//mini-extension to List for removing 1 element from a list 
module List = 
    let remove n lst = List.filter (fun x -> x <> n) lst 

//Node type declared outside permutations function allows us to define a pruning filter 
type Node<'a> = 
    | Branch of ('a * Node<'a> seq) 
    | Leaf of 'a 

let permutations treefilter lst = 
    //Builds a tree representing all possible permutations 
    let rec nodeBuilder lst x = //x is the next element to use 
     match lst with //lst is all the remaining elements to be permuted 
     | [x] -> seq { yield Leaf(x) } //only x left in list -> we are at a leaf 
     | h -> //anything else left -> we are at a branch, recurse 
      let ilst = List.remove x lst //get new list without i, use this to build subnodes of branch 
      seq { yield Branch(x, Seq.map_concat (nodeBuilder ilst) ilst) } 

    //converts a tree to a list for each leafpath 
    let rec pathBuilder pth n = // pth is the accumulated path, n is the current node 
     match n with 
     | Leaf(i) -> seq { yield List.rev (i :: pth) } //path list is constructed from root to leaf, so have to reverse it 
     | Branch(i, nodes) -> Seq.map_concat (pathBuilder (i :: pth)) nodes 

    let nodes = 
     lst          //using input list 
     |> Seq.map_concat (nodeBuilder lst)  //build permutations tree 
     |> Seq.choose treefilter    //prune tree if necessary 
     |> Seq.map_concat (pathBuilder [])  //convert to seq of path lists 

    nodes 

的排列功能的工作原理是构建n元(当然更短!)树代表传入的'事物'列表的所有可能排列,然后遍历树来构造列表列表。使用“Seq”可显着提高性能,因为它会让所有内容都变得懒惰。

排列函数的第二个参数允许调用者在生成路径之前定义一个“修剪”树的过滤器(请参阅下面的示例,我不想要任何前导零)。

一些示例用法:节点<“一>是通用的,所以我们可以做的排列组合 '东西':

let myfilter n = Some(n) //i.e., don't filter 
permutations myfilter ['A';'B';'C';'D'] 

//in this case, I want to 'prune' leading zeros from my list before generating paths 
let noLeadingZero n = 
    match n with 
    | Branch(0, _) -> None 
    | n -> Some(n) 

//Curry myself an int-list permutations function with no leading zeros 
let noLZperm = permutations noLeadingZero 
noLZperm [0..9] 

(特别感谢Tomas Petricek,有任何意见欢迎)

+0

请注意,F#有一个List.permute函数,但这并不是完全相同的事情(我不确定它实际上是什么...) – Benjol 2008-11-13 08:46:58

12

我喜欢这个实现(但不记得它的源):

let rec insertions x = function 
    | []    -> [[x]] 
    | (y :: ys) as l -> (x::l)::(List.map (fun x -> y::x) (insertions x ys)) 

let rec permutations = function 
    | []  -> seq [ [] ] 
    | x :: xs -> Seq.concat (Seq.map (insertions x) (permutations xs)) 
0

看看这个:

http://fsharpcode.blogspot.com/2010/04/permutations.html

let length = Seq.length 
let take = Seq.take 
let skip = Seq.skip 
let (++) = Seq.append 
let concat = Seq.concat 
let map = Seq.map 

let (|Empty|Cons|) (xs:seq<'a>) : Choice<Unit, 'a * seq<'a>> = 
    if (Seq.isEmpty xs) then Empty else Cons(Seq.head xs, Seq.skip 1 xs) 

let interleave x ys = 
    seq { for i in [0..length ys] -> 
      (take i ys) ++ seq [x] ++ (skip i ys) } 

let rec permutations xs = 
      match xs with 
      | Empty -> seq [seq []] 
      | Cons(x,xs) -> concat(map (interleave x) (permutations xs)) 
2

Tomas的解决方案非常优雅:简洁,功能完善,懒惰。我认为它甚至可能是尾递归的。而且,它按照字典顺序产生排列。然而,我们可以在内部使用命令式解决方案提高性能两倍,同时仍然在外部暴露功能性接口。

函数permutations采用通用序列e以及通用比较函数f : ('a -> 'a -> int),并按照字典顺序产生不可变的排列。比较功能允许我们生成不一定comparable元素的排列,也可以轻松指定反向或自定义排序。

内部函数permute是所述算法的必要实现here。转换功能let comparer f = { new System.Collections.Generic.IComparer<'a> with member self.Compare(x,y) = f x y }允许我们使用System.Array.Sort过载,它使用IComparer进行就地子范围自定义排序。

let permutations f e = 
    ///Advances (mutating) perm to the next lexical permutation. 
    let permute (perm:'a[]) (f: 'a->'a->int) (comparer:System.Collections.Generic.IComparer<'a>) : bool = 
     try 
      //Find the longest "tail" that is ordered in decreasing order ((s+1)..perm.Length-1). 
      //will throw an index out of bounds exception if perm is the last permuation, 
      //but will not corrupt perm. 
      let rec find i = 
       if (f perm.[i] perm.[i-1]) >= 0 then i-1 
       else find (i-1) 
      let s = find (perm.Length-1) 
      let s' = perm.[s] 

      //Change the number just before the tail (s') to the smallest number bigger than it in the tail (perm.[t]). 
      let rec find i imin = 
       if i = perm.Length then imin 
       elif (f perm.[i] s') > 0 && (f perm.[i] perm.[imin]) < 0 then find (i+1) i 
       else find (i+1) imin 
      let t = find (s+1) (s+1) 

      perm.[s] <- perm.[t] 
      perm.[t] <- s' 

      //Sort the tail in increasing order. 
      System.Array.Sort(perm, s+1, perm.Length - s - 1, comparer) 
      true 
     with 
     | _ -> false 

    //permuation sequence expression 
    let c = f |> comparer 
    let freeze arr = arr |> Array.copy |> Seq.readonly 
    seq { let e' = Seq.toArray e 
      yield freeze e' 
      while permute e' f c do 
       yield freeze e' } 

现在,为了方便起见,我们有以下其中let flip f x y = f y x

let permutationsAsc e = permutations compare e 
let permutationsDesc e = permutations (flip compare) e 
0

如果你需要不同的permuations(当原始集有重复),您可以使用此:

let rec insertions pre c post = 
    seq { 
     if List.length post = 0 then 
      yield pre @ [c] 
     else 
      if List.forall (fun x->x<>c) post then 
       yield [email protected][c]@post 
      yield! insertions ([email protected][post.Head]) c post.Tail 
     } 

let rec permutations l = 
    seq { 
     if List.length l = 1 then 
      yield l 
     else 
      let subperms = permutations l.Tail 
      for sub in subperms do 
       yield! insertions [] l.Head sub 
     } 

这是一个从this C#代码直接翻译。我愿意提供更实用的外观和建议。