a more functional solution

1
2
3
4
5
6
7
8
9
10
11
12
13
 

let rec insert x xs =
  match xs with
    | [] -> [[x]]
    | y::ys -> (x::y::ys)::List.map (fun u -> y::u) (insert x ys)

let rec orderedSubsets l =
 match l with
 | [] -> [[]]
 | x::xs -> let subs = orderedSubsets xs
                subs |> List.collect (insert x) |> List.append subs
1
orderedSubsets ["apple";"banana"; "canteloupe"]

is equal to

[[]; ["canteloupe"]; ["banana"]; ["banana"; "canteloupe"];
["canteloupe"; "banana"]; ["apple"]; ["apple"; "canteloupe"];
["canteloupe"; "apple"]; ["apple"; "banana"]; ["banana"; "apple"];
["apple"; "banana"; "canteloupe"]; ["banana"; "apple"; "canteloupe"];
["banana"; "canteloupe"; "apple"]; ["apple"; "canteloupe"; "banana"];
["canteloupe"; "apple"; "banana"]; ["canteloupe"; "banana"; "apple"]]

By on 3/9/2010 10:36 AM ()

Very clever and terse code. I have to admit I had to whip out f# interactive to understand how this worked. One thing I wonder is how you would convert this to return elements in lexicographic order.

Also, I purposely didn't return the results as a list because the number of permutations quickly becomes humongous as the set of elements grows.

By on 3/9/2010 3:50 PM ()
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
let permute xs =
  let insert e xs =
    List.fold (fun (a,l) x -> (e::x::l)::List.map (fun ys -> x::ys) a,x::l) ( [ [ e ] ] , [ ] ) xs |> fst
  
  let rec _p xs sofar =
    match xs with 
    | [] -> sofar
    | h::t -> 
      _p t (List.fold (fun a x -> List.fold (fun s x -> x::s) a (insert h x)) sofar sofar)
  _p xs [[]] |> List.sort |> List.tail

> permute ["apple";"banana";"canteloupe"] ;;
val it : string list list =
  [["apple"]; ["apple"; "banana"]; ["apple"; "banana"; "canteloupe"];
   ["apple"; "canteloupe"]; ["apple"; "canteloupe"; "banana"]; ["banana"];
   ["banana"; "apple"]; ["banana"; "apple"; "canteloupe"];
   ["banana"; "canteloupe"]; ["banana"; "canteloupe"; "apple"]; ["canteloupe"];
   ["canteloupe"; "apple"]; ["canteloupe"; "apple"; "banana"];
   ["canteloupe"; "banana"]; ["canteloupe"; "banana"; "apple"]]

List.sort should do the ordering.

And you are right that it will grow really fast. For really long list, a seq or lazylist would be more suitable.

By on 3/9/2010 10:48 PM ()

this version maintains the order on construction but make heavy use of concat/append which is very inefficient for list

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 


let orderedsub xs =
  let pull_to_front xs =
    let rec _p ys l =
      match ys with
      |[] -> []
      |h::t -> (h::(List.append l t))::(_p t (List.append l [h]))
    _p xs []
  
  let rec _orderedsub ls =
    match ls with
    |[] -> []
    |h::t -> 
      let b = List.concat (List.map _orderedsub (pull_to_front t))
      [h]::List.map (fun ls -> h::ls) b 
  List.concat (List.map _orderedsub (pull_to_front xs))

Luckily there is the LazyList which turns the disadvantage (append and concat are just deferred lambdas which is invoked in as needed basis one element a time). The following is a direct translation.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 

let orderedsub xs =
  let pull_to_front xs =
    let rec _p ys l =
      match ys with
      |Nil -> empty
      |Cons(h,t) -> consl (consl h (fun() -> l++t)) (fun() -> _p t (l++(singleton h)))
    _p xs empty
  
  let rec _orderedsub ls =
    match ls with
    |Nil -> empty
    |Cons(h,t) -> 
      let b = LazyList.concat (LazyList.map _orderedsub (pull_to_front t))
      consl (singleton h) (fun() -> LazyList.map (fun ls -> consl h (fun() -> ls)) b) 
  LazyList.concat (LazyList.map _orderedsub (pull_to_front xs))

This version use constant space and can give out results immediately. The disadvantage is a noticeable slow down.

By on 3/11/2010 7:17 AM ()

I've always known permutations to be used as meaning all the possible arrangements of the members of a set. So if the original set has 3 members then each permutation has 3 members.

here's a decent explanation

[link:www.usna.edu]

By on 12/6/2010 3:11 PM ()

if order is not required this may be a bit more efficient:

1
2
3
4
5
6
7
8
9
10
 

let permute xs =
  let rec _p xs sofar =
    match xs with 
    | [] -> sofar
    | h::t -> 
      _p t (List.fold (fun a x -> (h::x)::a) sofar sofar)
  _p xs [[]] |> List.rev |> List.tail

it is tail recursive and doesn't use append. The only extra run is the List.rev which is needed to remove the [[]] entry, a map would do too.

edit:

and it is wrong. I am doing combination. back to drawing board.

By on 3/9/2010 1:27 PM ()

See

[link:cs.hubfs.net]

regarding posting code.

By on 3/9/2010 10:00 AM ()
IntelliFactory Offices Copyright (c) 2011-2012 IntelliFactory. All rights reserved.
Home | Products | Consulting | Trainings | Blogs | Jobs | Contact Us | Terms of Use | Privacy Policy | Cookie Policy
Built with WebSharper