Pirrmann's train of thought

With Wimbledon’s final this weekend, I recalled that I had not blogged about the “Evil Tennis kata” I played with, a few months ago. Its aim was to compute a tennis score from a series of game events. This kata is inspired by the original tennis kata, but does not stop at the game level and computes the score for a whole match.

Let’s consider a tennis match. We can see it as a list of points, either won by player A or player B. For instance, here are the first points from Sunday’s final:

["Murray"; "Murray"; "Murray"; "Djokovic"; "Djokovic"; "Djokovic"; "Djokovic"; "Djokovic"; "Murray"; "Murray"; "Murray"; "Djokovic"; "Murray"; "Djokovic"; "Murray"; "Murray"; "Murray"; "Djokovic"; "Djokovic"; "Djokovic"; "Murray"; "Murray"; "Djokovic"; "Murray"; "Djokovic"; "Murray"; "Murray"; "Djokovic"; "Djokovic"… ]

One of the goals of the kata is to be able to determine the final score from the match events. It can also be to print nicely every score from the start until the end, like it is done for instance on the following page:
http://www.flashscore.com/match/SSmzQE8d/#point-by-point;1

Once again, it has been a nice way to practice F#:

type Player = PlayerA | PlayerB
type GameEvent = Point of Player
type GameScore = GameScore of int * int
type SetScore = GameScore list
type Match = SetScore list

type Outcome =
    | Win of Player
    | Pending

I use a single union type to define the score of a game, composed of the number of points won by player A and the number of points won by player B. For instance, GameScore(3,1) means that the current game score is 40-15. Using classical integers to count the points is much easier than trying to reason directly in the tennis scoring system, which is seriously twisted. In order to display a classical score from this representation, here is the first function:

let displayGame (GameScore(a, b)) =
    let displayScore score =
        match score with
        | 0 -> "0"
        | 1 -> "15"
        | 2 -> "30"
        | 3 -> "40"
        | _ -> failwith "Invalid argument score"
    match a, b with
    | a, b when a <= 3 && b <= 3 -> sprintf "%s - %s" (displayScore a) (displayScore b)
    | a, b when a = b -> "Deuce"
    | a, b when a = b + 1 -> "Adv A"
    | a, b when a = b - 1 -> "Adv B"
    | a, b when a > b -> "Game A"
    | _ -> "Game B"

Now what we want is to be able to build a GameScore from a series of GameEvent. This can be achieved nicely with a function and a fold:

let updateGame (GameScore(a, b)) event =
    let newGame =
        match event with
        | Point(PlayerA) -> GameScore(a + 1, b)
        | Point(PlayerB) -> GameScore(a, b + 1)
    newGame

[Point(PlayerA);Point(PlayerA);Point(PlayerB);Point(PlayerA)]
|> Seq.fold updateGame (GameScore(0, 0)) 
|> displayGame

The previous sample code prints out the score : “40 – 15”.

When we try to go a step further, displaying the score of a particular game becomes less interesting. What we really want is to check the victory condition at the game level, in order to determine whether the next point will start a new game:

let getGameOutcome (GameScore(a, b)) =
    match (a, b) with
    | a, b when a > 3 && a > b + 1 -> Win(PlayerA)
    | a, b when b > 3 && a < b - 1 -> Win(PlayerB)
    | _ -> Pending

From there, we can build an updateSet method:

let updateSet previousSet event =
    match previousSet with
    | previousGame :: previousGames ->
        match getGameOutcome previousGame with
        | Win(_) -> updateGame (GameScore(0, 0)) event :: previousGame :: previousGames
        | Pending -> updateGame previousGame event :: previousGames
    | [] -> updateGame (GameScore(0, 0)) event :: []

Similarly, we need to determine at some point whether the set has been won. In order to do this we have to count the games won by each player. Here is how I did it:

let countWins games =
    let rec countWinsRec games (a, b) =
        match games with
        | game :: otherGames ->
            let wins =
                match getGameOutcome game with
                | Win(PlayerA) -> (a + 1, b)
                | Win(PlayerB) -> (a, b + 1)
                | _ -> (a, b)
            countWinsRec otherGames wins
        | _ -> (a, b)
    countWinsRec games (0, 0)

From there, we can determine whether a set is won:

let getSetOutcome (setScore:SetScore) =
    let (a, b) = countWins setScore
    match (a, b) with
    | a, b when a > 5 && a > b + 1 -> Win(PlayerA)
    | a, b when b > 5 && a < b - 1 -> Win(PlayerB)
    | _ -> Pending

The next step is to move to the match level:

