Calculation of permutations in F #

Question

Inspired by this question and how do I create a general permutation algorithm in F #? Google does not provide any useful answers to this question.

EDIT: I give my best answer below, but I suspect Thomas is better (of course, shorter!)

Answer 1

you can also write something like this:

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 } 

The list argument contains all the numbers you want to rearrange, and the taken one is a set containing the numbers you are already using. The function returns an empty list when all numbers are made. Otherwise, it iterates over all available numbers, obtains all possible permutations of the remaining numbers (recursively using "permutations"), and adds the current number to each of them before returning (l :: perm).

To run this, you give it an empty set, since at the beginning the numbers are not used:

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

Answer 2

I like this implementation (but I can’t remember its 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

Tomas' solution is pretty elegant: it's short, purely functional and lazy. I think it could even be tail-recursive. In addition, he makes permutations lexicographically. However, we can improve performance by half, using an internal internal solution, while still exposing the external interface.

The permutations function accepts the general sequence e , as well as the general comparison function f : ('a -> 'a -> int) and lazily displays immutable permutations lexicographically. The comparison functionality allows us to create permutations of elements that are not necessarily comparable , as well as easily determine reverse or user orders.

The permute internal function is an imperative implementation of the described algorithm here . The conversion function let comparer f = { new System.Collections.Generic.IComparer<'a> with member self.Compare(x,y) = fxy } allows you to use the overload System.Array.Sort , which makes its own custom settings at the sub- range using IComparer .

 let permutations fe = ///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' fc do yield freeze e' } 

Now for convenience we have the following: let flip fxy = fyx :

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

Answer 4

My last best answer

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

The permutation function works by creating an n-ary tree representing all possible permutations of the list of transferred “things”, and then traversing the tree to build the list of lists. Using "Seq" significantly improves performance, as it makes everything lazy.

The second parameter of the permutation function allows the caller to define a filter to “trim” the tree before creating the paths (see my example below, where I do not need leading zeros).

Example usage example: Node <'a> is generic, so we can perform "nothing" permutations:

 let myfilter n = Some(n) //ie, 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] 

(Special thanks to Tomas Petricek , any comments are welcome)

Answer 5

Take a look at this:

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 6

If you need different permutations (when the source set has duplicates), you can use this:

 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 } 

This is a direct translation from this code to C #. I am open to suggestions for a more functional look.

Answer 7

If you need permutations with repetitions, this is a book-by-book approach that uses List.indexed instead of comparing items to filter items when building the 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