Saturday, March 13, 2010

Bowling Kata as a Haskell Exercise (First Attempt)

At this point I wonder if I should consider renaming this blog to be the Bowling Kata blog. The reason I keep using it is that I find the complexity of the kata is just about right for a simple but non-trivial task, and so it will probably show up again; most likely in x86 assembly, but that's for another time. There is some other content on the way as well, I promise.

I'm currently trying to learn Haskell, a purely functional language, so with that in mind, I figured I'd try to implement the bowling kata as a first exercise, using the HUnit test framework to test it. I'm sure that this implementation will broadcast clearly to anyone in the know that I come from an OO imperative programming world, so I'll welcome any constructive criticism as usual.

For those interested in looking into Haskell, both of these tutorials have been of great help so far.
For HUnit, Getting Started With HUnit has been great to quickly get the hang of it.

Anyway, without further ado, the Bowling Kata, Haskell style.

Bowling Kata in Haskell
I'm following the same test order as I did with the C# implementation, so my first test is for a game of all gutterballs. Just to show how the test module is set up, this first code snippet also includes the header info.
module ScorerTest where

import HUnit
import Scorer

main = runTestTT $ TestList [allGuttersReturnZero]

allGuttersReturnZero = TestCase $ assertEqual
    "All gutterballs" 0 (calculateScore $ replicate 20 0)
And the following implementation of calculateScore looks like this. In short, define a function that takes a list of type number, and returns a number. To make the first test pass, we accept the list xs, but return zero no matter what.
module Scorer (calculateScore) where

calculateScore :: (Num a) => [a] -> a
calculateScore xs = 0
The next test is to roll all ones, avoiding the more complicated spare and strike cases.
allBallsKnockDownOnePin = TestCase $ assertEqual
    "All balls roll one" 20 (calculateScore $ replicate 20 1)
To make this pass for both test cases, we simply sum up all of the rolls passed in.
calculateScore :: (Num a) => [a] -> a
calculateScore xs = sum xs
Then we begin to get to the meat of the problem, this time rolling a strike on the first frame and following with ones for the rest of the rolls.
firstFrameStrikeRestOnes = TestCase $ assertEqual
    "First frame is strike, rest ones" 30 (calculateScore $ [10] ++ replicate 18 1)
To make this test pass, a bit more work is needed.

First of all, since we're introducing recursion at this stage, the edge case needs to be covered, which is calculateScore being called with an empty list. We set it to return zero if that is the case.

Secondly, we split up the list coming in into head and tails (x:xs), and then check the head (x) to see if it's equal to 10 - a strike. If it is, we sum it up along with the next two values in the list (take 2 xs) and then run the calculation again on the rest of the list. If the value is not 10, we just take off the first element, and add it to the score calculation of the rest of the list.

More succinctly, it looks like the following.
calculateScore :: (Num a) => [a] -> a
calculateScore [] = 0
calculateScore (x:xs)
    | x == 10   = x + sum (take 2 xs) + calculateScore xs
    | otherwise = x + calculateScore xs
Moving on with the tests, we devise one where all of the rolls are strikes to see how the code performs. As expected, we get a score of 330 instead of 300, since the algorithm doesn't know to not count the last two balls as fully scoring strikes. So we consider frames instead of individual balls.
allFramesAreStrikes = TestCase $ assertEqual
    "All frames are strikes" 300 (calculateScore $ replicate 12 10)
I have to admit that I got a little stuck here, since I'm still trying to get the hang of the functional way of thinking, so thanks to Tom Moertel, Isaac Gouy and Phillip Schwarz, whose solutions I found online to help me adjust my plan of attack.

Switching over to using frames as a basis instead of balls required a bit more extensive code rewriting, including breaking frame scoring out into its own function, which takes the list of rolls, the current total and the frame as arguments.

The function itself is split into three cases. First a case to make sure the calculation stops after the 10th frame, then a case to handle the last frame if there are no special rolls. These first two are our edge cases.

Lastly, the general case for the remaining rolls scores the list recursively. It splits the list of rolls into four components - the first three balls and the remaining list. If the first roll is 10 (a strike), it then scores the next frame along with the remaining list, at the same time adding the first three balls to the score. Otherwise it scores the same way, but adding only the first two balls to the score.

This is how it looked when I wrote it.
calculateScore :: (Num a) => [a] -> a
calculateScore rolls = scorePerFrame rolls 0 0
    
scorePerFrame :: (Num a) => [a] -> a -> a -> a
scorePerFrame rolls score 10 = score
scorePerFrame [x,y] score frame = score+x+y
scorePerFrame (x:y:z:rest) score frame 
    | x == 10   = scorePerFrame (y:z:rest) (score+x+y+z) (frame+1)
    | otherwise = scorePerFrame (z:rest)   (score+x+y)   (frame+1)
Once this framework is in place, adding the case for spares is pretty simple. First the test case.
firstFrameSpareRestOnes = TestCase $ assertEqual
    "First frame is spare, rest ones" 29 (calculateScore $ [5,5] ++ replicate 18 1)
