Active patterns

Yacht
Yacht in F#
module Yacht

type Category =
    | Ones
    | Twos
    | Threes
    | Fours
    | Fives
    | Sixes
    | FullHouse
    | FourOfAKind
    | LittleStraight
    | BigStraight
    | Choice
    | Yacht

type Die =
    | One
    | Two
    | Three
    | Four
    | Five
    | Six

let private dieScore (die: Die): int =
    match die with
    | One   -> 1
    | Two   -> 2
    | Three -> 3
    | Four  -> 4
    | Five  -> 5
    | Six   -> 6

let private (|SingleThrow|) (target: Die) (dice: Die list): int =
    dice
    |> List.filter (fun die -> die = target)
    |> List.length

let private (|FullHouseThrow|_|) (dice: Die list): unit option =
    match List.countBy id dice |> List.sortBy snd with
    | [(_, 2); (_, 3)] -> Some ()
    | _ -> None

let private (|FourOfAKindThrow|_|) (dice: Die list): Die option =
    match List.countBy id dice |> List.sortBy snd with
    | [(number, 5)] | [_; (number, 4)] -> Some number
    | _ -> None

let private (|LittleStraightThrow|_|) (dice: Die list): unit option =
    match List.sort dice with
    | [Die.One; Die.Two; Die.Three; Die.Four; Die.Five] -> Some ()
    | _ -> None

let private (|BigStraightThrow|_|) (dice: Die list): unit option =
    match List.sort dice with
    | [Die.Two; Die.Three; Die.Four; Die.Five; Die.Six] -> Some ()
    | _ -> None

let private (|YachtThrow|_|) (dice: Die list): unit option =
    match List.distinct dice with
    | [_] -> Some ()
    | _ -> None

let score (category: Category) (dice: Die list): int =
    match category, dice with
    | Ones,           SingleThrow Die.One count   -> count * 1
    | Twos,           SingleThrow Die.Two count   -> count * 2
    | Threes,         SingleThrow Die.Three count -> count * 3
    | Fours,          SingleThrow Die.Four count  -> count * 4
    | Fives,          SingleThrow Die.Five count  -> count * 5
    | Sixes,          SingleThrow Die.Six count   -> count * 6
    | FullHouse,      FullHouseThrow              -> List.sumBy dieScore dice
    | FourOfAKind,    FourOfAKindThrow die        -> dieScore die * 4
    | LittleStraight, LittleStraightThrow         -> 30
    | BigStraight,    BigStraightThrow            -> 30
    | Yacht,          YachtThrow                  -> 50
    | Choice,         _                           -> List.sumBy dieScore dice
    | _,              _                           -> 0

This approach combines a number of functions from the List module with some pattern matching to score the dice.

Scoring dice

A Die is defined by a discriminated union. We need some way to convert its individual values to scores (e.g. Three should equal 3). One way to do this is by converting the discriminated union to an enum type:

type Die =
    | One   = 1
    | Two   = 2
    | Three = 3
    | Four  = 4
    | Five  = 5
    | Six   = 6

While this may look appealing, it is actually not recommend. As explained in this discriminated union vs enum types article, it is possible to construct an enum value that doesn't match any of the predefined values. For that reason, we'll stick with the discriminated union.

We'll support converting dice to scores via a function that uses some basic pattern matching:

let private dieScore (die: Die): int =
    match die with
    | One   -> 1
    | Two   -> 2
    | Three -> 3
    | Four  -> 4
    | Five  -> 5
    | Six   -> 6
Note

Another option would have been to add a member to the discriminated union:

type Die =
    | One
    | Two
    | Three
    | Four
    | Five
    | Six

    member this.Score: int =
        match this with
        | One -> 1
        | Two -> 2
        | Three -> 3
        | Four -> 4
        | Five -> 5
        | Six -> 6

We've chosen not to do this, as members are more awkward to use in higher-order functions, which we rely on a lot in this approach.

Active patterns

Active patterns are used in pattern matching and can be used to categorize input and/or extract data from input.

There are two types of active patterns:

  • Regular active patterns: these patterns will match any input
  • Partial active patterns: these pattern will match some inputs, but not all

Scoring categories

In this approach, we'll define active patterns for the different categories. The idea is that if we're try to match category named A, then we have a corresponding active pattern named AThrow that will check if the dice match the category.

We'll use a combination of regular and partial active patterns.

Note that the active patterns do not calculate scores, they're just there to help match input data. This better separates responsiblities and opens up the active patterns for usage elsewhere.

These functions will then later on be called in the score function, like this:

