Monadic List Functions

Posted on February 11, 2018
Tags: ,

Here’s an old Haskell chestnut:

>>> filterM (\_ -> [False, True]) [1,2,3]
[[],[3],[2],[2,3],[1],[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)))

It translates over pretty readily:

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]
[[[1],[2],[3]],[[1],[2,3]],[[1,2],[3]],[[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)
  
instance Monad (DecTree t) where
  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],[3]]
1=2┤
   │   ┌[[1],[2,3]]
   └2=3┤
       └[[1],[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.

References

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.↩︎