And then we just add a line that matches a spare.
scorePerFrame (x:y:z:rest) score frame 
    | x == 10     = scorePerFrame (y:z:rest) (score+x+y+z) (frame+1)
    | x + y == 10 = scorePerFrame (z:rest)   (score+x+y+z) (frame+1)
    | otherwise   = scorePerFrame (z:rest)   (score+x+y)   (frame+1)
In theory, this solution should work fine if I roll all spares as well, but for my own sense of security, I'll write that test anyway.
allFramesAreSpares = TestCase $ assertEqual
    "All frames are spares" 150 (calculateScore $ replicate 21 5)
It passes right away, so no code changes needed. So there you have it, the bowling scorer in Haskell.

The final code follows below. I tried to do a little refactoring, but in the end I found the current terse style was more legible. Part of that I think is a nature of the Haskell syntax. x, y and z could perhaps be replaced with "first, second and third," but I thought it just made it look bulky.

The Tests
module ScorerTest where

import HUnit
import Scorer

main = runTestTT $ TestList [
    allGuttersReturnZero, 
    allBallsKnockDownOnePin, 
    firstFrameStrikeRestOnes, 
    allFramesAreStrikes,
    firstFrameSpareRestOnes,
    allFramesAreSpares
    ]

allGuttersReturnZero = TestCase $ assertEqual
    "All gutterballs" 0 (calculateScore $ replicate 20 0)
    
allBallsKnockDownOnePin = TestCase $ assertEqual
    "All balls roll one" 20 (calculateScore $ replicate 20 1)
    
firstFrameStrikeRestOnes = TestCase $ assertEqual
    "First frame is strike, rest ones" 30 (calculateScore $ [10] ++ replicate 18 1)

allFramesAreStrikes = TestCase $ assertEqual
    "All frames are strikes" 300 (calculateScore $ replicate 12 10)
    
firstFrameSpareRestOnes = TestCase $ assertEqual
    "First frame is spare, rest ones" 29 (calculateScore $ [5,5] ++ replicate 18 1)
    
allFramesAreSpares = TestCase $ assertEqual
    "All frames are spares" 150 (calculateScore $ replicate 21 5)
The Code
module Scorer (calculateScore) where

calculateScore :: (Num a) => [a] -> a
calculateScore rolls = scorePerFrame rolls 0 0
    
scorePerFrame :: (Num a) => [a] -> a -> a -> a
scorePerFrame rolls score 10 = score
scorePerFrame [x,y] score frame = score+x+y
scorePerFrame (x:y:z:rest) score frame 
    | x == 10     = scorePerFrame (y:z:rest) (score+x+y+z) (frame+1)
    | x + y == 10 = scorePerFrame (z:rest)   (score+x+y+z) (frame+1)
    | otherwise   = scorePerFrame (z:rest)   (score+x+y)   (frame+1)

4 comments:

  1. My thoughts, as a mediocre intermediate Haskeller:

    - I'd put scorePerFrame in a `where' clause below calculateScore.
    - I'd try and get rid of the frame counting. Why not just stop when rolls is empty?
    (You're not doing full well-formedness checking of frames anyways)

    - An issue with the _problem_ rather than your solution: my fingers would itch to define some data structure that would _only_ be able to represent a well-formed series of frames. Hmm, perhaps something like this:

    data Hit = First | Second | Never
    data Frame = Hits { pin1 :: Hit, pin2 :: Hit, {- and so on -} pin10 :: Hit }
    data Series = Frame { frame1 :: Frame {- and more -} }

    It definitely doesn't make this kata any shorter or smoother, or perhaps improves it in an way, but in a real, serious, industry-grade bowling application, I'd want to ask the type system for _some_ kind of help.

    ReplyDelete
  2. Also, what's with the many and long names? I'd go with

    main = runTestTT $ TestList [
    TestCase $ assertEquals "gutterballs" 0 $ score $ replicate 20 0,
    ...]

    And perhaps, depending on how crufty a mood I was in, I might not have an inner function scorePerFrame but just have score evaluate to 0 on [] and (scoreOfThisFrame + score the_rest) otherwise. In any case, I'd call it something short and generic like loop, step, go, rec, recur or something like that.

    (For some less local helper routine I might do something different)

    ReplyDelete
  3. It's a good while since I last wrote this, but I think you'll find that funny stuff happens when you try to account for strikes and spares in the 10th frame, where the rules are special, if you don't track which frame you're on. Typically, you'll get a result of greater than 300 for a perfect game, for example.

    As for names, I've always been a fan of tiny functions with clear names. Code and unit tests as documentation and all that. While it might not be as necessary for small programs like this, it's a habit. :)

    What is not well formed in the checking of frames? I'm an utter Haskell noob, so maybe you can elaborate there.

    For a perhaps more compact example with a similar structure, I did this exercise in F# as well a while back, that I think is more like your crufty mood example.

    http://codernub.blogspot.com/2010/05/bowling-kata-in-f-yup-more-bowling.html

    If you do an example with a custom data structure, I'd love to see it. There's nothing in the definition of the problem that says you couldn't do that, and it sounds like a cool exercise. :)

    ReplyDelete