let score (category: Category) (dice: Die list): int =
    match category, dice with
    | Yacht, YachtThrow -> 50

You can see that we're using regular pattern matching on the category parameter, which is a discriminated union. However, we're also pattern matching on the dice using a custom YachtThrow (active) pattern. Let's start defining these active patterns!

Single score

To score a single die, we need to:

  1. Find the number of dice that match the target die
  2. Multiply the number of matching dice with the die value

With the above steps, the output is also correct when the target die could not be found (zero times any dice value is zero). Therefore, our active pattern can be a regular, non-partial active pattern as it will always match the input.

Score ones

Let's start by scoring the six die (Die.Six). Our active pattern will take the thing we're matching on (the dice) as its sole parameter. It wil return an int representing the number of six dice found, as the score function will require that information to calculate the score:

let private (|SixesThrow|) (dice: Die list): int =
    dice
    |> List.filter (fun die -> die = Die.Six)
    |> List.length
Note

Active patterns functions have their name specified between (| and |). This name will be used it in pattern matching, so choose the name accordingly.

The implementation is fairly straightforward. We first filter the dice matching the six dice by using List.filter. Then, we count those dice via List.length, which is subsequently returned.

A different way to read this is: to use the SixesThrow active pattern, one has to pass it a list of dice and you'll get back their count.

We can now use this pattern in our score function:

match category, dice with
| Sixes, SixesThrow count -> count * 6

This is saying: if the category is Sixes and the dice match the SixesThrow pattern (which they will always do), multiply the count (as returned by the SixesThrow pattern) by six to determine score.

We could continue defining similar patterns for the other five dice, but we can do something much nicer: parameterizing our active pattern.

Converting to a parameterized active pattern

Active patterns, like regular functions, can have parameters besides the value that is being matched on. The only constraint is that the value to match on must be the last parameter.

To make our SixesThrow active pattern more generic, let's rename it to SingleThrow (as in: single dice throw) and add a parameter which is the target die:

let private (|SingleThrow|) (target: Die) (dice: Die list): int =
    dice
    |> List.filter (fun die -> die = target)
    |> List.length

The only thing we then need to change is to replace Die.Six with our target parameter in the List.filter call's lambda.

We can do use this pattern to score the six single dice categories:

match category, dice with
| Ones,    SingleThrow Die.One count   -> count * 1
| Twos,    SingleThrow Die.Two count   -> count * 2
| Threes,  SingleThrow Die.Three count -> count * 3
| Fours,   SingleThrow Die.Four count  -> count * 4
| Fives,   SingleThrow Die.Five count  -> count * 5
| Sixes,   SingleThrow Die.Six count   -> count * 6

Full house score

A four of a kind score contains one dice at least four times. We can use List.countBy to return a list of pairs where the first value is the unique value and the second value is the number times it occurred in the list.

Then we pattern match the result of the List.countBy call with the two possible full house patterns:

  1. The dice contain two numbers, and the first number occurs twice and the second number thrice times: [(_, 2); (_, 3)]
  2. The dice contain two numbers, and the first number occurs thrice and the second number twice times: [(_, 3); (_, 2)]

