Posted on February 11, 2018

``````>>> filterM (\_ -> [False, True]) [1,2,3]
[[],,,[2,3],,[1,3],[1,2],[1,2,3]]``````

`filterM (\_ -> [False,True])` gives the power set of some input list. It’s one of the especially magical demonstrations of monads. From a high-level perspective, it makes sense: for each element in the list, we want it to be present in one output, and not present in another. It’s hard to see how it actually works, though. The (old1) source for `filterM` doesn’t help hugely, either:

``````filterM          :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
filterM _ []     =  return []
filterM p (x:xs) =  do
flg <- p x
ys  <- filterM p xs
return (if flg then x:ys else ys)``````

Again, elegant and beautiful (aside from the three-space indent), but opaque. Despite not really getting how it works, I was encouraged by its simplicity to try my hand at some of the other functions from Data.List.

## Grouping

Let’s start with the subject of my last post. Here’s the implementation:

``````groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
groupBy p xs = build (\c n ->
let f x a q
| q x = (x : ys, zs)
| otherwise = ([], c (x : ys) zs)
where (ys,zs) = a (p x)
in snd (foldr f (const ([], n)) xs (const False)))``````

``````groupByM :: Applicative m => (a -> a -> m Bool) -> [a] -> m [[a]]
groupByM p xs =
fmap snd (foldr f (const (pure ([], []))) xs (const (pure (False))))
where
f x a q = liftA2 st (q x) (a (p x)) where
st b (ys,zs)
| b = (x : ys, zs)
| otherwise = ([], (x:ys):zs)``````

Let’s try it with a similar example to `filterM`:

``````>>> groupByM (\_ _ -> [False, True]) [1,2,3]
[[,,],[,[2,3]],[[1,2],],[[1,2,3]]]``````

It gives the partitions of the list!

## Sorting

So these monadic generalisations have been discovered before, several times over. There’s even a package with monadic versions of the functions in Data.List. Exploring this idea with a little more formality is the paper “All Sorts of Permutations” (Christiansen, Danilenko, and Dylus 2016), and accompanying presentation on YouTube. They show that the monadic version of sort produces permutations of the input list, and examine the output from different sorting algorithms. Here’s a couple of their implementations, altered slightly:

``````insertM :: Monad m => (a -> a -> m Bool) -> a -> [a] -> m [a]
insertM _ x [] = pure [x]
insertM p x yys@(y:ys) = do
lte <- p x y
if lte
then pure (x:yys)
else fmap (y:) (insertM p x ys)

insertSortM :: Monad m => (a -> a -> m Bool) -> [a] -> m [a]
insertSortM p = foldrM (insertM p) []

partitionM :: Applicative m => (a -> m Bool) -> [a] -> m ([a],[a])
partitionM p = foldr f (pure ([],[])) where
f x = liftA2 ifStmt (p x) where
ifStmt flg (tr,fl)
| flg = (x:tr,fl)
| otherwise = (tr,x:fl)

quickSortM :: Monad m => (a -> a -> m Bool) -> [a] -> m [a]
quickSortM p [] = pure []
quickSortM p (x:xs) = do
(gt,le) <- partitionM (p x) xs
ls <- quickSortM p le
gs <- quickSortM p gt
pure (ls ++ [x] ++ gs)

>>> insertSortM (\_ _ -> [False,True]) [1,2,3]
[[1,2,3],[1,3,2],[3,1,2],[2,1,3],[2,3,1],[3,2,1]]

>>> quickSortM (\_ _ -> [False,True]) [1,2,3]
[[3,2,1],[2,3,1],[2,1,3],[3,1,2],[1,3,2],[1,2,3]]``````

As it should be easy to see, they’re very concise and elegant, and strongly resemble the pure versions of the algorithms.

## State

So the examples above are very interesting and cool, but they don’t necessarily have a place in real Haskell code. If you wanted to find the permutations, partitions, or power set of a list you’d probably use a more standard implementation. That’s not to say that these monadic functions have no uses, though: especially when coupled with `State` they yield readable and fast implementations for certain tricky functions. `ordNub`, for instance:

``````ordNub :: Ord a => [a] -> [a]
ordNub =
flip evalState Set.empty .
filterM
(\x -> do
flg <- gets (Set.notMember x)
when flg (modify (Set.insert x))
pure flg)``````

Alternatively, using a monadic version of `maximumOn`:

