How do I compute the cartesian product of n sequences in F#?

Question

I was given a puzzle as a present. It consists of 4 cubes, arranged side by side. The faces of each cube are one of four colours.

To solve the puzzle, the cubes must be orientated so that all four cubes' tops are different, all their fronts are different, all their backs are different and all their bottom's are different. The left and right sides do not matter.

My pseudo-code solution was:

1. Create a representation of each cube.
2. Get all the possible orientations of each cube (there are 24 for each).
3. Get all the possible combinations of orientations of each cube.
4. Find the combination of orientations that satisfies the solution.

I solved the puzzle using an implementation of that pseudo-code in F#, but am not satisifed with the way I did step 3:

let problemSpace =
    seq { for c1 in cube1Orientations do
              for c2 in cube2Orientations do
                  for c3 in cube3Orientations do
                      for c4 in cube4Orientations do
                          yield [c1; c2; c3; c4] }

The above code is very concrete, and only works out the cartesian product of four sequences of orientations. I started thinking about a way to write it for n sequences of orientations.

I came up with (all the code from now on should execute fine in F# interactive):

// Used to just print the contents of a list.
let print = 
    Seq.fold (fun s i -> s + i.ToString()) "" >> printfn "%s"

// Computes the product of two sequences - kind of; the 2nd argument is weird.
let product (seq1:'a seq) (seq2:'a seq seq) =
    seq { for item1 in seq1 do
              for item2 in seq2 do
                  yield item1 |> Seq.singleton |> Seq.append item2 }

The product function could be used like so...

seq { yield Seq.empty }
|> product [ 'a'; 'b'; 'c' ]
|> product [ 'd'; 'e'; 'f' ]
|> product [ 'h'; 'i'; 'j' ]
|> Seq.iter print

... which lead to ...

let productn (s:seq<#seq<'a>>) =
    s |> Seq.fold (fun r s -> r |> product s) (seq { yield Seq.empty })

[ [ 'a'; 'b'; 'c' ]
  [ 'd'; 'e'; 'f' ]
  [ 'h'; 'i'; 'j' ] ]
|> productn
|> Seq.iter print

This is exactly the usage I want. productn has exactly the signature I want and works.

However, using product involves the nasty line seq { yield Seq.empty }, and it unintuitively takes:

1. A sequence of values (seq<'a>)
2. A sequence of sequences of values (seq<seq<'a>>)

The second argument doesn't seem correct.

That strange interface is hidden nicely by productn, but is still nagging me regardless.

Are there any nicer, more intuitive ways to generically compute the cartesian product of n sequences? Are there any built in functions (or combination of) that do this?

Answer 1

Use recursion: the cartesian product of n lists {L1..LN} is the collection of lists you get when you add each element in L1 to each sublist in the cartesian product of lists {L2..LN}.

let rec cart1 LL = 
    match LL with
    | [] -> Seq.singleton []
    | L::Ls -> seq {for x in L do for xs in cart1 Ls -> x::xs}

Example:

> cart1 [[1;2];[3;4;5];[6;7]] |> Seq.toList;;
val it : int list list =
  [[1; 3; 6]; [1; 3; 7]; [1; 4; 6]; [1; 4; 7]; [1; 5; 6]; [1; 5; 7]; [2; 3; 6];
   [2; 3; 7]; [2; 4; 6]; [2; 4; 7]; [2; 5; 6]; [2; 5; 7]]

The cartesian product of [1;2] [3;4;5] and [6;7] is the union of {1 appended to each list in cart [[3;4;5];[6;7]]} and {2 appended to each list in cart [[3;4;5];[6;7]]}. This is the second clause in the match statement.

Answer 2

Here's a solution 'a list list -> Seq<'a list> to calculate the Cartesian product of n lists, with lazy evaluation. I wrote it to be an F# analogue of Python's itertools.product

let product lists = 
    let folder list state =
         state |> Seq.allPairs list |> Seq.map List.Cons 
    Seq.singleton List.empty |> List.foldBack folder lists

It's based on List.allPairs which was introduced in F# 4.0.

Answer 3

Here's a first try at a list version. I think it could be cleaned up a bit.

let rec cart nll = 
  let f0 n nll =
    match nll with
    | [] -> [[n]]
    | _ -> List.map (fun nl->n::nl) nll
  match nll with
  | [] -> []
  | h::t -> List.collect (fun n->f0 n (cart t)) h