No posts for a month and now this one's a rerun. Don't ask me why I'm fixated upon such a stupid problem, but I'm playing checkers again. It's the exact same exercise I described in a previous write-up: determine if any pieces on a checkers board are in danger of being attacked. I've already demonstrated how the array manipulation prowess of Q lend themselves well to this puzzle, but I also believe ADTs and monads simplify things further, which is why I'm taking another crack at it in Haskell. I should emphasize the Haskell part of "Haskell," because the code here is not actually Purescript like it is in my other posts—I've got a new job where I'm required to write Haskell-ass Haskell, so I should brush up on it.
{-# LANGUAGE UnicodeSyntax #-}
import Control.Arrow ((***))
import Control.Monad (foldM, join, liftM2)
import Data.Array (range)
import Data.Map (elems, fromListWith)
import Data.Maybe (isJust)
As always, I'm using Haskell as a saner J, which means liftM2
(lift2
in Purescript) is a must.
data Cell = R | B | E deriving Show
type Board = [[Cell]]
While the Q solution relied on using numerical values to represent which checkers pieces occupied which cell, I figured an explicit algebraic data type would make more sense. A Cell
can have instances of R
, B
, or E
, which represent red pieces, black pieces, or empty cells respectively. A 2D list of Cell
values is represented by a Board
type synonym. Some safe and unsafe board configurations follow.
unsafe1 ∷ Board
unsafe1 =
[[E, R, E, E],
[E, E, B, E],
[E, R, E, E],
[E, E, B, E]]
unsafe2 ∷ Board
unsafe2 =
[[E, R, E, E],
[B, E, E, E],
[E, R, E, E],
[B, E, E, E]]
safe1 ∷ Board
safe1 =
[[E, B, E, E],
[E, E, R, E],
[E, E, E, R],
[E, E, E, B]]
safe2 ∷ Board
safe2 =
[[E, B, E, E],
[R, E, R, E],
[E, E, B, E],
[B, R, B, B]]
Boards are analyzed the same way as before: segregate the diagonal runs of boards into linear arrays, and fold across them. If a black piece precedes a red piece in any of these arrays, the board is considered dangerous. It is safe otherwise. The Q code checked for red-black alignments instead of black-red because it accumulated the indices of its diagonal rows differently, but the principle is the same.
Diagonals are found in a similar manner as well.
enumerate
is the first function necessary for this process.
enumerate ∷ [a] → [Int]
enumerate = curry range 0 . pred . length
It takes a list and enumerates each of its indices.
> enumerate unsafe1
[0,1,2,3]
Enumerating a Board
and its head
gives the n×m dimensions required for the cartesian product.
cartesian ∷ Board → [(Int, Int)]
cartesian = (liftM2 . liftM2) (,) enumerate (enumerate . head)
Some interesting concepts rear their heads already here. There is no need for a dedicated cross
product function in Haskell; it is enough to lift a tuple constructor (,)
into the monadic context of []
to return a pairing of all indices. If this seems like magic, recall that the definition of liftM2
is nothing more than
f <$> x <*> y
Mapping a binary function like (,)
across one list x
would return a list of partially-applied constructors waiting for their second tuple value. Applying these functions to the second list y
yields the complete pairing.
That explains the first use of liftM2
in cartesian
. Recall that liftM2
in the context of functions is J-style monadic fork f (g x) (h x)
. So (liftM2 . liftM2)
is a forking combinator in the context of []
that performs a train of three functions against a Board
.
> cartesian unsafe1
[(0,0),(0,1),(0,2),(0,3),(1,0),(1,1),(1,2),(1,3),(2,0),(2,1),(2,2),(2,3),(3,0),(3,1),(3,2),(3,3)]
Coercing these values into a map requires more manipulation. The product must be converted into a list of the form
[(Int, [Int])]
where the first integer is the sum of coordinates, and the second integer is an index in the flattened board, lifted into a list singleton for concatenation purposes.
The second integer is provided by zipping the product against another enumerate
, resulting in a list of nested tuples.
> (zip <*> enumerate) (cartesian unsafe1)
[((0,0),0),((0,1),1),((0,2),2),((0,3),3),((1,0),4),((1,1),5),((1,2),6),((1,3),7),((2,0),8),((2,1),9),((2,2),10),((2,3),11),((3,0),12),((3,1),13),((3,2),14),((3,3),15)]
Then performing a bifunctor mapping operation with uncurry (+)
and pure
will provide the shape we seek.
> (map (uncurry (+) *** pure) . (zip <*> enumerate)) (cartesian unsafe1)
[(0,[0]),(1,[1]),(2,[2]),(3,[3]),(1,[4]),(2,[5]) …]
This operation won't work in the REPL because pure
is ambiguous, but you can see how it all comes together once written in a properly-typed function.
diagonal ∷ [(Int, Int)] → [[Int]]
diagonal = elems . fromListWith (++) . map withRowNum . withIndices
where
withIndices = zip <*> enumerate
withRowNum = uncurry (+) *** pure
fromListWith (++)
converts the list to Map Int [Int]
, and then elems
will return a 2D list representing diagonally-segregated indices.
> (diagonal . cartesian) unsafe1
[[0],[4,1],[8,5,2],[12,9,6,3],[13,10,7],[14,11],[15]]
You can see how this mirrors the Q example, though the indices are compiled in reverse. This is why the Haskell program checks for black-red adjacent cells rather than the other way around.
The project
functions takes a list of cells and a list of desired indices, and returns only the cells that match.
project ∷ [Cell] → [Int] → [Cell]
project = map . (!!)
> project [E, R, B, E] [1, 1, 1, 2]
[R,R,R,B]
Curried with a flattened board as its first argument, mapping project
across each sublist of the diagonally-segregated indices provides a diagonal projection of the original board.
split ∷ Board → Board
split = liftM2 (map . project) join (diagonal . cartesian)
> split unsafe1
[[E],[E,R],[E,E,E],[E,R,B,E],[E,E,E],[B,E],[E]]
Of course this projection is hardly unsafe, seeing as how there are no black-red pairs to be found. The program must check the diagonals in both directions, which involves reversing a board on its x-axis.
bothDirections ∷ Board → Board
bothDirections = liftM2 (++) split (split . map reverse)
> bothDirections unsafe1
[[E],[E,R],[E,E,E],[E,R,B,E],[E,E,E],[B,E],[E],[E],[E,E],[E,B,R],[E,E,E,E],[B,R,E],[E,E],[E]]
There's a B,R
in there somewhere.
Haskell's true beauty reveals itself at this stage of the program. The strongly typed Cell
means we don't have to do weird arithmetic, and the existence of monads allows us to short-circuit the evaluation of any unsafe board, rather than mapping over the whole thing as we would in Q.
neighborCheck ∷ Cell → Cell → Maybe Cell
neighborCheck B R = Nothing
neighborCheck _ ω = Just ω
This checking procedure is folded over each diagonal row. As stated earlier, if a black piece is found in front of a red piece, the board is unsafe. Returning Nothing
signals this. Otherwise, the second cell's contents are provided as the new accumulator wrapped in a Just
. Folding a function (b → a → f b)
with foldM
can signal failure early on, unlike a generic fold.
> foldM neighborCheck E [E,R,B,E,E,R]
Just R
> foldM neighborCheck E [E,B,R,E,E,R]
Nothing
traverse
maps a function across a structure within an applicative context. That is to say, much like how
(+) <$> Nothing <*> (Just 1)
will terminate when it encounters Nothing
, a traversal will also cease mapping if it encounters a failure case. It is therefore enough to check an entire board with
traverse (foldM neighborCheck E)
which performs a foldM
of neighborCheck
across each diagonal row sublist, but short-circuits to Nothing
the moment an unsafe configuration is detected.
A board is safe when a Just
is returned.
safe ∷ Board → Bool
safe = isJust . traverse (foldM neighborCheck E) . bothDirections
> safe <$> [unsafe1, unsafe2, safe1, safe2]
[False,False,True,True]
It's not as terse as Q, but I think I prefer this implementation, and Haskell in general.