Solving Sudoku with F#

An unfinished sudoku puzzle
Can you solve it?

One of my more recent additions to the life of {Redacted} is a thing we call the Thursday Kata. Every Thursday, I pop a message into our slack channel, with a challenge for the week.  Dev team members noodle over the problem, slack a gist with their solution, and then on Wednesday, during our weekly team meeting, we vote on a submitted solution and have the author present what they did, how they did it, and what they learned.

It’s a lot of fun, and is gaining quite a bit of traction within the development org. Developers are walking around discussing the kata, and strategies for solving it, and it interrupts what can be some of the more mundane day-to-day tasks.

The tasks aren’t meant to take more than an hour or two. A more recent example was a Sudoku solver. Devs were challenged to come up with a solver, in whatever language they wanted to look at.

Unfortunately, as the emcee of this event, my own solutions are off limits for voting… but that’s when I remembered I have readers of this blog (even if it is only myself and my mom. Hi Mom!)  Here’s the gist.

Basically, I had two ideas. First, be able to parse and render a puzzle grid, and second, solve the grid using a simple recursive algorithm.

I started with a few types that would help me with the domain.

  1. Sector. A type that represented the 9 blocks (tic-tac-toe blocks) of a Sudoku grid.
  2. Position. A type that represented an individual location of a Sudoku grid. The position was made of a Rank and File, which indicated the X and Y coordinate (in similar terms to chess, a game I’m more familiar with.)
  3. Grid. A type simply mapping a Position (Rank and File) with integers.

The first thing I did was create a simple set of all available positions, and second I created a Map of positions with a unique set of positions to “check”. For example: the position at Rank.One and File.A (the upper left square), would be mapped to a distinct set of positions that included:

  • All positions in Rank.One (A1, B1, C1… I1)
  • All positions in File.A (A1, A2, A3… A9)
  • All positions in the same TopLeft sector (A1, B1, C1, A2, B2, C2, A3, B2, C3)

The next three functions were some simple rendering / parsing functions, enabling me to quickly test my solver, by entering grids as simple strings.

let easy = parseGrid "5,-,-,-,1,-,-,-,4,2,7,4,-,-,-,6,-,-,-,8,-,9,-,4,-,-,-,8,1,-,4,6,-,3,-,2,-,-,2,-,3,-,1,-,-,7,-,6,-,9,1,-,5,8,-,-,-,5,-,3,-,1,-,-,-,5,-,-,-,9,2,7,1,-,-,-,2,-,-,-,3";;

