Solving a Simple Puzzle using Functional Programming in F#

Introduction

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

Imagine that the puzzle is in front of you on a table, the four cubes stretching from left to right. We’ll name the sides of the cubes based on this perspective. For each cube:

1. The side facing the ceiling is the top.
2. The side facing the table is the bottom.
3. The side facing you is the back.
4. The side facing the wall in front of you is the front.
5. The side facing the left wall is the left.
6. The side facing the right wall is the right.

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.

After fiddling around with the puzzle for a while, failing to get my ‘human’ intelligence to solve the problem in a non-methodical fashion, I decided to look at the puzzle logically.

Theory

I knew that the order of the cubes would not affect the solution, so I started to reason about how each cube could be orientated. With a single side resting on the table, each cube could be positioned on of four ways (front side at the front, left, back and right). Each cube has six sides, any of which can be resting on the table. Four orientations on each face multiplied by six faces equals 24 orientations.

There are four cubes, so the number of combinations of orientations is 24 to the power of 4, or 331776.

In theory, I could move each cube through each orientation until I found the result. Before attempting this, I considered how long that might actually take.

I took the super-optimistic assumption that it would take 10 seconds to move a cube and check whether or not the problem was solved. This equated to 921.6 hours of work. Say I took it up as a job, and worked at it 40 hours a week. If I did a little overtime and made no mistakes, I could work out all solutions to the problem  in around 23 weeks!

The word unfeasible came to mind.

However, if I developed a simulation of the puzzle, I could get a computer to work out all the combinations for me and find the solution. I fancied my chances most using F#.

Implementation

I went for a design using immutablility. A die object could represent one of the cubes, and functions could be produced to get new dice by rotating it.

My type definitions were as follows.

type face =
    | Blue
    | Orange
    | Green
    | Yellow
    override this.ToString() =
        match this with
        | Blue -> "Blue"
        | Orange -> "Orange"
        | Green -> "Green"
        | Yellow -> "Yellow"

type die(top:face, bottom:face, left:face, right:face, front:face, back:face) =
    member this.Top = top
    member this.Bottom = bottom
    member this.Left = left
    member this.Right = right
    member this.Front = front
    member this.Back = back
    override this.ToString() =
        sprintf "Top: %O, Bottom: %O, Left: %O, Right: %O, Front: %O, Back: %O"
                top bottom left right front back

Next I had to figure out how to generate all 24 orientations for each die. Before going further, I needed some terminology for the ways in which the dice could be rotated. I decided to call on my (very basic) knowledge of aircraft. An aircraft has three axes of movement. I could steal the terms for these axes for my dice simulation.

1. Normal axis: turned about when the aircraft yaws (like a tank would move when turning from left to right).
2. Longitudinal axis: turned about when the aircraft rolls.
3. Lateral axis: turned about when the aircraft pitches.

I could use the terms ‘normal’, ‘longitudinal’ and ‘lateral’ in my rotate function names. Next I needed a sequence of movements to get all my orientations. After some thinking, I settled on one requiring just three different rotations. I added a function that would apply those rotations and create a list of orientations for each die. I placed all of this in the Die module.

module Die =
    let private rotateNormalRight (d:die) =
        die(d.Top, d.Bottom, d.Back, d.Front, d.Left, d.Right)
    let private rotateLongitudinalRight (d:die) =
        die(d.Left, d.Right, d.Bottom, d.Top, d.Front, d.Back)
    let private rotateLongitudinalLeft (d:die) =
        die(d.Right, d.Left, d.Top, d.Bottom, d.Front, d.Back)
    let private operations =
        [ rotateNormalRight; rotateNormalRight; rotateNormalRight; rotateLongitudinalRight
          rotateNormalRight; rotateNormalRight; rotateNormalRight; rotateLongitudinalRight
          rotateNormalRight; rotateNormalRight; rotateNormalRight; rotateLongitudinalLeft
          rotateNormalRight; rotateNormalRight; rotateNormalRight; rotateLongitudinalLeft
          rotateNormalRight; rotateNormalRight; rotateNormalRight; rotateLongitudinalRight
          rotateNormalRight; rotateNormalRight; rotateNormalRight ]
    let getOrientations startDie =
        let rec getDiceInner (ops:(die -> die) list) (d:die list) =
            match ops with
            | [] -> d
            | op :: rest -> getDiceInner rest ((d |> List.hd |> op) :: d)
        getDiceInner operations [startDie]

Now I turned my effort to checking whether or not a sequence of die objects represented a solution or not. I decided that if the number of distinctly coloured faces equalled the total number of faces for a given set of faces, then that set of faces qualified for a solution. If this applied to all the top, front, bottom and back faces, the sequence represeted a solution.

