f# generate the cross join two list [duplicate] - collections

Question

I have to do projection of a list of lists which returns all combinations with each element from each list. For example:
projection([[1]; [2; 3]]) = [[1; 2]; [1; 3]].
projection([[1]; [2; 3]; [4; 5]]) = [[1; 2; 4]; [1; 2; 5]; [1; 3; 4]; [1; 3; 5]].
I come up with a function:
let projection lss0 =
let rec projectionUtil lss accs =
match lss with
| [] -> accs
| ls::lss' -> projectionUtil lss' (List.fold (fun accs' l ->
accs' # List.map (fun acc -> acc # [l]) accs)
[] ls)
match lss0 with
| [] -> []
| ls::lss' ->
projectionUtil lss' (List.map (fun l -> [l]) ls)
and a testcase:
#time "on";;
let N = 10
let fss0 = List.init N (fun i -> List.init (i+1) (fun j -> j+i*i+i));;
let fss1 = projection fss0;;
The function is quite slow now, with N = 10 it takes more than 10 seconds to complete. Moreover, I think the solution is unnatural because I have to breakdown the same list in two different ways. Any suggestion how I can improve performance and readability of the function?

Answer 1

First of all, try to avoid list concatenation (#) whenever possible, since it's O(N) instead of O(1) prepend.
I'd start with a (relatively) easy to follow plan of how to compute the cartesian outer product of lists.
Prepend each element of the first list to each sublist in the cartesian product of the remaining lists.
Take care of the base case.
First version:
let rec cartesian = function
| [] -> [[]]
| L::Ls -> [for C in cartesian Ls do yield! [for x in L do yield x::C]]
This is the direct translation of the sentences above to code.
Now speed this up: instead of list comprehensions, use list concatenations and maps:
let rec cartesian2 = function
| [] -> [[]]
| L::Ls -> cartesian2 Ls |> List.collect (fun C -> L |> List.map (fun x->x::C))
This can be made faster still by computing the lists on demand via a sequence:
let rec cartesian3 = function
| [] -> Seq.singleton []
| L::Ls -> cartesian3 Ls |> Seq.collect (fun C -> L |> Seq.map (fun x->x::C))
This last form is what I use myself, since I most often just need to iterate over the results instead of having them all at once.
Some benchmarks on my machine:
Test code:
let test f N =
let fss0 = List.init N (fun i -> List.init (i+1) (fun j -> j+i*i+i))
f fss0 |> Seq.length
Results in FSI:
> test projection 10;;
Real: 00:00:18.066, CPU: 00:00:18.062, GC gen0: 168, gen1: 157, gen2: 7
val it : int = 3628800
> test cartesian 10;;
Real: 00:00:19.822, CPU: 00:00:19.828, GC gen0: 244, gen1: 121, gen2: 3
val it : int = 3628800
> test cartesian2 10;;
Real: 00:00:09.247, CPU: 00:00:09.250, GC gen0: 94, gen1: 52, gen2: 2
val it : int = 3628800
> test cartesian3 10;;
Real: 00:00:04.254, CPU: 00:00:04.250, GC gen0: 359, gen1: 1, gen2: 0
val it : int = 3628800

Answer 2

This function is Haskell's sequence (although sequence is more generic). Translating to F#:
let sequence lss =
let k l ls = [ for x in l do for xs in ls -> x::xs ]
List.foldBack k lss [[]]
in interactive:
> test projection 10;;
Real: 00:00:12.240, CPU: 00:00:12.807, GC gen0: 163, gen1: 155, gen2: 4
val it : int = 3628800
> test sequence 10;;
Real: 00:00:06.038, CPU: 00:00:06.021, GC gen0: 75, gen1: 74, gen2: 0
val it : int = 3628800
General idea: avoid explicit recursion in favor to standard combinators (fold, map etc.)

Answer 3

Here's a tail-recursive version. It's not as fast as some of the other solutions (only 25% faster than your original function), but memory usage is constant, so it works for extremely large result sets.
let cartesian l =
let rec aux f = function
| [] -> f (Seq.singleton [])
| h::t -> aux (fun acc -> f (Seq.collect (fun x -> (Seq.map (fun y -> y::x) h)) acc)) t
aux id l

Answer 4

You implementation is slow because of the # (i.e List concat) operation, which is a slow operation and it is being done many a times in recursive way. The reason for # being slow is that List are Linked list in functional programming and to concat 2 list you have to first go till the end of the list (one by one traversing through elements) and then append another list .
Please look at the suggested references in comments. I hope those will help you out.

Answer 5

The following version is even faster than cartesian3, and uses basic features of functional programming (no fancy List.collect, Seq.collect...)
let cartesian xss =
let rec add x yss s =
match yss with
| [] -> s
| ys :: yss' -> add x yss' ((x :: ys) :: s)
let rec mul xs yss p =
match xs with
| [] -> p
| x :: xs' -> mul xs' yss (add x yss p)
let rec cartesian xss c =
match xss with
| [] -> c
| xs :: xss' -> cartesian xss' (mul xs c [])
cartesian xss [ [] ]
Results
> test cartesian3 10;;
Real: 00:00:04.132, CPU: 00:00:04.109, GC Gen0: 482, Gen1: 2, Gen2: 1
val it: int = 3628800
> test cartesian 10;;
Real: 00:00:01.414, CPU: 00:00:01.406, GC Gen0: 27, Gen1: 16, Gen2: 2
val it: int = 3628800
> test cartesian3 11;;
Real: 00:00:45.652, CPU: 00:00:45.281, GC Gen0: 5299, Gen1: 5, Gen2: 1
val it: int = 39916800
> test cartesian 11;;
Real: 00:00:17.242, CPU: 00:00:16.812, GC Gen0: 260, Gen1: 174, Gen2: 6
val it: int = 39916800
The partition strategy used here is naive: the input list xss is separated into head and tail, I believe that a smarter strategy can give much better performance.
Edit: Another solution is of Christopher Strachey, which is explained in [1] (the observation is that the recursion on list can be expressed by folding):
let cartesianf xss =
let f xs yss =
let h x ys uss = (x :: ys) :: uss
let g yss x zss = List.foldBack (h x) yss zss
List.foldBack (g yss) xs []
List.foldBack f xss [ [] ]
[1] Mike Spivey. Strachey's function pearl, forty years on.

Answer 6

let crossProduct listA listB listC listD listE =
listA |> Seq.collect (fun a ->
listB |> Seq.collect (fun b ->
listC |> Seq.collect (fun c ->
listD |> Seq.collect (fun d ->
listE |> Seq.map (fun e -> a,b,c,d,e))