In the toy problem described by I Failed a Twitter Interview, we are given a list of integers
representing the heights of walls
3  2  1  4  2 
and we imagine pouring water onto this structure such that puddles accumulate in the gaps.
We are then asked: How much water is held by the structure? (In the above example, the answer is 3).
Monoids
I find myself thinking about monoids a lot lately. Such a small, unassuming thing
class Monoid a where
mappend :: a > a > a  An associative operation,
 also called (<>)
mempty :: a  Identity of (<>)
yet it stirs the imagination. If your type has a monoid, you can chain the elements of any collection together into a single element.
fold :: (Foldable t, Monoid m) => t m > m
The obvious examples may be data structures like strings, which are chained together by concatenation.
x = fold [ "one"
, "two"
, "three"
]
 x = "one" <> "two" <> "three"
 = "one" ++ "two" ++ "three"
 = "onetwothree"
But a monoid operations aren’t just ways to merge data structures. My favorite
example is Endo
, which lets you chain together collections of
functions.
newtype Endo a = Endo { appEndo :: a > a }
instance Monoid (Endo a) where
mempty = Endo id
Endo f `mappend` Endo g = Endo (f . g)
f = fold [ Endo (+ 3)
, Endo (`div` 2)
, Endo (+ 10)
]
 appEndo f 0
 = appEndo (Endo (+ 3) <> Endo (`div` 2) <> Endo (+ 10)) 0
 = ((+ 3) . (`div` 2) . (+ 10)) 0
 = 8
Monoids compose extraordinarily readily.
For example, if a
and b
have monoids, then the tuple (a, b)
does as well.
instance (Monoid a, Monoid b) => Monoid (a, b) where
mempty = (mempty, mempty)
(a1, b1) `mappend` (a2, b2) = (a1 <> a2, b1 <> b2)
The water monoid
I woke up one morning recently with the thought that we can define a monoid for these waterfilled structures. When we place two of them sidebyside, they combine like this:
A structure is represented by

What its outer shape looks like
 From the left, and
 From the right.
I call these its “faces”. Imagine the structure were as tall as you, and you were standing to the left or right of it; the face is comprised of the corners that are visible to you from that perspective.
 The amount of water it holds.