As a full house is the sum of its dice, we don't have to return any value from our active pattern so we'll just return unit (which is F#'s way of representing the absence of a value).

let private (|FullHouseThrow|_|) (dice: Die list): unit option =
    match List.countBy id dice with
    | [(_, 2); (_, 3)] | [(_, 3); (_, 2)] -> Some ()
    | _ -> None
Note

We have to define the FullHouseThrow active pattern as a partial active pattern (indicated by the |_| suffix), as not all dice are a full house.

Simplifying

We can simplify things a bit by sorting the results, ordering by the second value (the count) using List.sortBy and snd (which selects the second value). This allows us to merge the second and third pattern:

let private (|FullHouseThrow|_|) (dice: Die list): unit option =
    match List.countBy id dice |> List.sortBy snd with
    | [(_, 2); (_, 3)] -> Some ()
    | _ -> None
Scoring

Let's use this pattern in our score function, where the score is just summing the dice scores via List.sumBy and our dieScore function:

match category, dice with
| FullHouse, FullHouseThrow -> List.sumBy dieScore dice

Four of a kind score

A four of a kind score contains one dice at least four times. We'll use the same strategy we just used for a full house, but this time looking for the following count patterns:

  1. The dice contain just one number and it occurs five times: [(number, 5)]
  2. The dice contain two numbers, and the first number occurs four times: [(number, 4); _]
  3. The dice contain two numbers, and the second number occurs four times: [_; (number, 4)

We can use the same List.countBy and pattern matching strategy

let private (|FourOfAKindThrow|_|) (dice: Die list): Die option =
    match List.countBy id dice with
    | [(number, 5)] | [(number, 4); _] | [_; (number, 4)] -> Some number
    | _ -> None

As scoring a four of a kind throw requires multipying the die occuring four times, we'll return that die from our function.

Simplifying

Once again, we can simplify things a bit by sorting the results, ordering by the second value (the count) using List.sortBy and snd (which selects the second value). This allows us to merge the second and third pattern:

let private (|FourOfAKindThrow|_|) (dice: Die list): Die option =
    match List.countBy id dice |> List.sortBy snd with
    | [(number, 5)] | [_; (number, 4)] -> Some number
    | _ -> None
Scoring

For the scoring of a four of kind throw, we'll capture the die in our active pattern, converting it to an int via dieScore and then multiply by four:

match category, dice with
| FourOfAKind, FourOfAKindThrow die -> dieScore die * 4

Little straight score

A little straight contains the dice with face values 1, 2, 3, 4 and 5. This can be directly translated into pattern matching:

let private (|LittleStraightThrow|_|) (dice: Die list): unit option =
    match List.sort dice with
    | [Die.One; Die.Two; Die.Three; Die.Four; Die.Five] -> Some ()
    | _ -> None

Note that we do need to call List.sort first, as the dice aren't necessarily in order and pattern matching is sensitive to the ordering.

The pattern is defined as a partial active pattern (not all throws are little straights) and returns unit, as a little straight's score is always the same.

Scoring

Scoring little straights is very straightforward (pun intended):

match category, dice with
| LittleStraight, LittleStraightThrow -> 30

Big straight score

A big straight contains the dice with face values 2, 3, 4, 5 and 6. This can be directly translated into pattern matching:

let private (|BigStraightThrow|_|) (dice: Die list): unit option =
    match List.sort dice with
    | [Die.Two; Die.Three; Die.Four; Die.Five; Die.Six] -> Some ()
    | _ -> None

Once again, we need List.sort to fix the ordering.

Like the little straight pattern, we're using a partial active pattern (not all throws are big straights) and return unit, as a big straight's score is always the same.

Scoring

We can score big straights as follows:

match category, dice with
| BigStraight, BigStraightThrow -> 30

Yacht score

For the yacht category, we need to determine if all dice have the same face. We can check this by using List.distinct to first remove any duplicates, and then use pattern matching to check if there is only one unique die:

let private (|YachtThrow|_|) (dice: Die list): unit option =
    match List.distinct dice with
    | [_] -> Some ()
    | _ -> None
Note

Alternatively, we could have counted the number of unique dice and checked if that was equal to one in an if expression:

let private (|YachtThrow|_|) (dice: Die list): unit option =
    if List.distinct dice |> List.length = 1 then Some () else None
Scoring

We can score yachts as follows:

match category, dice with
| Yacht, YachtThrow -> 50

Choice score

Scoring the choice category is simple: we just need to sum all the dice. We therefore don't need to define an active pattern and can just add the following to the score function's pattern matching:

| Choice, _ -> List.sumBy dieScore dice
Note

We're matching the dice using the wildcard pattern (_), which will match any input.

Handling non-matching dice

So far, we've secretly ignored something quite important: what to do if the dice don't match a category's active pattern!

The solution for this is simple though. As dice that don't match the pattern should be scored as zero, we can just add two wildcards at the end of our score function and return zero:

| _, _ -> 0

Putting it all together

Now that we support all categories and handle non-matching dice, let's see what the score function looks like:

let score (category: Category) (dice: Die list): int =
    match category, dice with
    | Ones,           SingleThrow Die.One count   -> count * 1
    | Twos,           SingleThrow Die.Two count   -> count * 2
    | Threes,         SingleThrow Die.Three count -> count * 3
    | Fours,          SingleThrow Die.Four count  -> count * 4
    | Fives,          SingleThrow Die.Five count  -> count * 5
    | Sixes,          SingleThrow Die.Six count   -> count * 6
    | FullHouse,      FullHouseThrow              -> List.sumBy dieScore dice
    | FourOfAKind,    FourOfAKindThrow die        -> dieScore die * 4
    | LittleStraight, LittleStraightThrow         -> 30
    | BigStraight,    BigStraightThrow            -> 30
    | Yacht,          YachtThrow                  -> 50
    | Choice,         _                           -> List.sumBy dieScore dice
    | _,              _                           -> 0

Quite nice!

18th Dec 2024 · Found it useful?