Calculando las permutaciones en F #

Question

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

EDIT: proporcionar mi mejor respuesta de abajo, pero sospecho que Tomas de es mejor

Answer 1

también puede 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 } 

La 'lista' argumento contiene todos los números que desea permutar y 'tomada' es un conjunto que contiene los números ya usado. 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, se lo daré un conjunto vacío, porque no hay números se utilizan al principio:

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

Answer 2

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 permutaciones funciona mediante la construcción de un n-ario (sin duda más corto!) árbol que representa todas las permutaciones posibles de la lista de "cosas" pasadas, luego atraviesa 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 ejemplo de uso: Nodo < 'a> es genérico, por lo que puede hacer permutaciones de 'nada':

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] 

(Gracias especiales a Tomas Petricek, cualquier comentario de bienvenida)

Answer 3

Me gusta esta implementación (pero no pueden recordar el origen 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)) 

Answer 4

Tome un vistazo a esto:

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

La solución de Tomas es bastante elegante: es corta, puramente funcional y vaga. 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érico f : ('a -> 'a -> int) y perezosamente produce 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 here.La función de conversión let comparer f = { new System.Collections.Generic.IComparer<'a> with member self.Compare(x,y) = f x y } nos permite usar la sobrecarga System.Array.Sort, que hace ordenamientos personalizados de subintervalo in situ usando 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 por conveniencia tenemos el siguiente, donde let flip f x y = f y x:

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

Answer 6

Si necesita permuations distintos (cuando el conjunto original tiene duplicados), se puede utilizar este:

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 del código C# this. Estoy abierto a sugerencias para un look-and-feel más funcional.