data Structure = Structure
{ sLeft :: LeftFace  1. The outer shape
, sRight :: RightFace
, sArea :: Area  2. How much water it holds
}
When filled with water, the structure is convex, so the left and right faces provide all the information we need to figure out what shape will result when we combine two structures.
instance Monoid Structure where
mempty = Structure mempty mempty mempty
mappend (Structure left right water)
(Structure left' right' water') =
Structure (left <> left')
(right <> right')
(water <> water' <> waterBetween right left')
Not only does Structure
have a monoid, but so do all of its fields; so
mempty
is defined quite simply as Structure mempty mempty mempty
. The
definition of mappend
is similarly straightforward, with the exception that we
also have to add in waterBetween right left'
to include the water that puddles
in the new gap between the two structures.
Arithmetic
Since there are no negative numbers in this problem, we’ll be using the
Natural
type, which represents nonnegative integers.
import Numeric.Natural (Natural)
The arithmetic in Haskell’s default prelude is a bit clumsy, so you want to be
precise, it can be nice to define your own. For example, Natural
has an
instance of Num
, which can get us into trouble because ()
is partial.
λ> 1  2 :: Natural
*** Exception: arithmetic underflow
For the Natural
type, I’d prefer to have the ()
function signify absolute
difference. Fortunately we can define our own subtraction class and implement
it however we want.
class Subtraction a where
() :: a > a > a
infixl 6 
instance Subtraction Natural where
a  b  a >= b = a Prelude. b
 otherwise = b Prelude. a
instance Subtraction a => Subtraction (Sum a) where
Sum a  Sum b = Sum (a  b)
Not all numbers are the same, so let’s also define some types to assign meaning to the specific sorts of quantities we’re dealing with in this problem.
We wrap the numbers in Sum
so that we can automatically derive monoid
instances that combine additively.
{# LANGUAGE GeneralizedNewtypeDeriving #}
newtype Width = Width (Sum Natural)
deriving (Eq, Monoid, Ord, Semigroup, Subtraction)
newtype Height = Height (Sum Natural)
deriving (Eq, Monoid, Ord, Semigroup, Subtraction)
newtype Area = Area (Sum Natural)
deriving (Eq, Monoid, Ord, Semigroup, Subtraction)
We’ll need to multiply a Width
by a Height
to get an Area
. Here we run
into another limitation of Num
: It assume we’re only multiplying values of the
same type.
(*) :: Num a => a > a > a
So again let’s ignore the standard math and invent our own. Since this hetereogeneous multiplication involves more than one type, we need the language extension that allows multiparameter type classes.
{# LANGUAGE MultiParamTypeClasses #}
class Multiplication a b c where
(*) :: a > b > c
infixl 7 *
instance Multiplication Width Height Area where
Width w * Height h = Area (w Prelude.* h)
instance Multiplication Height Width Area where
Height h * Width w = Area (w Prelude.* h)
Faces
Recall that we defined a structure’s shape in terms of its LeftFace
and its
RightFace
. Now we’ll define those types and their monoids.
import Data.Map (Map)
import qualified Data.Map as Map
type Corners = Map Height Width
newtype LeftFace = LeftFace Corners
newtype RightFace = RightFace Corners
instance Monoid LeftFace where
mempty = emptyFace
mappend near far = overlapFaces near far
instance Monoid RightFace where
mempty = emptyFace
mappend far near = overlapFaces near far
Notice the subtle difference between how mappend
is defined for each of these
types. When we combine two faces, it matters whether we’re looking at them from
the left or from the right.
This is what combining two left faces looks like:
The emptyFace
and overlapFaces
functions need to be polymorphic so we can
use them for both the left or right face types. To make this easy, we can take
advantage of the Coercible
instances that newtypes get
automatically, and define a Face
as anything which can be converted back and
forth to Corners
.
{# LANGUAGE ConstraintKinds, FlexibleContexts #}
import Data.Coerce (Coercible, coerce)
type Face a = (Coercible Corners a, Coercible a Corners)
Now we can generically implement the facecombining logic, using coerce
to
convert Corners
to Face
and vice versa.
emptyFace :: Face a => a
emptyFace = coerce (Map.empty :: Corners)
overlapFaces :: Face a => a > a > a
overlapFaces nearFace farFace = coerce (corners :: Corners)
where
near = coerce nearFace :: Corners
far = coerce farFace :: Corners
(nearHeight, nearWidth) = faceSize near
far' = (<> nearWidth <> Width 1) <$> snd (Map.split nearHeight far)
corners = near <> far'
faceSize :: Face a => a > (Height, Width)
faceSize face = let corners = coerce face :: Corners
in if null corners
then mempty
else Map.findMax corners
Water between two structures
The last nontrivial bit of coding is to compute the area of water between two
opposing faces. Notice that the entire thing is a fold
, and that here is where
we use the (*)
and ()
functions defined above.
waterBetween :: RightFace > LeftFace > Area
waterBetween face face' =
fold $ go (Map.toAscList (coerce face :: Corners))
(Map.toAscList (coerce face' :: Corners))
mempty
where
go :: [(Height, Width)]
> [(Height, Width)]
> Height
> [Area]
go l@((heightL, depthL) : restL)
r@((heightR, depthR) : restR)
floor =
let area = raised * width
raised = floor'  floor
width = depthL <> depthR
(floor', l', r') =
case compare heightL heightR of
LT > (heightL, restL, r )
GT > (heightR, l, restR)
EQ > (heightL, restL, restR)
in area : go l' r' floor'
go _ _ _ = []
Folding it all together
We then define the construction of a structure with a single wall…
structureSingleton :: Height > Structure
structureSingleton height = Structure face face mempty
where
face :: Face a => a
face = coerce (Map.singleton height mempty :: Corners)
And finally, chain all the walls together, using another fold!
collectWater :: [Natural] > Natural
collectWater = coerce . sArea . foldMap (structureSingleton . coerce)
Notes
You can see the complete working code on GitHub.
In this post I don’t give much thought to efficiency; I haven’t bothered to benchmark this code, and I suspect its runtime may be quadratic.
In case you are wondering Does it really take this much code to write a Haskell program? — No; what I’ve done here is overkill, just for fun and learning.
If you are interested in optimization or brevity, check out Chris Done’s work on the subject, which includes a very nice concise solution in Haskell using scans.
To simplify explanation, I avoided mentioning Semigroup
, but it
is something you should be aware of. Semigroup complicates things because in
Haskell it has some historical baggage. Ideally the two classes would look like
this:
class Semigroup a where
(<>) :: a > a > a
class Semigroup a => Monoid a where
mempty :: a
However, because semigroups were added to Haskell after monoids, Monoid
does
not have this constraint, and it has a mappend
method which is redundant to (<>)
.