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

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

//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< 'a> универсально, таким образом, мы можем сделать перестановки 'чего-либо':

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

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

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

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

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

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

Функция перестановок принимает общую последовательность e , а также общую функцию сравнения f: ('a ->' a -> int) и лениво дает неизменяемые перестановки лексикографически. Функционал сравнения позволяет нам генерировать перестановки элементов, которые не обязательно сопоставимы , а также легко определять обратный или индивидуальный порядок.

Внутренняя функция перестановка является императивной реализацией алгоритма, описанного здесь . Функция преобразования let comparer f = {new System.Collections.Generic.IComparer <'a> with member self.Compare (x, y) = fxy} позволяет нам использовать 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 fxy = fyx :

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

Если вам нужны разные перестановки (когда в исходном наборе есть дубликаты), вы можете использовать это:

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
        }

Это прямой перевод из этого кода C #. Я открыт для предложений по более функциональному внешнему виду.