val easy : Grid option = Some (map [({Rank = One; File = A;}, 5; .... 

let rendered = renderGrid e;;
val rendered : string =
 5 - - | - 1 - | - - 4
 2 7 4 | - - - | 6 - -
 - 8 - | 9 - 4 | - - -
 8 1 - | 4 6 - | 3 - 2
 - - 2 | - 3 - | 1 - -
 7 - 6 | - 9 1 | - 5 8
 - - - | 5 - 3 | - 1 -
 - - 5 | - - - | 9 2 7
 1 - - | - 2 - | - - 3

Ah UI code… my favorite ūüôā

I created a few helper functions to make some logical tests work as well.

  • getAvailableValues : Grid -> position -> (Position * int[])
    This function took a grid and a position, and returned the array of possible number values that were available for the position in question.
  • isNotSolvable : (‘a * ‘b []) list -> bool
    This was a simple test to look at a list of things, and if there were any items that came in with an empty array (as the b value).
  • isSolved : (‘a * ‘b []) list -> bool
    This simple test ensures that the incoming list, the max length of the b array is 1 value.

All together, this made the solve method easy to write.

Solve : Grid -> Map<Position, int> option.

If solve returned a None value, no solution was found. Otherwise, it would return Some solution (see what I did there.)

In that function, it defined a recursive function called ‘createSolution’, taking a grid g.

That function would first iterate through allGrid positions, and then create a list of Position * int [], mapping over the getAvailableValues function and the grid passed in.  That gave us a list of positions, and all positions potential answers. It caled the isNotSolvable method, to test if ANY of the positions couldn’t be solved (because they had no avialable options in the array.)  If so, the function returned None. Otherwise, it checked if the puzzle was solved, using the isSolved function above, and if so, it created a Grid map, and returned Some with that grid.

Finally, the meat of the function assumed that at least one of the Grid squares had more than one possible answer. It then did a simple query for the square with the smallest number of possible answers, and then simply called ‘createSolution’ recursively with one of those possible answers set for the square in question.

What ends up here is a depth first solution, but one that always returns (eventually.)

Here are some simple results I got. Fire up FSI and see what you get! Have a good puzzle everyone!

// easy (solve time 0.167 seconds)
let easy = Option.get (parseGrid "5,-,-,-,1,-,-,-,4,2,7,4,-,-,-,6,-,-,-,8,-,9,-,4,-,-,-,8,1,-,4,6,-,3,-,2,-,-,2,-,3,-,1,-,-,7,-,6,-,9,1,-,5,8,-,-,-,5,-,3,-,1,-,-,-,5,-,-,-,9,2,7,1,-,-,-,2,-,-,-,3");;
// hard (6.401 seconds) (38x easy)
let hard = Option.get (parseGrid "-,-,5,-,-,-,9,-,-,-,-,4,6,9,-,1,-,-,7,9,-,-,-,-,-,-,-,-,1,-,2,-,-,-,-,3,-,7,-,-,-,6,-,8,-,-,-,-,-,1,4,6,-,2,2,3,-,-,-,8,-,-,-,-,-,-,-,5,-,-,-,7,-,-,-,4,-,3,-,1,-");;
// extreme (20 minutes, 50.464 seconds) (7,487x easy)
let extreme = Option.get (parseGrid "8,-,-,-,-,-,-,-,-,-,-,3,6,-,-,-,-,-,-,7,-,-,9,-,2,-,-,-,5,-,-,-,7,-,-,-,-,-,-,-,4,5,7,-,-,-,-,-,1,-,-,-,3,-,-,-,1,-,-,-,-,6,8,-,-,8,5,-,-,-,1,-,-,9,-,-,-,-,4,-,-");;


“I believe that children are our future. Teach them well, and let them lead the way…” – Whitney Houston

After an evening of library time, Daddy’s Crossfit, and a Lacrosse pickup, my two girls, Zoe (the oldest) and Lydia were tired and hungry. During a quick evening meal of leftover lasagna, I popped open the laptop to work on a quick kata, when my oldest asked “Whatcha doin’?”

Zoe’s interest in my work is rare, so I happily showed her some of my F# test code. She looked around. Even asked a few questions.

So I popped open the FSI and showed her how stuff works.

Microsoft (R) F# Interactive version 10.2.3 for F# 4.5
Copyright (c) Microsoft Corporation. All Rights Reserved.

For help type #help;;

> let zoe = "awesome";;
val zoe : string = "awesome"

> zoe = "not awesome";;
val it : bool = false


She was pretty happy that Zoe != “not awesome”.

I gave her her own FSI to try out, and I happily present to you, the very first code in what I’m sure is a very long lucrative functional programming career.

Microsoft (R) F# Interactive version 10.2.3 for F# 4.5
Copyright (c) Microsoft Corporation. All Rights Reserved.

For help type #help;;

> let lydia = "annoying";;
val lydia : string = "annoying"


I guess sisters will be sisters.

Poker Hands and Discriminated Unions

Discriminated union types are pretty damned powerful, especially when modeling business domains. A business domain I enjoy immensely is Poker.  The below Fun Friday post examples modeling poker hands.

First thing, I started with the below enums to start modeling out the cards themselves.

type Suit = | Clubs = 0 | Diamonds = 1 | Hearts = 2 | Spades = 3

type Rank = | Two = 2 | Three = 3 | Four = 4 | Five = 5 
            | Six = 6 | Seven = 7 | Eight = 8 | Nine = 9 | Ten = 10
            | Jack = 11 | Queen = 12 | King = 13 | Ace = 14

type Card = { Rank : Rank; Suit: Suit }

This makes the problem space fairly easy to put together, but preferred to have a ‘deck’ of cards to deal with. Note, because I used standard enumerations for the Suit and Ranks, I was able to write a quick ‘toList’ function to grab enumeration values and stick them in a standard F# list.

let toList = [for i in System.Enum.GetValues(typedefof) 
                   do yield i] |> 
             (fun n -> downcast n : 'a )

let deck = List.allPairs toList toList |> 
  (fun (s,r) -> { Suit = s; Rank = r; })

OK. So we have a deck to deal with. Now, to deal with Poker Hands.

I chose to model the Poker Hand with a discriminated union type mainly to example a bounded set¬†scenario. The fact is, for my game here (or my ‘business scenario’), I need to treat ‘poker hands’ as singular types, but the individual types differ quite a lot. In practice, they became distinctly organized sets of ‘Rank’ objects.

type PokerHand = 
    | StraightFlush of HighestCard : Rank
    | Quads of QuadsRank : Rank * Kicker : Rank
    | FullHouse of TripsRank : Rank * PairRank : Rank
    | Flush of Card1 : Rank * Card2 : Rank * Card3 : Rank * Card4 : Rank * Card5 : Rank
    | Straight of HighestCard : Rank
    | Trips of TripsRank : Rank * Kickers : (Rank * Rank)
    | TwoPair of HighPairRank : Rank * SecondPairRank : Rank * Kicker: Rank
    | Pair of PairRank : Rank * Kickers : (Rank * Rank * Rank)
    | HighCard of Kickers : (Rank * Rank * Rank * Rank * Rank)

A lot of the reasons I chose to model out the Poker Hands individually like this was to make comparing poker hands relatively easy to reason about. I’ll assume you know how poker hands compare, but if not, click here.

Comparing two poker hands is a fairly simple operation. First, you start with the ranks of the hand types themselves, and if one hand is ‘bigger’ than the other, that’s your winner. A function-style expression works with that nicely, as we can bind directly to the value. This style expression takes an implied parameter of type PokerHand (you’ll see usage below.)

let handRank = function 
        | StraightFlush _ -> 8 | Quads _ -> 7 | FullHouse _ -> 6 
        | Flush _ -> 5 | Straight _ -> 4 | Trips _ -> 3 
        | TwoPair _ -> 2 | Pair _ -> 1  | HighCard _ -> 0

Second, if the hands are the same, you need to be able to compare the ranks of the cards, in order of relevance to the hand. It is this relevance that I decided to model in the PokerHand union type above. Still, comparing ranks was easy.

let compareRanks x y = 
        if x > y then 1
        else if y > x then -1
        else 0

So we have the baseline functions all set here. Putting it all together, we end up with the following:

let compare hand1 hand2 = 
    let handRank = function 
        | StraightFlush _ -> 8 | Quads _ -> 7 | FullHouse _ -> 6 | Flush _ -> 5 | Straight _ -> 4  
        | Trips _ -> 3 | TwoPair _ -> 2 | Pair _ -> 1  | HighCard _ -> 0  
    let compareRanks x y = 
        if x > y then 1
        else if y > x then -1
        else 0
    match hand1, hand2 with 
     | (x, y) 
        when (handRank x) - (handRank y)  0 -> Some (sign ((handRank x) - (handRank y)))
    | (Quads (c, _), Quads (c2, _))
    | (FullHouse (c, _), FullHouse (c2, _))
    | (Flush (c,_, _ ,_ ,_), Flush (c2,_, _ ,_ ,_)) | (Flush (_,c, _ ,_ ,_), Flush (_,c2, _ ,_ ,_)) 
    | (Flush (_,_,c,_,_), Flush (_,_,c2,_,_)) | (Flush (_,_, _ ,c ,_), Flush (_,_, _ ,c2,_)) 
    | (Trips (c,_), Trips (c2, _)) | (Trips (_,(c,_)), Trips(_,(c2,_)))
    | (TwoPair (c, _, _), TwoPair (c2, _ , _)) | (TwoPair (_, c, _), TwoPair (_, c2 , _)) 
    | (Pair (c, _), Pair (c2, _)) | (Pair (_, (c, _, _)), Pair (_, (c2, _, _)))  
    | (Pair (_, (_, c, _)), Pair (_, (_, c2,  _)))
    | (HighCard (c, _, _, _, _), HighCard (c2, _, _, _, _)) | (HighCard (_, c, _, _, _), HighCard (_, c2, _, _, _))
    | (HighCard (_, _, c, _, _), HighCard (_, _, c2, _, _)) | (HighCard (_, _, _, c, _), HighCard (_, _, _, c2, _))
        when compareRanks c c2  0 
            -> Some (compareRanks c c2)
    | (StraightFlush c, StraightFlush c2) 
    | (Straight c, Straight c2)
    | (Quads (_, c), Quads (_, c2))
    | (FullHouse (_, c), FullHouse (_, c2))
    | (Flush (_,_, _ ,_ ,c), Flush (_,_, _ ,_ ,c2))
    | (Trips (_,(_,c)), Trips(_,(_,c2))) 
    | (TwoPair (_, _, c), TwoPair (_, _, c2)) 
    | (Pair (_, (_, _, c)), Pair (_, (_, _, c2)))
    | (HighCard (_, _, _, _, c), HighCard (_, _, _, _, c2))
        -> Some (compareRanks c c2)
    | _ -> None

I will admit, it’s got a weighty match expression, but match expressions can be broken down by their guard clauses, so altogether, it can be reasoned about as:

match hand1, hand2 with
| when the handRanks are different, return the bigger one.
| when the card ranks are different in the relevant order for the hand type in question, return the bigger one.
| when one relevant card rank remains, return the comparison between that last card rank.
| when passed anything else, return None.

Take comparing two Two Pair hands.

TwoPair (Rank.King, Rank.Four, Rank.Eight)
TwoPair (Rank.King, Rank.Six, Rank.Seven)

The first relevant rank here compares as 0 (King vs King), but the second relevant rank is non-zero (4 vs 6) so the second hand wins.

Finally, creating PokerHand instances requires 5 distinct cards.

let getHand card1 card2 card3 card4 card5 = 
    let ranks = [card1.Rank 
                 card5.Rank] |>
                 List.groupBy id |> 
                 List.sortByDescending (fun (m,n) -> (List.length n) * 100 + (int) m);
    match List.length ranks with
    | 4 -> // pair
        let card = Pair (fst ranks.Head, (fst ranks.[1], fst ranks.[2], fst ranks.[3]))
        Some card
    | 2 -> // quads or fullhouse
        if(List.length (snd ranks.Head) = 4) then
            let card = Quads (fst ranks.Head, fst ranks.[1])
            Some card
            let card = FullHouse (fst ranks.Head, fst ranks.[1])
            Some card
    | 3 -> // trips or twopair
        if(List.length (snd ranks.Head) = 3) then
            let card = Trips (fst ranks.Head, (fst ranks.[1], fst ranks.[2]))
            Some card
            let card = TwoPair (fst ranks.Head, fst ranks.[1], fst ranks.[2])
            Some card
    | 5 -> // a flush or straight flush
        let r = [card1.Rank; card2.Rank; card3.Rank; card4.Rank; card5.Rank] 
                |> List.sortByDescending id
        let suits = [card1.Suit
                     card5.Suit] |> 
        match (List.length suits, r) with
        | (1, Rank.Ace::Rank.Five::_) -> Some (StraightFlush Rank.Five)
        | (1, x::xs) when x - (List.last xs) = Rank.Four -> Some (StraightFlush x)
        | (1, _) -> Some (Flush (r.[0], r.[1], r.[2], r.[3], r.[4]))
        | (_, Rank.Ace::Rank.Five::_) -> Some (Straight Rank.Five)
        | (_, x::xs) when x - (List.last xs) = Rank.Four -> Some (Straight x)
        | _ -> Some (HighCard (r.[0], r.[1], r.[2], r.[3], r.[4]))
    | _ -> 

This method works fairly simply. We take the ranks of the incoming cards, group the like ranks together, then sorting by the rank count (times 100) plus the rank value. (Hence, 2 Kings, and 2 sixes and a 4 will end up as 213, 206, and 4, respectively.)

Then, by matching against the number of a distinct ranks, we can create simple logic to determine the hand type. When 5 cards have 4 distinct ranks, the hand must be a pair, so we simply set the values for the PokerHand instance accordingly. When there are 2 distinct ranks, the hand must be either a FullHouse (3 of one rank, 2 of the other), or Quads (4 of one rank, 1 of the other.) Trips and TwoPair will both have 3 distinct ranks. If there are 5 distinct ranks, we need to check for a bit more. In the case of 5 distinct ranks, we need to sort them in order, and get a count of distinct suits. If there is 1 suit, then we’re dealing with a Flush or a StraightFlush. Straights are 5 cards in a row (rank order), OR Ace, Two, Three, Four, Five. If we have more than one suit, we are dealing with a HighCard hand (the most common hand), or a Straight. If we get any other number of distinct ranks, we have an invalid set of arguments, so we return the option value None.

The last function will give us a random hand to play with.

let getRandomHand() = 
    let r = System.Random();
    let rec makeHand length list = 
        let m = r.Next(0, 52)
        if (List.contains m list) then
            makeHand length list
            let newList = m::list
            if (List.length newList = length) then
                makeHand length newList
    let idx = makeHand 5 []
    getHand deck.[idx.[0]] deck.[idx.[1]] deck.[idx.[2]] deck.[idx.[3]] deck.[idx.[4]]

It’s getting late. Time to head to the card room, but I encourage you to try this out in FSI, and think about how discriminated unions could make your OWN business modeling a little easier. See ya!

Fun Friday – Diamonds are Forever

Sometimes you write code you’re just not super happy with.

The Diamond Kata is a simple kata to take a single character parameter, and return a “diamond” shaped string.¬† Examples:

diamond 'A';; 
val it : string = "A"

diamond 'B';;
val it : string = "
 A "

diamond 'C';;
val it : string = "
 B B 
C   C
 B B 
  A  "


That’s how I describe this Kata I was working on. I’m just not super happy with it. It feels wordy, and a bit inelegant. Still, it does work (as long as you pass a character ‘greater’ than upper case A. I should probably enforce that sometime… but for now, here it is.

open System
let diamond char =
let chars = [ 'A' .. char ]
let numberOfChars = List.length chars
let padCount i = numberOfChars (i + 1)
let gridWidth = numberOfChars * 2 1
let pad i = new string (' ', i)
let init = chars |> List.mapi (fun i c -> (string c), (padCount i))
let all = init @ (List.tail (List.rev init))
let makeLine (str,padCount) =
match gridWidth (padCount * 2 + 1) with
| 0 -> pad padCount + str + pad padCount
| a -> pad padCount + str + pad (a 1) + str + pad padCount
all |> makeLine
|> List.reduce (fun x y -> sprintf "%s%s%s" x Environment.NewLine y)

view raw


hosted with ❤ by GitHub

Fun Friday – Roman Numeral Kata

Roman numerals are about the most useless things on the planet nowadays, provided you aren’t rolling credits at a movie screen.

However, if the Romans DO return, we have a solution to the pesky number problem. I present you my F# implementation.

let vals = [(1000, "M");(900, "CM");(500, "D");(400, "CD");
(100, "C");(90, "XC");(50, "L");(40, "XL");
(10, "X");(9,"IX");(5,"V");(4,"IV");(1, "I")]
let toRoman iVal =
let rec loop acc n list =
match list with
| [] -> acc
| (i, s)::xs when n >= i -> loop (acc + s) (n i) list
| x::xs -> loop acc n xs
loop "" iVal vals
let fromRoman sVal =
let rec loop acc (str : string) list =
match list with
| [] -> acc
| (i, s)::xs when str.StartsWith(s) -> loop (acc + i) (str.Substring(s.Length)) list
| x::xs -> loop acc str xs
loop 0 sVal vals

I endeavor to explain for those not yet converted to the F# happy-path.

The first lines (1-3), declares a value (“vals”) as a list of tuples. Those tuples consist of a number, and it’s equivalent textual value in the Roman Numeral form. The ordering is important, as it goes from largest numerical value to smallest in the list.

Both functions defined here (toRoman and fromRoman) are very similarly designed. They start with a single parameter, and then define and internal looping function that actually creates the resulting value. Then they call that internal function with an “empty” accumulator, the initial parameter value, and the vals list declared above. If you run a simple test in FSI with these functions you should easily get some good results:

> toRoman 54;;
val it : string = "LIV"

> toRoman 2017;;
val it : string = "MMXVII"

> fromRoman "MMXVII";;
val it : int = 2017

Internal loops with an accumulator are common in functional code. Our loops use the “acc” (aka, accumulator) parameter to sum up the matching numbers in the fromRoman function, and to build the resulting string in the toRoman function. The internal loop¬† matches the incoming list, and compares it against 3 possible options. The first possible match is against an empty list. If the list passed in to the loop function is empty, it simply returns the acc value. The second match is a list with the head of the element deconstructed as a tuple (i, s), filtering when the “n” parameter (of the loop function) is larger than (or equal to) the “i” value in the tuple. In that case, we simply call the loop function again, appending the s value to the acc parameter, subtracting the i value from the n parameter, and passing the same list into the function again. Finally the third option is when it’s just a simple list object that has a head and a tail (the match order counts) and it passes the existing acc and n parameter values to the loop function with the tail of the list.

When I pass in 54 into the toRoman function, the first thing that happens in that function is:

1) The loop function is defined and then called, with “” as the acc parameter, 54 as the n parameter and the vals list [(1000, “M”)…(1, “I”)] as the list parameter.

2) The loop executes, matching against the list parameter.

3) The list is not empty, so it skips the first match.

4) The first value in the list (1000, “M”) is capable of being represented as a tuple (i, s), and the list itself matches the cons operator (“::“) as well, but the “when” setting n >= i does NOT match, because the n parameter is¬†54 and the i is 1000, so it skips the second match.

* Reread and, make sure you understand this part, as it’s the critical point of the function.

5) The final option matches, and calls loop again, this time with parameters: acc = “”; n = 54, and list¬†=¬†[(900, “CM”)…(1, “I”)]¬†