``````maximumOnM :: (Applicative m, Ord b) => (a -> m b) -> [a] -> m (Maybe a)
maximumOnM p = (fmap . fmap) snd . foldl f (pure Nothing)
where
f a e = liftA2 g a (p e)
where
g Nothing q = Just (q, e)
g b@(Just (o, y)) q
| o < q = Just (q, e)
| otherwise = b``````

You can write a one-pass `mostFrequent`:

``````mostFrequent :: Ord a => [a] -> Maybe a
mostFrequent =
flip evalState Map.empty .
maximumOnM
(\x -> maybe 1 succ <\$> state (Map.insertLookupWithKey (const (+)) x 1))``````

## Decision Trees

One of the nicest things about the paper was the diagrams of decision trees provided for each sorting algorithm. I couldn’t find a library to do that for me, so I had a go at producing my own. First, we’ll need a data type to represent the tree itself:

``````data DecTree t a
= Pure a
| Choice t (DecTree t a) (DecTree t a)
deriving Functor``````

We’ll say the left branch is “true” and the right “false”. Applicative and monad instances are relatively mechanical2:

``````instance Applicative (DecTree t) where
pure = Pure
Pure f <*> xs = fmap f xs
Choice c ls rs <*> xs = Choice c (ls <*> xs) (rs <*> xs)

Pure x >>= f = f x
Choice c ls rs >>= f = Choice c (ls >>= f) (rs >>= f)``````

We can now create a comparator function that constructs one of these trees, and remembers the values it was given:

``````traceCompare :: a -> a -> DecTree (a,a) Bool
traceCompare x y = Choice (x,y) (Pure True) (Pure False)``````

Finally, to draw the tree, I’ll use a function from my binary tree library:

``````printDecTree :: (Show a, Show b) => String -> DecTree (a,a) b -> IO ()
printDecTree rel t = putStr (drawTreeWith id (go t) "") where
go (Pure xs) = Node (show xs) Leaf Leaf
go (Choice (x,y) tr fl) =
Node (show x ++ rel ++ show y) (go tr) (go fl)``````

And we get these really nice diagrams out:

``````>>> (printDecTree "<=" . insertSortM traceCompare) [1,2,3]

┌[1,2,3]
┌1<=2┤
│    │    ┌[2,1,3]
│    └1<=3┤
│         └[2,3,1]
2<=3┤
│    ┌[1,3,2]
└1<=3┤
│    ┌[3,1,2]
└1<=2┤
└[3,2,1]

>>> (printDecTree "<=" . quickSortM traceCompare) [1,2,3]

┌[1,2,3]
┌2<=3┤
│    └[1,3,2]
┌1<=3┤
│    └[3,1,2]
1<=2┤
│    ┌[2,1,3]
└1<=3┤
│    ┌[2,3,1]
└2<=3┤
└[3,2,1]``````

We can also try it out with the other monadic list functions:

``````>>> (printDecTree "=" . groupByM traceCompare) [1,2,3]

┌[[1,2,3]]
┌2=3┤
│   └[[1,2],]
1=2┤
│   ┌[,[2,3]]
└2=3┤
└[,,]``````

## Applicative

You might notice that none of these “monadic” functions actually require a monad constraint: they’re all applicative. There’s a straightforward implementation that relies only on applicative for most of these functions, with a notable exception: sort. Getting that to work with just applicative is the subject of a future post.

Christiansen, Jan, Nikita Danilenko, and Sandra Dylus. 2016. “All Sorts of Permutations (Functional Pearl).” In Proceedings of the 21st ACM SIGPLAN International Conference on Functional Programming, 168–179. ICFP 2016. New York, NY, USA: ACM. doi:10.1145/2951913.2951949. http://informatik.uni-kiel.de/~sad/icfp2016-preprint.pdf.

1. The definition has since been updated to more modern Haskell: it now uses a fold, and only requires `Applicative`.

2. Part of the reason the instances are so mechanical is that this type strongly resembles the free monad:

`data Free f a = Pure a | Free (f (Free f a))`

In fact, the example given in the `MonadFree` class is the following:

`data Pair a = Pair a a`

`type Tree = Free Pair`

The only difference with the above type and the decision tree is that the decision tree carries a tag with it.

So what’s so interesting about this relationship? Well, `Pair` is actually a representable functor. Any representable functor `f a` can be converted to (and from) a function `key -> a`, where `key` is the specific key for `f`. The key for `Pair` is `Bool`: the result of the function we passed in to the sorting functions!

In general, you can make a “decision tree” for any function of type `a -> b` like so:

`type DecTree a b r = Rep f ~ b => Free (Compose ((,) a) f) r`

But more on that in a later post.