Today we’re writing a bingo simulator. We’re given a (large!) collection of boards and a stream of numbers and asked to find some information about the (first) winning board.
As usual, let’s ignore parsing completely.
Boards are our fundamental type of interest, but we’ll ignore the question of what they “are” and focus on the operations we expect them to support:
mark : Board → ℕ → Board
marked : Board → ℕ → Bool
won : Board → Bool
mark b k takes the board b to a board in which k is marked; if k is not present in b, a board identical to b is returned. We require of mark that:
mark (mark b k) l = mark (mark b l) k
full b ⇒ mark b k = b
for all k, l ∈ ℕ; full b is true iff every element of b is marked.
marked b k is true iff k both occurs and is marked in b.
occurs b k ⇒ is_marked (mark b k) k
¬ (occurs b k) ⇒ ¬ (is_marked b k)
won b determines whether b is a winning board—that is, whether it contains a marked row or column.
This is all we need to describe the game:
bingo : [Board] → [ℕ] → ℕ
bingo bs (n ∷ ns) = let bs′ = marks n bs in
case winner bs′ of
Nothing → bingo bs′ ns
Just b → score b n
marks : ℕ → [Board] → [Board]
marks k = list (λ b → mark b k)
winner : [Board] → Maybe Board
winner = find won
score : Board -> Int -> Int
bingo bs ns runs through the drawn numbers, represented by the list ns, marking each in bs to create the next game state. It terminates when there is a winning board among the bs (we will assume that this winner is unique) and computes the score of the winning board. (The recursion in bingo is slightly funky, since a board’s score depends on the last number called.) The helper functions marks and winner mark a given number in a list of boards and find a winning board in a list, respectively. winner makes use of the find function, which gives Just the first element of a list satisfying a predicate, or Nothing if no such element exists.
We leave the scoring function for last and go on to talking about Boards in more detail. We consider them in terms of a parametric type T:
Board = T (ℕ × Bool)
We expect that T is a functor and also foldable, in the sense of the Haskell typeclass. mark is then easy:
mark b k = board (mark1 k) b
mark1 : ℕ → (ℕ × Bool) → (ℕ × Bool)
mark1 k (x, mk) = if k == x then (x, True) else (x, mk)
marked is also easy, using the function any : Foldable τ ⇒ (α → Bool) → τ α → Bool which returns whether some element of a parametric foldable type satisfies a predicate:
marked b k = any (λ (x, mk) → k == x ∧ mk) b
Of course, the predicate won involves the most work. In this case, we need to attach a notion of 2-D geometric structure to boards. We want an additional constraint on the Board type:
S ⊆ (ℕ × ℕ) ⇒ Board ≅ S → (ℕ × Bool)
That is, a board is isomorphic to a function from pairs of naturals in a certain range to possibly-marked naturals. (I’m sure there’s a lighter-weight constraint.) This means that we can easily check if a given “cell” is marked; we specify:
cell_marked : Board → S → Bool
cell_marked b = π₂ ∘ (to b)
where to : Board → (S → (ℕ × Bool)) is a witness of the Board/map isomorphism. We can extract the rows or columns of a Board with bound (k, k):
rows : Board → [[(ℕ × Bool)]]
rows b = [[ (to b) (i, j) | j ← [0..k]] | i ← [0..k]]
cols : Board → [[(ℕ × Bool)]]
cols b = [[ (to b) (i, j) | i ← [0..k]] | j ← [0..k]]]
We have a winning board if a row or a column is entirely marked:
rcmarked : [(ℕ × Bool)] → Bool
rcmarked = all π₂
won : Board → Bool
won b = any rcmarked (rows b) ∨ any rcmarked (cols b)
any is a library function analogous to all that determines whether any of the elements of a collection satisfy a predicate. any is a fold, so we could rewrite rows and cols as unfolds and apply hylomorphism fusion, but this seems good enough for now.
Now it’s just a matter of scoring the winning board. According to the puzzle description, we score a board by summing all of its unmarked elements, then multiplying their sum by the last number called. Specify:
score b n = n * sum (unmarked b)
unmarked : Board → [ℕ]
unmarked = foldr cons_um []
cons_um : (ℕ, Bool) → [ℕ] → [ℕ]
cons_um (_, True) ns = ns
cons_um (n, False) ns = n ∷ ns
Any easy application of fold fusion gives us:
score b n = n * sum_um b
sum_um : Board → ℕ
sum_um = foldr add_um 0
add_um (_, True) n = n
add_um (x, False) n = x + n
Haskellized short test puzzle input
(TODO)
We’re still playing bingo, but now we want to find the last board in our set that will win with the given numbers drawn. We can’t assume that every board will eventually win, so we will run the game to its conclusion (all boards filled, or no more numbers), then return the score of the most-recently-filled board.