6) The steps 3-5 execute again. The head of the list is compared, until eventually the “n” parameter is larger or equal to the corresponding “i” (from step 4).
(900, “CM”) -> Nope
(500, “D”) -> Nada
(400, “CD”) -> No Dice

(50, “L”) -> That’s a match!

7) Since that match occurred, we STILL loop through the execution, but now we modify our parameters a bit. Instead of the plain old acc, now we apply a function to the acc to¬†accumulate the value; acc is no longer “”, it is now “” + “L”.¬† The variable n is modified as well. It is no longer 54, it becomes¬†4¬†(54 – 50).¬†The list value stays the same [(50,”L”)…(1, “I”)].

8) The new values are now matched, and the process continues. The list is still not empty, and the new n value (4) is clearly less than 50 (the first element in the list), so we move on through the list, in the same way we did before but against the new n value (4):
(50, “L”) -> Nope
(40, “XL”) -> Negative
(10, “X”) -> No Dice
(9, “IX”) -> Sorry
(5, “V”) -> Not quite
(4, “IV”) -> Yep!

9) The result updates acc to¬†“LIV”, and n to 0. We loop through the remaining 2 items in the list (4, “IV”) and (1, “I”) and get to the last possible match [], the empty list.¬† The last match returns the acc passed in (“LIV”). That becomes our final value, and is the result of our toRoman function.

The differences between fromRoman and toRoman are simply related to the data types involved. String “subtraction” doesn’t work with a simple minus sign (at least, not without defining a new infix operator), so instead it’s “str.Substring(s.Length).” String comparison doesn’t work with the >= operator, so str.StartsWith(s) was recruited to do the job. Everything else largely works the same, the accumulator¬†accumulates the values while the function executes and the str variable is “decremented”, until the list is exhausted.

There are some clear flaws in my implementations here, and I accept them for what they are. Firstly, in the toRoman function, negative value parameters all return an empty string. I don’t remember my mathematics history there, and I am not sure if they even actually had the concept of negative numbers back then. If you are a history buff, and know the answer, please comment and let me know. Secondly, the fromRoman function isn’t validating the incoming text. You could submit something things like “CDCDCD”, and it would return 1200, even though the input is clearly wrong. Finally, when you put in an exceptionally large number into toRoman, you can end up with a LOT of “M”s, simply because the vals list doesn’t contain enough “domain knowledge” about larger numbers.

Still, it largely works, so for a Fun Friday, I’m happy with it. Enjoy!