Calcular permutações em F#

Question

Inspirado por este pergunta e responder, como criar um genérico permutações algoritmo em F#?O Google não dá quaisquer respostas úteis para isso.

EDITAR:Eu dar o meu melhor resposta abaixo, mas eu suspeito que Tomas é melhor (certamente mais curto!)

Answer 1

Você também pode escrever algo assim:

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 }

O argumento da 'lista' contém todos os números que você deseja permitir e 'tomada' é um conjunto que contém números já usados. A função retorna uma lista vazia quando todos os números são feitos. Caso contrário, ele itera em todos os números que ainda estão disponíveis, obtém todas as permutações possíveis dos números restantes (usando recursivamente 'permutações') e anexa o número atual a cada um deles antes de retornar (L :: Perm).

Para executar isso, você dará um conjunto vazio, porque nenhum número é usado no início:

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

Answer 2

Eu gosto dessa implementação (mas não consigo me lembrar da fonte):

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 3

Tomas' solução é bastante elegante:ele é curto, puramente funcional, e preguiçoso.Eu acho que pode até mesmo ser recursiva.Além disso, ele produz permutações lexicographically.No entanto, podemos melhorar o desempenho duas vezes usando um imperativo solução internamente ao expor ainda uma interface funcional externamente.

A função permutations leva uma sequência genérica e assim como uma genérica função de comparação f : ('a -> 'a -> int) e preguiçosamente rendimentos imutável permutações lexicographically.A comparação funcional nos permite gerar permutações de elementos que não são necessariamente comparable bem como especificar facilmente reverter ou personalizado ordenações.

A função interna permute é imperativo a implementação do algoritmo descrito aqui.A função de conversão let comparer f = { new System.Collections.Generic.IComparer<'a> with member self.Compare(x,y) = f x y } permite-nos utilizar o System.Array.Sort sobrecarga que não no-lugar sub-intervalo personalizado tipo usando um 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' }

Agora, por conveniência, temos o seguinte onde let flip f x y = f y x:

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

Answer 4

Minha melhor resposta mais recente

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

A função de permutações funciona construindo uma árvore n-yar que representa todas as permutações possíveis da lista de 'coisas' passadas e depois atravessando a árvore para construir uma lista de listas. O uso do 'SEQ' melhora drasticamente o desempenho, pois torna tudo preguiçoso.

O segundo parâmetro da função de permutações permite que o chamador defina um filtro para 'podar' a árvore antes de gerar os caminhos (veja meu exemplo abaixo, onde não quero nenhum zeros líder).

Algum exemplo de uso: nó <'a> é genérico, para que possamos fazer permutações de' qualquer coisa ':

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] 

(Agradecimentos especiais para Tomas Petricek, qualquer comentário bem -vindo)

Answer 5

Se você precisar de permuções distintas (quando o conjunto original tiver duplicatas), você pode usar isso:

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
        }

Esta é uma tradução direta de isto Código C#. Estou aberto a sugestões para uma aparência mais funcional.

Answer 6

Dê uma olhada neste:

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 7

Se você precisar de permutações com repetições, esta é a abordagem "pelo livro" usando list.indexed em vez de comparação de elementos para filtrar elementos enquanto construía uma permutação.

let permutations s =
    let rec perm perms carry rem =
        match rem with
            | [] -> carry::perms
            | l ->
                let li = List.indexed l
                let permutations =
                        seq { for ci in li ->
                                let (i, c) = ci
                                (perm
                                        perms
                                        (c::carry)
                                        (li |> List.filter (fun (index, _) -> i <> index) |> List.map (fun (_, char) -> char))) }

                permutations |> Seq.fold List.append []
    perm [] [] s