This post is a walk-through of doing the Diamond kata with FsCheck.

Recently, Nat Pryce tweeted:

The diamond kata, TDD'd only with property-based tests. https://github.com/npryce/property-driven-diamond-kata One commit for each step: add test/make test pass/refactor
This made me curious. First, I'd never heard about the Diamond kata, and second, I find Property-Based Testing quite interesting these days.

Digging a bit lead me to a blog post by Seb Rose; the Diamond kata is extremely easy to explain:

Given a letter, print a diamond starting with ā€˜Aā€™ with the supplied letter at the widest point.

For example: print-diamond ā€˜Cā€™ prints

  A
 B B 
C   C
 B B 
  A  
After having thought about it a little, I couldn't even begin to see how one could approach this problem using Property-Based Testing. It struck me as a problem inherently suited for Example-Driven Development, so I decided to do that first.

Example-Driven Development

The no-brain approach to Example-Driven Development is to start with 'A', then 'B', and so on. Exactly as Seb Rose predicts, when you approach the problem like this, when you reach 'C', it no longer seems reasonable to hard-code the responses, but then the entire complexity of the problem hits you all at once. It's quite hard to do incremental development by going through the 'A', 'B', 'C' progression.

This annoyed me, but I was curious about the implementation, so I spent an hours or so toying with making the 'C' case pass. After this, on the other hand, I had an implementation that works for all letters A-Z.

Property-Driven Development

On my commute it subsequently struck me that solving the Diamond kata with Example-Driven Development taught me a lot about the problem itsef, and I could easily come up with the first 10 properties about it.

Therefore, I decided to give the kata another try, this time with FsCheck. I also wanted to see if it would be possible to make the development more incremental; while I didn't follow the Transformation Priority Premise (TPP) to the letter, I was inspired by it. My third 'rule' was to use Devil's Advocate to force me to write properties that completely describe the problem.

Ice Breaker

To get started, it can be a good idea to write a simple (ice breaker) test, because there's always a little work involved in getting everything up and running. To meet that goal, I wrote this almost useless property:

[<Property(QuietOnSuccess = true)>]
let ``Diamond is non-empty`` (letter : char) =
    let actual = Diamond.make letter
    not (String.IsNullOrWhiteSpace actual)

It only states that the string returned from the Diamond.make function isn't an empty string. Using Devil's Advocate, I created this implementation:

let make letter = "Devil's advocate."

This hard-coded result satisfies the single property. However, the only reason it works is because it ignores the input.

Constraining the input

The kata only states what should happen for the inputs A-Z, but as currently written, FsCheck will serve all sorts of char values, including white space and funny characters like '<', ']', '?', etc. While I could write a run-time check in the make function, and return None upon invalid input, I am, after all, only doing a kata, so I'd rather want to tell FsCheck to give me only the letters A-Z. Here's one way to do that:

type Letters =
    static member Char() =
        Arb.Default.Char()
        |> Arb.filter (fun c -> 'A' <= c && c <= 'Z')
 
type DiamondPropertyAttribute() =
    inherit PropertyAttribute(
        Arbitrary = [| typeof<Letters> |],
        QuietOnSuccess = true)
 
[<DiamondProperty>]
let ``Diamond is non-empty`` (letter : char) =
    let actual = Diamond.make letter
    not (String.IsNullOrWhiteSpace actual)

The Letters type redefines how char values are generated, using the default generator of char, but then filtering the values so that they only fall in the range [A-Z].

To save myself from a bit of typing, I also defined the custom DiamondPropertyAttribute that uses the Letters type, and used it to adorn the test function instead of FsCheck's built-in PropertyAttribute.

Top and bottom

Considering the TPP, I wondered which property I should write next, since I wanted to define a property that would force me to change my current implementation in the right direction, but only by a small step.

A good candidate seemed to state something about the top and bottom of the diamond: the first and the last line of the diamond must always contain a single 'A'. Here's how I expressed that in code:

let split (x : string) =
    x.Split([| Environment.NewLine |], StringSplitOptions.None)
 
let trim (x : string) = x.Trim()
 
[<DiamondProperty>]
let ``First row contains A`` (letter : char) =
    let actual = Diamond.make letter
 
    let rows = split actual
    rows |> Seq.head |> trim = "A"
 
[<DiamondProperty>]
let ``Last row contains A`` (letter : char) =
    let actual = Diamond.make letter
 
    let rows = split actual
    rows |> Seq.last |> trim = "A"

