Calcul des permutations en F #

Question

Inspiré par ce question et answer, comment créer un algorithme de permutations génériques en F #? Google ne donne aucune réponse utile à cela.

EDIT: Je fournir ma meilleure réponse ci-dessous, mais je soupçonne que Tomas est mieux

Answer 1

vous pouvez aussi écrire quelque chose comme ceci:

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 } 

L'argument de la « liste » contient tous les numéros que vous voulez et permute « prise » est un ensemble qui contient les numéros déjà utilisé. La fonction renvoie la liste vide lorsque tous les numéros sont tous pris. Sinon, il itère sur tous les nombres qui sont encore disponibles, obtient toutes les permutations possibles des nombres restants (récursivement en utilisant 'permutations') et ajoute le nombre actuel à chacun d'entre eux avant de retourner (l :: perm).

Pour exécuter cette commande, vous allez donner un ensemble vide, car aucun numéros sont utilisés au début:

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

Answer 2

Ma dernière meilleure réponse

//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 fonction permutations fonctionne en construisant un n-aire (certainement plus court!) arbre représentant toutes les permutations possibles de la liste des 'choses' passées, puis traversant l'arbre pour construire une liste de listes. L'utilisation de 'Seq' améliore considérablement les performances car elle rend tout paresseux. Le deuxième paramètre de la fonction permutations permet à l'appelant de définir un filtre pour «élaguer» l'arbre avant de générer les chemins (voir mon exemple ci-dessous, où je ne veux pas de zéros en tête).

Quelques exemples d'utilisation: Noeud < « a> est générique, donc nous pouvons faire des permutations de 'quoi que ce soit':

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] 

(grâce à Tomas Petricek, tout commentaire bienvenue)

Answer 3

J'aime cette mise en œuvre (mais ne peut pas se rappeler la source de celui-ci):

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

Jetez un oeil à celui-ci:

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 solution de Tomas est assez élégante: elle est courte, purement fonctionnelle et paresseuse. Je pense que cela peut même être récursif. En outre, il produit des permutations lexicographiques. Cependant, nous pouvons améliorer les performances deux fois en utilisant une solution impérative en interne tout en exposant une interface fonctionnelle à l'extérieur.

La fonction permutations prend une séquence générique e ainsi qu'une fonction de comparaison générique f : ('a -> 'a -> int) et donne paresseusement des permutations immutables lexicographiquement. La fonction de comparaison nous permet de générer des permutations d'éléments qui ne sont pas nécessairement comparable ainsi que de spécifier facilement des ordres inversés ou personnalisés.

La fonction interne permute est la mise en œuvre impérative de l'algorithme décrit here.La fonction de conversion let comparer f = { new System.Collections.Generic.IComparer<'a> with member self.Compare(x,y) = f x y } nous permet d'utiliser la surcharge System.Array.Sort qui effectue des tris personnalisés sur une sous-gamme à l'aide d'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' } 

Maintenant, pour des raisons pratiques, nous avons les éléments suivants où let flip f x y = f y x:

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

Answer 6

Si vous avez besoin permuations distinctes (lorsque le jeu original a doublons), vous pouvez utiliser ceci:

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 
     } 

Ceci est une traduction directe du code C# this. Je suis ouvert aux suggestions pour un look-and-feel plus fonctionnel.