2008-11-13 87 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#代碼直接翻譯。我願意提供更實用的外觀和建議。