let updateMatch previousMatch event =
    match previousMatch with
    | previousSet :: previousSets ->
        match getSetOutcome previousSet with
        | Win(_) -> updateSet [] event :: previousSet :: previousSets
        | Pending -> updateSet previousSet event :: previousSets
    | [] -> updateSet [] event :: []

Finally, we can use the updateMatch method in a fold to build a representation of the match:

let buildMatch events = List.fold updateMatch [] events

The result is a reversed list of reversed list of GameScores…

[[GameScore (6,8); GameScore (1,4); GameScore (2,4); GameScore (2,4);
  GameScore (4,1); GameScore (4,1); GameScore (4,2); GameScore (4,2);
  GameScore (0,4); GameScore (2,4)];
 [GameScore (0,4); GameScore (2,4); GameScore (2,4); GameScore (4,0);
  GameScore (5,7); GameScore (4,6); GameScore (1,4); GameScore (4,2);
  GameScore (4,1); GameScore (4,2); GameScore (3,5); GameScore (4,1)];
 [GameScore (0,4); GameScore (5,3); GameScore (5,7); GameScore (0,4);
  GameScore (0,4); GameScore (4,2); GameScore (4,1); GameScore (6,8);
  GameScore (1,4); GameScore (5,3)]]

That is not a very readable result… Here I go for a last function:

let displayMatchScore events = 
    let displaysWins (a, b) = sprintf "%i - %i" a b
    let displaySet games = displaysWins (countWins games)
    let rec getSetScoreToDisplay sets =
        match sets with
        | games :: [] ->
            match games with
            | game :: _ -> displaySet games :: []
            | _ -> displaySet games :: []
        | games :: otherSets -> displaySet games :: getSetScoreToDisplay otherSets
        | [] -> failwith "Error"
    getSetScoreToDisplay (buildMatch events |> List.rev)

This last one aggregates the events, in order to display a much more simple list of scores:

let score = displayMatchScore events

And the final score is displayed : ["4 - 6"; "5 - 7"; "4 - 6"] !

Last time, I blogged about the Potter Kata, and I carefully followed the advice, which was to only do the minimum required work to pass the tests. This time, I’m going to break the rule and implement a generic solver for the problem, although it may have no practical interest whatsoever.

Let’s pretend that in the pricing rules applied last time, the discount percentages could change, depending on the mood of a very lunatic sales person. For instance, he (or she) might decide that on a particular day, we remove the discount on the pack of two books, and introduce a “buy 2, get 1 free” offer. The prices would then become:

Now, let’s examine the previous “edge-case” basket, composed of:

• 2 copies of the first book
• 2 copies of the second book
• 2 copies of the third book
• 1 copy of the fourth book
• 1 copy of the fifth book

With the new pricing rules, the new best price is obtained by (5 * 8.0 * 0.75) + (2 * 8.00 + 1 * 0.00) and is 46.00 EUR. Here, the greedy algorithm is correct again, so we could just remove our adjustment rule from last time, isn’t it? Of course not! If we add one more book in the basket, the best price becomes… 3 * (2 * 8.00 + 1 * 0.00) = 48.00 EUR.

So how do we solve that ? Well, we could simply try a brute force solution, compute every single possible set of sets of books, price them, and take the cheapest option. But here we have an interesting property: every book has the same price. So evaluating [[1;2];[1;2];[3]] and [[1;2];[1;3];[2]] is exactly the same. When we consider books, we don’t really care about their individual number or title, but only about whether they are distinct from each other or not.

So here is my take on a solver algorithm. First, we take the books and organize them by types, sorted by ascending quantity:

let types = books |> Seq.countBy id |> Seq.map snd |> Seq.sort |> Seq.toList |> List.rev

This means that the following books [1;2;3;1;2;3;4;5] get transformed to the list [1;1;2;2;2], which means “a book that appears only once, then another one, then one that appears twice, then another one, and yet another one”.

From this representation, we can price the basket by splitting it into two simpler baskets, in several ways, price each combinations, and take the cheapest. To split the basket, we remove a single item of each kind of book, for the first n types. An example is worth a thousand words here:

From [1;1;2;2;2] we can get the following splittings:

• [1] + [1;2;2;2]
• [1;1] + [2;2;2]
• [1;1;1] + [1;2;2]
• [1;1;1;1] + [1;1;2]
• [1;1;1;1,1] + [1;1;1]

The first half is always priced directly as there is never more than one book of each kind. The second half is priced recursively using the same principle.

The algorithm is the following:

