10

I need to generate permutations on a given list. I managed to do it like this

let rec Permute (final, arr) = 
    if List.length arr > 0 then
        for x in arr do
            let n_final = final @ [x]
            let rest = arr |> List.filter (fun a -> not (x = a))
            Permute (n_final, rest)
    else
        printfn "%A" final

let DoPermute lst  = 
    Permute ([], lst)

DoPermute lst

There are obvious issues with this code. For example, list elements must be unique. Also, this is more-less a same approach that I would use when generating straight forward implementation in any other language. Is there any better way to implement this in F#.

Thanks!

Aleksandar
  • 123
  • 1
  • 7
  • Related (identical?) question: http://stackoverflow.com/questions/286427/calculating-permutations-in-f – Benjol Oct 07 '09 at 06:03

7 Answers7

38

Here's the solution I gave in my book F# for Scientists (page 166-167):

let rec distribute e = function
  | [] -> [[e]]
  | x::xs' as xs -> (e::xs)::[for xs in distribute e xs' -> x::xs]

let rec permute = function
  | [] -> [[]]
  | e::xs -> List.collect (distribute e) (permute xs)
J D
  • 48,105
  • 13
  • 171
  • 274
9

For permutations of small lists, I use the following code:

let distrib e L =
    let rec aux pre post = 
        seq {
            match post with
            | [] -> yield (L @ [e])
            | h::t -> yield (List.rev pre @ [e] @ post)
                      yield! aux (h::pre) t 
        }
    aux [] L

let rec perms = function 
    | [] -> Seq.singleton []
    | h::t -> Seq.collect (distrib h) (perms t)

It works as follows: the function "distrib" distributes a given element over all positions in a list, example:

distrib 10 [1;2;3] --> [[10;1;2;3];[1;10;2;3];[1;2;10;3];[1;2;3;10]]

The function perms works (recursively) as follows: distribute the head of the list over all permutations of its tail.

The distrib function will get slow for large lists, because it uses the @ operator a lot, but for lists of reasonable length (<=10), the code above works fine.

One warning: if your list contains duplicates, the result will contain identical permutations. For example:

perms [1;1;3] = [[1;1;3]; [1;1;3]; [1;3;1]; [1;3;1]; [3;1;1]; [3;1;1]]

The nice thing about this code is that it returns a sequence of permutations, instead of generating them all at once.

Of course, generating permutations with an imperative array-based algorithm will be (much) faster, but this algorithm has served me well in most cases.

cfern
  • 5,956
  • 2
  • 25
  • 22
5

Here's another sequence-based version, hopefully more readable than the voted answer. This version is similar to Jon's version in terms of logic, but uses computation expressions instead of lists. The first function computes all ways to insert an element x in a list l. The second function computes permutations. You should be able to use this on larger lists (e.g. for brute force searches on all permutations of a set of inputs).

let rec inserts x l =
  seq { match l with
        | [] -> yield [x]
        | y::rest ->
            yield x::l
            for i in inserts x rest do
              yield y::i
      }

let rec permutations l =
  seq { match l with
        | [] -> yield []
        | x::rest ->
            for p in permutations rest do
              yield! inserts x p
      }
fmr
  • 1,518
  • 13
  • 14
3

It depends on what you mean by "better". I'd consider this to be slightly more elegant, but that may be a matter of taste:

(* get the list of possible heads + remaining elements *)
let rec splitList = function
| [x] -> [x,[]]
| x::xs -> (x, xs) :: List.map (fun (y,l) -> y,x::l) (splitList xs)

let rec permutations = function
| [] -> [[]]
| l -> 
    splitList l 
    |> List.collect (fun (x,rest) ->
         (* permute remaining elements, then prepend head *)
         permutations rest |> List.map (fun l -> x::l))

This can handle lists with duplicate elements, though it will result in duplicated permutations.

kvb
  • 54,864
  • 2
  • 91
  • 133
3

In the spirit of Cyrl's suggestion, here's a sequence comprehension version

let rec permsOf xs =
  match xs with
  | [] -> List.toSeq([[]])
  | _ -> seq{ for x in xs do
               for xs' in permsOf (remove x xs) do
                 yield (x::xs')}

where remove is a simple function that removes a given element from a list

let rec remove x xs =
  match xs with [] -> [] | (x'::xs')-> if x=x' then xs' else x'::(remove x xs')
Motorhead
  • 928
  • 6
  • 16
1

IMHO the best solution should alleviate the fact that F# is a functional language so imho the solution should be as close to the definition of what we mean as permutation there as possible. So the permutation is such an instance of list of things where the head of the list is somehow added to the permutation of the rest of the input list. The erlang solution shows that in a pretty way:

permutations([]) -> [[]];
permutations(L) -> [[H|T] H<- L, T <- permutations( L--[H] ) ].

taken fron the "programming erlang" book

There is a list comprehension operator used, in solution mentioned here by the fellow stackoverflowers there is a helper function which does the similar job basically I'd vote for the solution without any visible loops etc, just pure function definition

Cyryl Płotnicki
  • 473
  • 6
  • 12
0

I'm like 11 years late, but still in case anyone needs permutations like I did recently. Here's Array version of permutation func, I believe it's more performant:

    [<RequireQualifiedAccess>]
    module Array =

        let private swap (arr: _[]) i j =
            let buf = arr.[i]
            arr.[i] <- arr.[j]
            arr.[j] <- buf

        let permutations arr =
            match arr with
            | null | [||] -> [||]
            | arr ->
                let last = arr.Length - 1
                let arr = Array.copy arr
                let rec perm arr k =
                    let arr = Array.copy arr
                    [|
                        if k = last then
                            yield arr
                        else
                            for i in k .. last do
                                swap arr k i
                                yield! perm arr (k + 1)
                    |]
                perm arr 0
kagetoki
  • 4,339
  • 3
  • 14
  • 17