Cálculo de permutaciones en F #

Inspirado por esta pregunta y respuesta , ¿cómo creo un algoritmo de permutaciones genéricas en F #? Google no da ninguna respuesta útil a esto.

EDIT: ofrezco mi mejor respuesta a continuación, pero sospecho que la de Tomás es mejor (¡ciertamente más corta!)

también puedes escribir algo como esto:

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 } 

El argumento ‘lista’ contiene todos los números que desea permutar y ‘tomado’ es un conjunto que contiene números ya utilizados. La función devuelve la lista vacía cuando se toman todos los números. De lo contrario, itera sobre todos los números que todavía están disponibles, obtiene todas las permutaciones posibles de los números restantes (recursivamente usando ‘permutaciones’) y agrega el número actual a cada uno de ellos antes de regresar (l :: perm).

Para ejecutar esto, le dará un conjunto vacío, porque no se usan números al principio:

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

Me gusta esta implementación (pero no recuerdo su origen):

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

La solución de Tomás es bastante elegante: es corta, puramente funcional y floja. Creo que incluso puede ser recursivo. Además, produce permutaciones lexicográficamente. Sin embargo, podemos mejorar el rendimiento dos veces utilizando una solución imperativa internamente y al mismo tiempo exponer externamente una interfaz funcional.

La función permutations toma una secuencia genérica e , así como una función de comparación genérica f : ('a -> 'a -> int) y cede perezosamente permutaciones inmutables lexicográficamente. La función de comparación nos permite generar permutaciones de elementos que no son necesariamente comparable , así como especificar fácilmente ordenamientos inversos o personalizados.

La función interna permute es la implementación imperativa del algoritmo descrito aquí . La función de conversión let comparer f = { new System.Collections.Generic.IComparer<'a> with member self.Compare(x,y) = fxy } nos permita utilizar la sobrecarga System.Array.Sort que tiene sub en let comparer f = { new System.Collections.Generic.IComparer<'a> with member self.Compare(x,y) = fxy } -range personalizado ordena utilizando un IComparer .

 let permutations fe = ///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' fc do yield freeze e' } 

Ahora, para mayor comodidad, tenemos lo siguiente donde let flip fxy = fyx :

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

Mi última mejor respuesta

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

La función de permutaciones funciona construyendo un árbol n-ario que representa todas las permutaciones posibles de la lista de “cosas” pasadas, luego recorriendo el árbol para construir una lista de listas. Usar ‘Seq’ mejora dramáticamente el rendimiento ya que hace que todo sea flojo.

El segundo parámetro de la función de permutaciones permite que el que llama defina un filtro para “podar” el árbol antes de generar las rutas (ver mi ejemplo a continuación, donde no quiero ningún cero inicial).

Algunos ejemplos de uso: el nodo <'a> es genérico, por lo que podemos hacer permutaciones de’ cualquier cosa ‘:

 let myfilter n = Some(n) //ie, 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] 

(Gracias especiales a Tomas Petricek , cualquier comentario es bienvenido)

Si necesita permuations distintas (cuando el conjunto original tiene duplicados), puede usar esto:

 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 es una traducción directa de este código C #. Estoy abierto a sugerencias para un look-and-feel más funcional.

Eche un vistazo a este:

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