let rec priceTypes priceBucket (types: int list) =
    let nbTypes = List.length types
    if nbTypes = 0 then 0.0M
    else
        let allPrices = seq {
            for bucketSize = 1 to nbTypes do
                let bucketPrice = priceBucket bucketSize
                let remainingTypes =
                    types
                    |> Seq.mapi (fun i n -> if i < bucketSize then n - 1 else n)
                    |> Seq.filter (fun n -> n > 0)
                    |> Seq.sort |> Seq.toList |> List.rev

                yield bucketPrice + priceTypes priceBucket remainingTypes }
        allPrices |> Seq.min

There are many combinations. This will lead to long computations, even with a low number of books. But many of these computations will share some identical combinations, and they don’t need to be run several times. This is just what memoization is designed for. The principle is simple: when an idempotent function gets the same input twice, it must generate the same output. From there, if we can record the generated output the first time and associate it with the input, the next time we get this input we can directly return the recorded output.

A standard memoize function can then be defined:

let memoize f =
    let dict = Dictionary<_, _>()
    fun x ->
        match dict.TryGetValue(x) with
        | true, res -> res
        | false, _ -> 
            let res = f x
            dict.Add(x, res)
            res

The things get a little more complicated when recursion is involved because in order to memoize effectively a recursive function, the function itself has to call its memoized version recursively (instead of itself). It gets even more complicated if you need the whole recursive thing to be tail-recursive. For now, hopefully, we don’t need that, because the tree of combinations that we try to build is quite wide, but not very deep.

My implementation of the memoized version is the following:

let rec priceTypes priceBucketFunc =
    let rec memoizedPriceTypes =
        let priceTypesRaw (types: int list) =
            let nbTypes = List.length types
            if nbTypes = 0 then 0.0M
            else
                let allPrices = seq {
                    for bucketSize = 1 to nbTypes do
                        let bucketPrice = priceBucketFunc bucketSize
                        let remainingTypes =
                            types
                            |> Seq.mapi (fun i n -> if i < bucketSize then n - 1 else n)
                            |> Seq.filter (fun n -> n > 0)
                            |> Seq.sort |> Seq.toList |> List.rev

                        yield bucketPrice + memoizedPriceTypes remainingTypes }
                allPrices |> Seq.min
        memoize priceTypesRaw
    memoizedPriceTypes

We can now build a price function that takes a “priceBucket” function as an argument, and returns the actual pricing function:

let price priceBucketFunc books =
    let types = books |> Seq.countBy id |> Seq.map snd |> Seq.sort |> Seq.toList |> List.rev
    priceTypes priceBucketFunc types

The function can then be used this way:

let priceBucket = function | 1 -> 8.0M | 2 -> 16.0M | 3 -> 16.0M | 4 -> 25.6M
                           | 5 -> 30.0M | _ -> failwith "Really ? 6 books ?"
let price = PotterKataTooMuch.price priceBucket
price [1;1;2;2;3;3;4;5]

It works on small to medium lists of books (such as 50 books for instances). Let’s pretend the world is perfect, and that it’s enough for today!

The code from this post and the previous one is available on GitHub.

Yesterday evening I was running Arolla’s Code Jam, and I suggested that we practice on the Potter Kata. This kata is a tricky one, which seems pretty simple at first, but shows its challenges after a few minutes, and it is very easy to get it wrong. In order to prepare the Jam and improve my level in F#, I practiced the kata this week, and I wanted to share my thoughts about it.

You can read the original problem description on codingdojo.org. I’ll just recap the pricing rules here for reference:

The rules are then followed by some clues:

You’ll find that this Kata is easy at the start. You can get going with tests for baskets of 0 books, 1 book, 2 identical books, 2 different books… and it is not too difficult to work in small steps and gradually introduce complexity.

However, the twist becomes apparent when you sit down and work out how much you think the sample basket above should cost. It isn’t 5*8*0.75+3*8*0.90. It is in fact 4*8*0.8+4*8*0.8. So the trick with this Kata is not that the acceptance test you’ve been given is wrong. The trick is that you have to write some code that is intelligent enough to notice that two sets of four books is cheaper than a set of five and a set of three.

You will have to introduce a certain amount of clever optimization algorithm. But not too much! This problem does not require a fully-fledged general purpose optimizer. Try to solve just this problem well in order to share it. Trust that you can generalize and improve your solution if and when new requirements come along.

It is clear here that the goal of this kata is not to write a general-purpose solver. I must agree that a general-purpose solver is not the best solution to the problem, as most probably You Aren’t Gonna Need It.

So I first tackled the kata, trying to do the bare minimum required to handle the requirements. In F#, my implementation goes down to 20 lines of code. The trick is that a greedy grouping of books (the “most intuitive” solution) is correct, except for the corner case where a group of 5 five books and a group of 3 books is actually more expensive than two groups of 4 books.

