Вычисление перестановок в F #

Question

Вдохновленный этим question и answer, как создать общий алгоритм перестановок в F #? Google не дает никаких полезных ответов на это.

EDIT: я обеспечиваю свой лучший ответ ниже, но я подозреваю, что Томас является лучше

Answer 1

вы также можете написать что-то вроде этого:

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 } 

«списка» аргумент содержит все числа, которые вы хотите переставить и «принимать» представляет собой набор, который содержит номера уже использован. Функция возвращает пустой список, когда все сделанные числа. В противном случае он выполняет итерацию по всем имеющимся числам, получает все возможные перестановки остальных чисел (рекурсивно используя «перестановки») и добавляет текущий номер к каждому из них перед возвратом (l :: perm).

Для запуска этого, вы будете давать ему пустое множество, потому что никакие цифры не используются в начале:

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

Answer 2

Мой последний лучший ответ

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

Функция перестановки работает путем построения п-ичных (конечно, короче!) дерево, представляющее все возможные перестановки списка «вещей», прошедших в, а затем обход дерева для построения списка списков. Использование «Seq» значительно повышает производительность, так как делает все ленивым.

Второй параметр функции перестановок позволяет вызывающему определить фильтр для «обрезки» дерева перед созданием путей (см. Мой пример ниже, где мне не нужны ведущие нули).

Некоторые примеры использования: Node < «а> является общим, так что мы можем сделать перестановки 'ничего':

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, любые комментарии приветствуются)

Answer 3

Мне нравится эта реализация (но не может вспомнить источник его):

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

Answer 4

Взгляните на этот:

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

Answer 5

Решение Томаса довольно элегантно: оно короткое, чисто функциональное и ленивое. Я думаю, что это может быть даже хвост-рекурсивный. Кроме того, он производит перестановки лексикографически. Тем не менее, мы можем улучшить производительность в два раза, используя внутреннее внутреннее решение, все еще выставляя внешний интерфейс.

Функция 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 

Answer 6

Если вам нужны различные 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 pre@[c]@post 
      yield! insertions (pre@[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# кода. Я открыт для предложений для более функционального внешнего вида.