2008-11-13 12 views
14

Inspiriert durch diese question und answer, wie erstelle ich einen generischen Permutationsalgorithmus in F #? Google gibt dazu keine sinnvollen Antworten.Berechnen von Permutationen in F #

EDIT: Ich biete meine beste Antwort unten, aber ich vermute, dass Tomas besser ist

Antwort

18

Sie können auch so etwas schreiben:

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 } 

Die ‚Liste‘ Argument alle Zahlen enthält, die Sie wollen permutieren und ‚genommen‘ ist eine Menge, die Zahlen enthält schon benutzt. Die Funktion gibt eine leere Liste zurück, wenn alle Nummern genommen wurden. Andernfalls iteriert es über alle noch verfügbaren Zahlen, ruft alle möglichen Permutationen der verbleibenden Zahlen (rekursiv unter Verwendung von 'Permutationen') ab und hängt die aktuelle Zahl an jeden von ihnen an, bevor er zurückkehrt (l :: perm).

dies ausführen zu können, müssen Sie ihm eine leere Menge geben, da keine Zahlen am Anfang verwendet:

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

FYI - Set.mem wurde in Set.contains –

+0

umbenannt @Stephen, ich habe den Code nachbearbeitet ... – Benjol

1

Meine neueste beste Antwort

//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 

Die Permutationen Funktion arbeitet durch eine n-stufige Konstruktion (sicherlich kürzer!) Baum, der alle möglichen Permutationen der Liste der übergebenen "Dinge" darstellt und dann den Baum durchläuft, um eine Liste von Listen zu erstellen. Die Verwendung von "Seq" verbessert die Leistung dramatisch, da es alles faul macht. Der zweite Parameter der Permutationsfunktion erlaubt dem Aufrufer, einen Filter zum "Beschneiden" des Baumes vor dem Erzeugen der Pfade zu definieren (siehe mein Beispiel unten, wo ich keine führenden Nullen haben möchte).

Einige Beispiele Nutzung: Knoten < ‚a> ist generisch, also können wir Permutationen tun 'alles':

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] 

(Besonderer Dank geht an Tomas Petricek, keine Kommentare willkommen)

+0

Beachten Sie, dass F # eine List.permute-Funktion hat, aber das macht nicht dasselbe (ich bin mir nicht sicher, was es eigentlich tut ...) – Benjol

12

ich diese Implementierung mag (aber können die Quelle nicht erinnern):

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)) 
+0

Das sieht wirklich gut aus. Könnte das in einer Version für unterschiedliche Permutationen umgewandelt werden? Siehe unten meine eigene Lösung, die nicht so gut aussieht wie deine. Vielen Dank. – Emile

+0

Ich wünschte, du könntest dich an die Quelle erinnern. In Bezug auf die Geschwindigkeit schlägt das die Hosen von jeder anderen Permutationsfunktion, die ich ausprobiert habe. –

+0

@ rick-minerich Dies ist fast identisch mit http://StackOverflow.com/Questions/1526046/F-permutations/3129136#3129136 obwohl IMO ein bisschen klarer ist ... –

0

Werfen Sie einen Blick auf diese:

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)) 
2

Tomas 'Lösung ist ziemlich elegant: Sie ist kurz, rein funktional und faul. Ich denke, es kann sogar Schwanz-rekursiv sein. Außerdem erzeugt es lexikographisch Permutationen. Wir können die Leistung jedoch zweifach verbessern, indem wir intern eine imperative Lösung verwenden und gleichzeitig eine funktionale Schnittstelle extern freilegen.

Die Funktion permutations nimmt eine generische Sequenz e sowie eine generische Vergleichsfunktion f : ('a -> 'a -> int) und lazily ergibt unveränderbare Permutationen lexikografisch. Das Vergleichsfunktional ermöglicht es uns, Permutationen von Elementen zu generieren, die nicht notwendigerweise comparable sind, und auch einfach umgekehrte oder benutzerdefinierte Ordnungen zu spezifizieren.

Die innere Funktion permute ist die zwingende Implementierung des beschriebenen Algorithmus here.Die Umwandlungsfunktion let comparer f = { new System.Collections.Generic.IComparer<'a> with member self.Compare(x,y) = f x y } ermöglicht es uns, die System.Array.Sort Überladung zu verwenden, die unter Verwendung von IComparer in-place benutzerdefinierte Sortierungen durchführt.

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' } 

Jetzt Einfachheit halber haben wir folgendes wo let flip f x y = f y x:

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

Wenn Sie verschiedene permuations müssen (wenn der ursprüngliche Satz Duplikate hat), können Sie dies:

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 [email protected][c]@post 
      yield! insertions ([email protected][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 
     } 

Dies ist eine direkte Übersetzung von this C# -Code. Ich bin offen für Vorschläge für ein funktionelleres Look-and-Feel.

Verwandte Themen