El cálculo de las permutaciones en F#
-
08-07-2019 - |
Solución
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 una lista vacía cuando se toman todos los números. De lo contrario, itera sobre todos los números que aún están disponibles, obtiene todas las permutaciones posibles de los números restantes (usando recursivamente '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;;
Otros consejos
Me gusta esta implementación (pero no recuerdo la fuente de la misma):
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))
Tomás solución es muy elegante:es corto, puramente funcional, y la pereza.Creo que incluso puede ser la cola recursiva.También, se produce permutaciones lexicográficamente.Sin embargo, podemos mejorar el rendimiento de dos veces el uso de un imperativo solución internamente mientras todavía exponer una interfaz funcional externamente.
La función permutations
toma una secuencia genérica e
así como un genérico de función de comparación f : ('a -> 'a -> int)
y perezosamente los rendimientos inmutable permutaciones lexicográficamente.La comparación funcional nos permite generar permutaciones de los elementos que no son necesariamente comparable
así como especificar fácilmente inversa o personalizado ordenamientos.
El interior de la función permute
es el imperativo de la implementación del algoritmo descrito aquí.La función de conversión de let comparer f = { new System.Collections.Generic.IComparer<'a> with member self.Compare(x,y) = f x y }
nos permite el uso de la System.Array.Sort
la sobrecarga que hace en lugar de sub-rango personalizado clasifica mediante un 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' }
Ahora para su comodidad contamos con la siguiente donde let flip f x y = f y x
:
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 atraviesa el árbol para construir una lista de listas. El uso de 'Seq' mejora drásticamente el rendimiento, ya que hace que todo sea perezoso.
El segundo parámetro de la función de permutaciones permite a la persona que llama definir un filtro para 'podar' el árbol antes de generar las rutas (vea mi ejemplo a continuación, donde no quiero ceros a la izquierda).
Algunos ejemplos de uso: Nodo < 'a > es genérico, por lo que podemos hacer permutaciones de 'cualquier cosa':
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]
(Un agradecimiento especial a Tomas Petricek , cualquier comentario es bienvenido)
Si necesita permutaciones 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 una apariencia más funcional.
Echa 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<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))
Si necesita permutaciones con repeticiones, esta es la & "; por el libro &"; enfoque utilizando List.indexed en lugar de la comparación de elementos para filtrar elementos mientras se construye una permutación.
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