Notice that I wrote the test-specific helper functions split and trim in order to make the code a bit more readable, and that I also decided to define the property for the top of the diamond separately from the property for the bottom.

In the degenerate case where the input is 'A', the first and the last rows are identical, but the properties still hold.

Using the Devil's Advocate, this implementation passes all properties defined so far:

let make letter = "        A       "

This is slightly better, but I purposely placed the 'A' slightly off-centre. In fact, the entire hard-coded string is 16 characters wide, so it can never have a single, centred letter. The next property should address this problem.

Vertical symmetry

A fairly important property of the diamond is that it must be symmetric. Here's how I defined symmetry over the vertical axis:

let leadingSpaces (x : string) =
    let indexOfNonSpace = x.IndexOfAny [| 'A' .. 'Z' |]
    x.Substring(0, indexOfNonSpace)
 
let trailingSpaces (x : string) =
    let lastIndexOfNonSpace = x.LastIndexOfAny [| 'A' .. 'Z' |]
    x.Substring(lastIndexOfNonSpace + 1)
 
[<DiamondProperty>]
let ``All rows must have a symmetric contour`` (letter : char) =
    let actual = Diamond.make letter
    
    let rows = split actual
    rows |> Array.forall (fun r -> (leadingSpaces r) = (trailingSpaces r))

Using the two new helper functions, this property states that the diamond should have a symmetric contour; that is, that it's external shape should be symmetric. The property doesn't define what's inside of the diamond.

Again, using the Devil's Advocate technique, this implementations passes all tests:

let make letter = "        A        "

At least the string is now symmetric, but it feels like we aren't getting anywhere, so it's time to define a property that will force me to use the input letter.

Letters, in correct order

When considering the shape of the required diamond, we know that the first line should contain an 'A', the next line should contain a 'B', the third line a 'C', and so on, until the input letter is reached, after which the order is reversed. Here's my way of stating that:

[<DiamondProperty>]
let ``Rows must contain the correct letters, in the correct order``
    (letter : char) =
    
    let actual = Diamond.make letter
 
    let letters = ['A' .. letter]
    let expectedLetters =
        letters @ (letters |> List.rev |> List.tail) |> List.toArray
    let rows = split actual
    expectedLetters = (rows |> Array.map trim |> Array.map Seq.head)

The expression let letters = ['A' .. letter] produces a list of letters up to, and including, the input letter. As an example, if letter is 'D', then letters will be ['A'; 'B'; 'C'; 'D']. That's only the top and middle parts of the diamond, but we can use letters again: we just have to reverse it (['D'; 'C'; 'B'; 'A']) and throw away the first element ('D') in order to remove the duplicate in the middle.

This property is still quite loosely stated, because it only states that each row's first non-white space character should be the expected letter, but it doesn't say anything about subsequent letters. The reason I defined this property so loosely was that I didn't want to force too many changes on the implementation at once. The simplest implementation I could think of was this:

let make letter =
    let letters = ['A' .. letter]
    let letters = letters @ (letters |> List.rev |> List.tail)
    letters
    |> List.map string 
    |> List.reduce (fun x y -> sprintf "%s%s%s" x System.Environment.NewLine y)

It duplicates the test code a bit, because it reuse the algorithm that generates the desired sequence of letters. However, I'm not too concerned about the occasional DRY violation.

For the input 'D', this implementation produces this output:

A
B
C
D
C
B
A

All properties still hold. Obviously this isn't correct yet, but I was happy that I was able to define a property that led me down a path where I could take a small, controlled step towards a more correct solution.

As wide as it's high

While I already have various properties that examine the white space around the letters, I've now temporarily arrived at an implementation entirely without white space. This made me consider how I could take advantage of those, and combine them with a new property, to re-introduce the second dimension to the figure.

It's fairly clear that the figure must be as wide as it's high, if we count both width and height in number of letters. This property is easy to define:

[<DiamondProperty>]
let ``Diamond is as wide as it's high`` (letter : char) =
    let actual = Diamond.make letter
 
    let rows = split actual
    let expected = rows.Length
    rows |> Array.forall (fun x -> x.Length = expected)

It simply verifies that each row has exactly the same number of letters as there are rows in the figure. My implementation then became this:

let make letter =
    let makeLine width letter =
        match letter with
        | 'A' ->
            let padding = String(' ', (width - 1) / 2)
            sprintf "%s%c%s" padding letter padding
        | _ -> String(letter, width)
 
    let letters = ['A' .. letter]
    let letters = letters @ (letters |> List.rev |> List.tail)
 
    let width = letters.Length
 
    letters
    |> List.map (makeLine width)
    |> List.reduce (fun x y -> sprintf "%s%s%s" x Environment.NewLine y)

