Calcul des permutations en fa #

Question

Inspiré par cette question et réponse , comment créer un algorithme générique de permutation en fa #? Google ne donne aucune réponse utile à cette question.

EDIT: Je donne ma meilleure réponse ci-dessous, mais je soupçonne que Tomas est meilleur (certainement plus court!)

Answer 1

vous pouvez également é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 'list' contient tous les nombres que vous souhaitez permuter et 'take' est un ensemble contenant des nombres déjà utilisés. La fonction retourne une liste vide quand tous les nombres sont pris. Sinon, il parcourt tous les nombres encore disponibles, obtient toutes les permutations possibles des nombres restants (en utilisant récursivement des "permutations") et ajoute le nombre actuel à chacun d'eux avant de les renvoyer (l :: perm).

Pour exécuter ceci, vous lui donnerez un ensemble vide, car aucun nombre n'est utilisé au début:

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

Answer 2

J'aime cette implémentation (mais je ne me souviens plus de la source):

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

La solution de Tomas est assez élégante: courte, purement fonctionnelle et paresseuse. Je pense que cela peut même être récursif. En outre, il produit des permutations lexicographiquement. Cependant, nous pouvons améliorer les performances de deux fois en utilisant une solution impérative en interne tout en exposant une interface fonctionnelle en externe.

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 immuables lexicographiquement. La fonctionnalité 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 l'implémentation impérative de l'algorithme décrit ici . . 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 System.Array.Sort surcharge qui effectue des tris personnalisés de sous-plages sur place à l’aide de 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' }

Par commodité, voici ce qui suit: let flip f x y = f y x:

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

Answer 4

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 arbre n-aire représentant toutes les permutations possibles de la liste des "choses" passées, puis en parcourant l’arbre pour construire une liste de listes. L’utilisation de 'Seq' améliore considérablement les performances car tout est 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 souhaite pas de zéros à gauche).

Quelques exemples d'utilisation: Node < 'a > est générique, donc on peut faire des permutations de 'n'importe quoi':

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 merci spécial à Tomas Petricek , tous les commentaires sont les bienvenus)

Answer 5

Si vous avez besoin de permutation distinctes (lorsque le jeu d'origine comporte des 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
        }

Il s'agit d'une traduction directe de ceci code C #. Je suis ouvert aux suggestions pour une apparence plus fonctionnelle.

Answer 6

Jetez un coup d'œil à 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 7

Si vous avez besoin de permutations avec répétitions, c’est le & "du livre &"; approche en utilisant List.indexed au lieu de la comparaison d’éléments pour filtrer les éléments lors de la construction d’une permutation.

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