Calcolo delle permutazioni in F #

Question

Ispirato da questa domanda e answer , come posso creare un algoritmo di permutazioni generiche in F #? Google non fornisce alcuna risposta utile a questo.

EDIT: fornisco la mia migliore risposta di seguito, ma sospetto che quella di Tomas sia migliore (sicuramente più breve!)

Answer 1

puoi anche scrivere qualcosa del genere:

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'argomento 'list' contiene tutti i numeri che si desidera permutare e 'preso' è un set che contiene numeri già usati. La funzione restituisce un elenco vuoto quando tutti i numeri sono stati rilevati. Altrimenti, scorre su tutti i numeri ancora disponibili, ottiene tutte le possibili permutazioni dei numeri rimanenti (usando ricorsivamente "permutazioni") e aggiunge il numero corrente a ciascuno di essi prima di tornare (l :: perm).

Per eseguire questo, gli darai un set vuoto, perché all'inizio non vengono usati numeri:

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

Answer 2

Mi piace questa implementazione (ma non ricordo la sua fonte):

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 soluzione di Tomas è piuttosto elegante: è corta, puramente funzionale e pigra. Penso che potrebbe anche essere ricorsivo di coda. Inoltre, produce permutazioni lessicograficamente. Tuttavia, possiamo migliorare le prestazioni in due modi utilizzando una soluzione imperativa internamente pur esponendo un'interfaccia funzionale esternamente.

La funzione permutations accetta una sequenza generica e nonché una funzione di confronto generica f : ('a -> 'a -> int) e produce pigramente permutazioni immutabili dal punto di vista lessicografico. Il confronto funzionale ci consente di generare permutazioni di elementi che non sono necessariamente comparable e di specificare facilmente ordini inversi o personalizzati.

La funzione interna permute è l'implementazione imperativa dell'algoritmo descritto qui . La funzione di conversione let comparer f = { new System.Collections.Generic.IComparer<'a> with member self.Compare(x,y) = f x y } ci consente di utilizzare il System.Array.Sort sovraccarico, che esegue ordinamenti sub-range sul posto utilizzando 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' }

Ora per comodità abbiamo quanto segue let flip f x y = f y x:

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

Answer 4

La mia ultima migliore risposta

//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 funzione permutazioni funziona costruendo un albero n-ary che rappresenta tutte le possibili permutazioni dell'elenco delle "cose" passate, quindi attraversando l'albero per costruire un elenco di elenchi. L'uso di "Seq" migliora notevolmente le prestazioni in quanto rende tutto pigro.

Il secondo parametro della funzione permutazioni consente al chiamante di definire un filtro per 'potare' l'albero prima di generare i percorsi (vedere il mio esempio di seguito, dove non voglio zeri iniziali).

Alcuni esempi di utilizzo: Nodo < 'a > è generico, quindi possiamo fare permutazioni di "qualsiasi 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 ringraziamento speciale a Tomas Petricek , eventuali commenti graditi)

Answer 5

Se hai bisogno di permuizioni distinte (quando il set originale ha duplicati), puoi usare questo:

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
        }

Questa è una traduzione diretta da questo codice C #. Sono aperto a suggerimenti per un aspetto più funzionale.

Answer 6

Dai un'occhiata a questo:

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

Se hai bisogno di permutazioni con ripetizioni, questa è la " del libro " approccio usando List.indexed invece del confronto tra elementi per filtrare gli elementi mentre si costruisce una permutazione.

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