let countDistinct (s:'a seq) =
        s |> Seq.groupBy id |> Seq.length

let isSolution (d:die seq) =
    let dice = d |> Seq.to_list
    let count = dice |> List.length
    (dice |> Seq.map (fun d -> d.Top) |> countDistinct) = count &&
    (dice |> Seq.map (fun d -> d.Front) |> countDistinct) = count &&
    (dice |> Seq.map (fun d -> d.Bottom) |> countDistinct) = count &&
    (dice |> Seq.map (fun d -> d.Back) |> countDistinct) = count

Now the final headache was finding all the combinations of orientations for the four dice. This could be computed using a cartesian product. I settled on the following function.

let product (ss:seq<#seq<'a>>) =
    let productInner (s1:seq<'a>) (s2:seq>) =
        seq { for i1 in s1 do
                  for i2 in s2 do
                      yield i1 |> Seq.singleton |> Seq.append i2 }
    ss |> Seq.fold (fun r s -> productInner s r) (seq { yield Seq.empty })

It’s fairly nasty. So nasty that it caused me to ask a question on stackoverflow. You can find a much nicer example there of computing a cartesian product on n sequences.

Now I had everything I needed to find the solution to my puzzle!

let printSolution (dice:die seq) =
    printfn "Found solution:"
    dice |> Seq.iter (fun d -> printfn "  %O" d)

[ die(Yellow, Orange, Green, Yellow, Blue, Orange)
  die(Yellow, Yellow, Blue, Yellow, Orange, Green)
  die(Orange, Green, Green, Yellow, Blue, Blue)
  die(Blue, Orange, Blue, Yellow, Orange, Green) ]
|> Seq.map Die.getOrientations
|> product
|> Seq.filter isSolution
|> Seq.iter printSolution

The printSolution function just does exactly what it says. The interesting part is the final statement. It reads pretty much like:

For these dice, work out all the orientations they can be in. Then work out all the possible combinations of orientations. Then find the combinations that represent a solution, and print those solutions.

Results

The final output is printed below.

Found solution:
  Top: Orange, Bottom: Blue, Left: Yellow, Right: Orange, Front: Yellow, Back: Green
  Top: Green, Bottom: Orange, Left: Yellow, Right: Yellow, Front: Blue, Back: Yellow
  Top: Yellow, Bottom: Green, Left: Blue, Right: Blue, Front: Green, Back: Orange
  Top: Blue, Bottom: Yellow, Left: Green, Right: Orange, Front: Orange, Back: Blue
Found solution:
  Top: Orange, Bottom: Blue, Left: Orange, Right: Yellow, Front: Green, Back: Yellow
  Top: Green, Bottom: Orange, Left: Yellow, Right: Yellow, Front: Yellow, Back: Blue
  Top: Yellow, Bottom: Green, Left: Blue, Right: Blue, Front: Orange, Back: Green
  Top: Blue, Bottom: Yellow, Left: Orange, Right: Green, Front: Blue, Back: Orange
Found solution:
  Top: Yellow, Bottom: Green, Left: Orange, Right: Yellow, Front: Orange, Back: Blue
  Top: Blue, Bottom: Yellow, Left: Yellow, Right: Yellow, Front: Green, Back: Orange
  Top: Green, Bottom: Orange, Left: Blue, Right: Blue, Front: Yellow, Back: Green
  Top: Orange, Bottom: Blue, Left: Orange, Right: Green, Front: Blue, Back: Yellow
Found solution:
  Top: Yellow, Bottom: Green, Left: Yellow, Right: Orange, Front: Blue, Back: Orange
  Top: Blue, Bottom: Yellow, Left: Yellow, Right: Yellow, Front: Orange, Back: Green
  Top: Green, Bottom: Orange, Left: Blue, Right: Blue, Front: Green, Back: Yellow
  Top: Orange, Bottom: Blue, Left: Green, Right: Orange, Front: Yellow, Back: Blue
Found solution:
  Top: Blue, Bottom: Orange, Left: Orange, Right: Yellow, Front: Yellow, Back: Green
  Top: Orange, Bottom: Green, Left: Yellow, Right: Yellow, Front: Blue, Back: Yellow
  Top: Green, Bottom: Yellow, Left: Blue, Right: Blue, Front: Green, Back: Orange
  Top: Yellow, Bottom: Blue, Left: Orange, Right: Green, Front: Orange, Back: Blue
Found solution:
  Top: Blue, Bottom: Orange, Left: Yellow, Right: Orange, Front: Green, Back: Yellow
  Top: Orange, Bottom: Green, Left: Yellow, Right: Yellow, Front: Yellow, Back: Blue
  Top: Green, Bottom: Yellow, Left: Blue, Right: Blue, Front: Orange, Back: Green
  Top: Yellow, Bottom: Blue, Left: Green, Right: Orange, Front: Blue, Back: Orange
Found solution:
  Top: Green, Bottom: Yellow, Left: Orange, Right: Yellow, Front: Blue, Back: Orange
  Top: Yellow, Bottom: Blue, Left: Yellow, Right: Yellow, Front: Orange, Back: Green
  Top: Orange, Bottom: Green, Left: Blue, Right: Blue, Front: Green, Back: Yellow
  Top: Blue, Bottom: Orange, Left: Orange, Right: Green, Front: Yellow, Back: Blue
Found solution:
  Top: Green, Bottom: Yellow, Left: Yellow, Right: Orange, Front: Orange, Back: Blue
  Top: Yellow, Bottom: Blue, Left: Yellow, Right: Yellow, Front: Green, Back: Orange
  Top: Orange, Bottom: Green, Left: Blue, Right: Blue, Front: Yellow, Back: Green
  Top: Blue, Bottom: Orange, Left: Green, Right: Orange, Front: Blue, Back: Yellow

It actually found eight solutions. On closer inspection, you can see that they are in two lots of four. Four represent the same solution rotated 0, 90, 180 and 270 degrees about the lateral axis. The other four are the same as the first four, but with each cube rotated 180 degrees about its normal axis. This effectively swaps the left and right sides of each die. This works because the left and rights aren’t considered in the solution.