This prompted me to introduce a private makeLine function, which produces the line for a single letter. It has a special case to handle the 'A', since this value is the only value where there's only a single letter on a line. For all other letters, there will be two letters - eventually with spaces between them.

This seemed a reasonable rationale for introducing a branch in the code, but after having completed the kata, I can see that Nat Pryce has a more elegant solution.

If the input is 'D' the output now looks like this:

   A   
BBBBBBB
CCCCCCC
DDDDDDD
CCCCCCC
BBBBBBB
   A   

There's still not much white space in the implementation, but at least we regained the second dimension of the figure.

Inner space

The next incremental change I wanted to introduce was the space between two letters. It seemed reasonable that this would be a small step for the makeLine function.

[<DiamondProperty>]
let ``All rows except top and bottom have two identical letters``
    (letter : char) =
 
    let actual = Diamond.make letter
 
    let isTwoIdenticalLetters x =
        let hasIdenticalLetters = x |> Seq.distinct |> Seq.length = 1
        let hasTwoLetters = x |> Seq.length = 2
        hasIdenticalLetters && hasTwoLetters
    let rows = split actual
    rows
    |> Array.filter (fun x -> not (x.Contains("A")))
    |> Array.map (fun x -> x.Replace(" """))
    |> Array.forall isTwoIdenticalLetters

The property itself simply states that each row must consist of exactly two identical letters, and then white space to fill out the shape. The way to verify this is to first replace all spaces with the empty string, and then examine the remaining string. Each remaining string must contain exactly two letters, so its length must be 2, and if you perform a distinct operation on its constituent char values, the resulting sequence of chars should have a length of 1.

This property only applies to the 'internal' rows, but not the top and bottom rows that contain a single 'A', so these rows are filtered out.

The new property itself only states that apart from the 'A' rows, each row must have exactly two identical letters. Because the tests for the 'A' rows, together with the tests for symmetric contours, already imply that each row must have a width of an uneven number, and again because of the symmetric contour requirement, I had to introduce at least a single space between the two characters.

let make letter =
    let makeLine width letter =
        match letter with
        | 'A' ->
            let padding = String(' ', (width - 1) / 2)
            sprintf "%s%c%s" padding letter padding
        | _ -> 
            let innerSpace = String(' ', width - 2)
            sprintf "%c%s%c" letter innerSpace letter
 
    let letters = ['A' .. letter]
    let letters = letters @ (letters |> List.rev |> List.tail)
 
    let width = letters.Length
 
    letters
    |> List.map (makeLine width)
    |> List.reduce (fun x y -> sprintf "%s%s%s" x Environment.NewLine y)

Using the Devil's Advocate technique, it seems that the simplest way of passing all tests is to fill out the inner space completely. Here's an example of calling Diamond.make 'D' with the current implementation:

   A   
B     B
C     C
D     D
C     C
B     B
   A   

Again, I like how this new property enabled me to do an incremental change to the implementation. Visually, we can see that the figure looks 'more correct' than it previously did.

Bottom triangle

At this point I thought that it was appropriate to begin to address the diamond shape of the figure. After having spent some time considering how to express that without repeating the implementation code, I decided that the easiest step would be to verify that the lower left space forms a triangle.

[<DiamondProperty>]
let ``Lower left space is a triangle`` (letter : char) =
    let actual = Diamond.make letter
 
    let rows = split actual
    let lowerLeftSpace =
        rows
        |> Seq.skipWhile (fun x -> not (x.Contains(string letter)))
        |> Seq.map leadingSpaces
    let spaceCounts = lowerLeftSpace |> Seq.map (fun x -> x.Length)
    let expected = Seq.initInfinite id
    spaceCounts
    |> Seq.zip expected
    |> Seq.forall (fun (x, y) -> x = y)

This one is a bit tricky. It examines the shape of the lower left white space. Getting that shape itself is easy enough, using the previously defined leadingSpaces helper function. For each row, spaceCounts contains the number of leading spaces.

The expected value contains an infinite sequence of numbers, {0; 1; 2; 3; 4; ...} because, due to the random nature of Property-Based Testing, I don't know exactly how many numbers to expect.

Zipping an infinite sequence with a finite sequence matches elements in each sequence, until the shortest sequence (that would be the finite sequence) ends. Each resulting element is a tuple, and if the lower left space forms a triangle, the sequence of tuples should look like this: {(0, 0); (1, 1); (2, 2); ...}. The final step in the property is therefore to verify that all of those tuples have identical elements.