Disclaimer: I’m going to show an implementation of the kata here. If you’ve never tried it before, I suggest that you practice on your own first, because the solution in itself is really not as valuable as the path to get there.

I’ll use some of the test cases provided in the original kata, plus the ones we came up with last night. In F#, I get these kinds of tests:

[<TestMethod>]
member x.``1 book (each kind)`` () = 
    Assert.AreEqual(8.0M, price [1])
    Assert.AreEqual(8.0M, price [2])
    Assert.AreEqual(8.0M, price [3])
    Assert.AreEqual(8.0M, price [4])
    Assert.AreEqual(8.0M, price [5])

[<TestMethod>]
member x.``2 same books`` () = 
    Assert.AreEqual(16.0M, price [1;1])
    Assert.AreEqual(24.0M, price [2;2;2])

[<TestMethod>]
member x.``2 distinct books`` () = 
    Assert.AreEqual(15.2M, price [1;2])

[<TestMethod>]
member x.``3 distinct books`` () = 
    Assert.AreEqual(21.6M, price [1;2;3])

[<TestMethod>]
member x.``4 distinct books`` () = 
    Assert.AreEqual(25.6M, price [1;2;3;4])

[<TestMethod>]
member x.``5 distinct books`` () = 
    Assert.AreEqual(30.0M, price [1;2;3;4;5])

[<TestMethod>]
member x.``Simple discount`` () = 
    Assert.AreEqual(29.6M, price [1;2;1;3])

If we read the test cases carefully, nothing forces us to have a notion of “discount” in our implementation. In fact, pricing a group of distinct books is almost a single-liner:

let priceGroup = function | 1 -> 8.0M | 2 -> 15.2M | 3 -> 21.6M
                          | 4 -> 25.6M | 5 -> 30.0M | _ -> failwith "What ? A 6th book ?"

Now, this obviously doesn’t work when we try to buy the same book more than once. In order to consume the previously defined function, we have to build groups of books. A greedy grouping seems accurate at first:

let greedyGroup books = 
    // we count how many books there are of each type and sort them
    let types = books |> Seq.countBy id |> Seq.map snd |> Seq.sort |> Seq.toList
    // then we recursively compute how many groups of books we can build
    let rec countGroups types used =
        match types with
        | [] -> []
        | head :: tail -> head - used :: countGroups tail head
    countGroups types 0 |> List.rev

I’m pretty happy with function. The first expression get en ordered list from the books: a list of books [1;1;2;2;3;4] produces a list of of types of books [1;1;2;2], that can be read as “a type with a single book, a type with a single book, a type with 2 books, a type with 2 books”. The recursive function counts how many groups of distinct books can be built from these type. Here, the output is [0;1;0;1] which means “0 group of 1 books, 1 group of 2 books, 0 group of 3 books, 1 group of 4 books”.

Now, we combine our functions into a price function:

let price books =
    books
    |> greedyGroup
    |> Seq.mapi (fun i nb -> priceGroup (i+1) * decimal nb)
    |> Seq.sum

We’re almost there. This code is incorrect for the edge case we identified before. But do we have to break everything and build a general-purpose solver? No. We just have to handle the edge case and adjust the grouping:

let adjust = function 
    | [a; b; c; d; e] ->
        let shift = min c e
        [a; b; c-shift; d+2*shift; e-shift]
    | l -> l

Basically, this adjust function replaces every pair of 5 distinct books and 3 distinct books by a 2 groups of 4 distinct books, which are cheaper.

Finally, the pricing function with the adjustment becomes:

let price books =
    books
    |> greedyGroup
    |> adjust
    |> Seq.mapi (fun i nb -> priceGroup (i+1) * decimal nb)
    |> Seq.sum

And that’s done.

Bonus: F# brings you such a nice type inference that without changing any line in my previous code, I can use the book titles instead of their numbers (or anything that has equality comparison!).

let test_generic_1 = price ["Harry Potter and the Philosopher's Stone";
                            "Harry Potter and the Chamber of Secrets";
                            "Harry Potter and the Prisoner of Azkaban";
                            "Harry goes to Hollywood";
                            "Harry Rabienkirira - ledernier"]

let test_generic_2 = price [typedefof<System.Collections.ArrayList>;
                            typedefof<System.String>;
                            typedefof<System.Int32>]

Of course, building a general purpose solver for the same problem is too appealing to be ignored. That will be the subject of the next post, featuring tail-recursion and memoization!

(For those of you who wonder where the “Pattern-matching” series has gone, it’s coming back soon)