The implementation uses Devil's Advocate, and goes quite a bit out of its way to make the top of the figure wrong. As you'll see shortly, it will actually be a simpler implementation to keep the figure symmetric around the horizontal axis as well, but we should have that as an explicit property.

let make letter =
    let makeLine width (letter, letterIndex) =
        match letter with
        | 'A' ->
            let padding = String(' ', (width - 1) / 2)
            sprintf "%s%c%s" padding letter padding
        | _ -> 
            let innerSpaceWidth = letterIndex * 2 - 1
            let padding = String(' ', (width - 2 - innerSpaceWidth) / 2)
            let innerSpace = String(' ', innerSpaceWidth)
            sprintf "%s%c%s%c%s" padding letter innerSpace letter padding
 
    let indexedLetters =
        ['A' .. letter] |> Seq.mapi (fun i l -> l, i) |> Seq.toList
    let indexedLetters = 
        (   indexedLetters
            |> List.map (fun (l, _) -> l, 1)
            |> List.rev
            |> List.tail
            |> List.rev)
        @ (indexedLetters |> List.rev)
 
    let width = indexedLetters.Length
 
    indexedLetters
    |> List.map (makeLine width)
    |> List.reduce (fun x y -> sprintf "%s%s%s" x Environment.NewLine y)

The main change here is that now each letter is being indexed, but then I deliberately throw away the indexes for the top part, in order to force myself to add yet another property later. While I could have skipped this step, and gone straight for the correct solution at this point, I was, after all, doing a kata, so I also wanted to write one last property.

The current implementation produces the figure below when Diamond.make is called with 'D':

   A   
  B B  
  C C  
D     D
 C   C 
  B B  
   A   

The shape is almost there, but obviously, the top is wrong, because I deliberately made it so.

Horizontal symmetry

Just as the figure must be symmetric over its vertical axis, it must also be symmetric over its horizontal axis:

[<DiamondProperty>]
let ``Figure is symmetric around the horizontal axis`` (letter : char) =
    let actual = Diamond.make letter
 
    let rows = split actual
    let topRows =
        rows
        |> Seq.takeWhile (fun x -> not (x.Contains(string letter))) 
        |> Seq.toList
    let bottomRows =
        rows
        |> Seq.skipWhile (fun x -> not (x.Contains(string letter)))
        |> Seq.skip 1
        |> Seq.toList
        |> List.rev
    topRows = bottomRows

This property finally 'allows' me to simplify my implementation:

let make letter =
    let makeLine width (letter, letterIndex) =
        match letter with
        | 'A' ->
            let padding = String(' ', (width - 1) / 2)
            sprintf "%s%c%s" padding letter padding
        | _ -> 
            let innerSpaceWidth = letterIndex * 2 - 1
            let padding = String(' ', (width - 2 - innerSpaceWidth) / 2)
            let innerSpace = String(' ', innerSpaceWidth)
            sprintf "%s%c%s%c%s" padding letter innerSpace letter padding
 
    let indexedLetters =
        ['A' .. letter] |> Seq.mapi (fun i l -> l, i) |> Seq.toList
    let indexedLetters = 
        indexedLetters @ (indexedLetters |> List.rev |> List.tail)
 
    let width = indexedLetters.Length
    
    indexedLetters
    |> List.map (makeLine width)
    |> List.reduce (fun x y -> sprintf "%s%s%s" x Environment.NewLine y)

Calling Diamond.make with 'D' now produces:

   A
  B B
 C   C
D     D
 C   C 
  B B  
   A   

It works with other letters, too.

Summary

It turned out to be an interesting exercise to do this kata with Property-Based Testing. To me, the most surprising part was that it was much easier to approach the problem in an incremental fashion than it was with Example-Driven Development.

If you're interested in perusing the source code, including my detailed, step-by-step commit remarks, it's on GitHub. If you want to learn more about Property-Based Testing, you can watch my Introduction to Property-based Testing with F# Pluralsight course. There are more examples in some of my other F# Pluralsight courses - particularly Type-Driven Development with F#.



Wish to comment?

You can add a comment to this post by sending me a pull request. Alternatively, you can discuss this post on Twitter or Google Plus, or somewhere else with a permalink. Ping me with the link, and I may add it as a comment.

Published

Saturday, 10 January 2015 22:10:00 UTC

Tags



"Our team wholeheartedly endorses Mark. His expert service provides tremendous value."
Hire me!