> {-# LANGUAGE Rank2Types #-}
>
> import Control.Monad

Monads for non-determinism
--------------------------
A monad for non-determinism is an instance of the type class
`MonadPlus`, i.e., a type constructor `m` that supports the following
operations.
~~~ { .Haskell }
return :: a -> m a
(>>=) :: m a -> (a -> m b) -> m b
mzero :: m a
mplus :: m a -> m a -> m a
~~~
* `return x` represents a non-deterministic computation with a
single result `x`,
* `>>=` is pronounced *bind* and applies a non-deterministic
function to every result of a non-deterministic computation,
flattening the final results,
* `mzero` represents a non-deterministic computation without
results, and
* `mplus` merges the results of two non-deterministic computations.
Lists are probably the simplest means to represent non-deterministic
computations in Haskell. And indeed, the type constructor `[]` is an
instance of `MonadPlus`.
~~~ { .Haskell }
instance Monad []
where
return x = [x]
xs >>= f = [ y | x <- xs, y <- f x ]
instance MonadPlus []
where
mzero = []
mplus = (++)
~~~
Here, `>>=` is implemented using a list comprehension and `mplus` is a
renaming for the append function defined as follows.
~~~ { .Haskell }
(++) :: [a] -> [a] -> [a]
[] ++ ys = ys
(x:xs) ++ ys = x : (xs++ys)
~~~
The function `++` traverses the first argument and, thus, runs in
linear time w.r.t. the length of this argument.
Now that we know how to *define* `[]` as a monad for non-determinism,
let's *use* it. Here is a non-deterministic operation that yields
every positive number up to the given upper limit.
> upto :: MonadPlus m => Int -> m Int
> upto 1 = return 1
> upto n = upto (n-1) `mplus` return n
If we ask for the result of `upto 7`, e.g., in GHCi, we get the list
`[1..7]`.
~~~
*Main> upto 7 :: [Int]
[1,2,3,4,5,6,7]
~~~
We have to explicitly assign a type signature in order to tell GHCi
that we want to use the list monad.
Well, it seems to work fine! But wait. If we try with greater numbers,
this function has unfortunate run time.
~~~
*Main> :set +s
*Main> length (upto 10000)
10000
(1.87 secs, 1404242756 bytes)
*Main> length [1..10000]
10000
(0.01 secs, 2118816 bytes)
~~~
What's going on here? Remember that the run-time of `++` is linear in
the length of the first argument! Unfortunately, the function `upto`
calls itself recursively as first argument of `mplus`, i.e., `++`,
which results in quadratic run time.
Of course, we could redefine `upto` and avoid left recursion
w.r.t. `mplus`. But let's refrain from doing so and better define a
different monad that doesn't care!
Functional lists
----------------
The standard solution to avoid this performance penalty is a so called
*functional list*.
> newtype FunList a = FunList { appendList :: [a] -> [a] }
A functional list is a function that takes a list and yields another
list. The idea is that a functional lists *appends* the list given as
argument to itself to yield the resulting list. Here, `appendList` is
defined as a record selector for the record type `FunList`.
~~~ { .Haskell }
appendList :: FunList a -> [a] -> [a]
~~~
Let's define operations to construct functional lists. The empty
functional list has no own elements, hence, the list given as argument
is returned unchanged to append it.
> empty :: FunList a
> empty = FunList id
A singleton list can be constructed by appending a single element to
the front of the given list.
> singleton :: a -> FunList a
> singleton x = FunList (x:)
Finally, we can append two functional lists using function
composition.
> append :: FunList a -> FunList a -> FunList a
> append a b = FunList (appendList a . appendList b)
The `append` function runs in constant time and we can transform a
functional list into an ordinary list in linear time.
> toList :: FunList a -> [a]
> toList l = appendList l []
We can construct a simple functional list and convert it into an
arbitrary list easily:
~~~
*Main> toList (singleton 08 `append` singleton 15)
[8,15]
~~~
Good news is that `append` runs in constant time so we can hope for
running the non-deterministic function `upto` in linear time using
functional lists. Let's make `FunList` a monad!
You may have noticed already that `singleton`, `empty`, and `append`
correspond exactly to `return`, `mzero`, and `mplus` respectively. So
all we need to do is define `>>=` for the `FunList` type:
~~~ { .Haskell }
(>>=) :: FunList a -> (a -> FunList b) -> FunList b
~~~
Let's try. We somehow need to map the given function over the elements
of the list and concatenate the results.
~~~
l >>= f = FunList (??? . map f . appendList l)
~~~
But, regardless what we write instead of `???`, this definition does
not typecheck because the resulting functional list takes an argument
of type `[b]` but `appendList l` expects an argument of type
`[a]`. Seems like we're stuck[^FunList-monad].
[^FunList-monad]: We can declare an instance of `Monad` for the type
constructr `FunList` directly by converting functional lists to
ordinary lists and back again:
~~~ { .Haskell }
instance Monad FunList
where
return = singleton
l >>= f = FunList ([ y | x <- toList l, y <- toList (f x) ]++)
~~~
If only we could implement a monad for non-determinism without having
to implement bind! Well, we can. Here's how.
Continuations
-------------
Before we'll see how to implement a non-determinism monad based on
functional lists, we need a little background in *continuation-passing
style*.
A function in continuation-passing style (CPS) does not return its
result but passes it on to a function given as additional argument. We
can capture this idea in the following type.
> newtype CPS a = CPS { (->>) :: forall b . (a -> b) -> b }
This time we use an infix record selector `->>` which has a
higher-rank type, i.e., it is polymorphic in the result type `b`.
~~~ { .Haskell }
(->>) :: CPS a -> (a -> b) -> b
~~~
We can use `->>` to pass a continuation of type `a -> b` to a
computation in CPS and get the result of applying the continuation to
the result of the computation.
Here is an example. We can define addition on integers in CPS as
follows:
> add :: Int -> Int -> CPS Int
> add m n = CPS (\c -> c (m+n))
Now, we can use `->>` to process the result, e.g., to print it.
~~~
*Main> add 08 15 ->> print
23
~~~
That looks like a funny way to write `print (8+15)` but what is it
good for?
Let's be a bit more restrictive and assume that continuations return
their results as computations expressed using a specific type
constructor `t`[^ContT].
[^ContT]: The type constructor `CpsMonad` is similar to the
[continuation monad transformer][ContT] and identical to the
[codensity monad transformer][Codensity].
[ContT]: http://haskell.org/ghc/docs/latest/html/libraries/mtl/Control-Monad-Cont.html#t%3AContT
[Codensity]: http://comonad.com/haskell/category-extras/dist/doc/html/category-extras/Control-Monad-Codensity.html
> newtype CpsMonad t a = CpsMonad { (>>-) :: forall b . (a -> t b) -> t b }
Now the type of the record selector looks almost like monadic bind!
~~~ { .Haskell }
(>>-) :: CpsMonad t a -> (a -> t b) -> t b
~~~
Only the occurrences of `t b` would need to be replaced with `CpsMonad
t b`. We can indeed make `CpsMonad t` an instance of `Monad` for *any*
type onstructor `t` (that's why it is called `CpsMonad`).
> instance Monad (CpsMonad t)
> where
> return x = CpsMonad (\c -> c x)
> a >>= f = CpsMonad (\c -> a >>- \x -> f x >>- c)
We could also make `CPS` a monad. The reason why we introduce the
additional type constructor `t` is that we want to *inherit* it's
functionality, viz., non-determinism.
Constructing a search monad from modular parts
----------------------------------------------
Now we can apply the type constructor `CpsMonad` to the type
constructor `FunList` and obtain a monad based on functional lists!
> fourty2 :: CpsMonad FunList Int
> fourty2 = return 42
We got implementations for `return` and `>>=` on functional lists for
free. Well they are not quite on functional lists, i.e., for
`FunList`. The implementations we get for free are for `CpsMonad
FunList`.
We have to pass a continuation of type `Int -> FunList Int` to the
computation `fourty2` in order to observe its results. The function
`singleton` on functional list fills this gap.
~~~
*Main> toList (fourty2 >>- singleton)
[42]
~~~
More generally, we can use a type class `Result`[^Result] to specify a
requirement on types `t` that allow to convert a value of type
`CpsMonad t a` into one of type `t a`.
> class Result t
> where
> result :: a -> t a
[^Result]: The type class `Result` is called `Pointed` in the
[category-extras package][cat-ext].
[cat-ext]: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/category-extras
We can use this type class to define a generic converter to get rid of
the `CpsMonad` type constructor.
> runCpsMonad :: Result t => CpsMonad t a -> t a
> runCpsMonad a = a >>- result
For functional lists the `result` function is just `singleton`.
> instance Result FunList
> where
> result = singleton
Now we may rephrase the call above using `runCpsMonad`.
~~~
*Main> toList (runCpsMonad fourty2)
[42]
~~~
Computing singleton lists is boring. Our original goal was to define a
*non-determinism* monad based on functional lists. Non-determinism is
captured by the type class `MonadPlus` but as this is a subclass of
`Monad` and we don't have a `Monad` instance for `FunList` we make our
own type class[^Alternative]. The whole point of this exercise is to
*get* a `Monad` instance for free so it doesn't make sense to
*require* one beforehand.
[^Alternative]: The type class `Nondet` is not only similar to
`MonadPlus` but also to `Control.Applicative.Alternative`. However, it
does not require an `Applicative` instance.
> class Nondet t
> where
> failure :: t a
> choice :: t a -> t a -> t a
>
> instance Nondet FunList
> where
> failure = empty
> choice = append
Now a `CpsMonad` can *inherit* non-determinism from the base type: we
can define an instance of `MonadPlus` for `CpsMonad t` if `t` is an
instance of `Nondet`.
> instance Nondet t => MonadPlus (CpsMonad t)
> where
> mzero = CpsMonad (\_ -> failure)
> mplus a b = CpsMonad (\c -> choice (a >>- c) (b >>- c))
We have now put together all the pieces we need for a non-determinism
monad based on functional lists. We can compute the results of the
function `upto` (that computes all positive numbers up to a given
limit) in linear time.
~~~
*Main> toList (runCpsMonad (upto 7))
[1,2,3,4,5,6,7]
*Main> length (toList (runCpsMonad (upto 10000)))
10000
(0.06 secs, 5176912 bytes)
*Main> length (toList (runCpsMonad (upto 100000)))
100000
(0.66 secs, 43019912 bytes)
~~~
So let's step back for a moment. What have we implemented here? If we
inline the newtypes then the type `CpsMonad FunList` is identical to
the following type.
> newtype DFS a = DFS { unDFS :: forall b . (a -> [b] -> [b]) -> [b] -> [b] }
You may recognize this as the type for two-continuation-based
search. The continuation of type `a -> [b] -> [b]` is usually called
*success continuation* and the subsequent `[b]` is called *failure
continuation*. We can also inline the monad instances and the run
function.
> instance Monad DFS
> where
> return x = DFS (\c -> c x)
> a >>= f = DFS (\c -> unDFS a (\x -> unDFS (f x) c))
>
> instance MonadPlus DFS
> where
> mzero = DFS (\_ -> id)
> mplus a b = DFS (\c -> unDFS a c . unDFS b c)
>
> runDFS :: DFS a -> [a]
> runDFS a = unDFS a (:) []
We have factored continuation-based depth-first search into modular
parts! Let's reuse the `CpsMonad` part to define continuation-based
*breadth*-first search.
Breadth-first search
--------------------
With breadth-first search, the results of a non-deterministic
computation are enumerated in level order of the corresponding tree
representation of the search space. Choices are the inner nodes of
this tree, failures and results are the leafs.
We represent the result of breadth-first search as a list of levels
where levels are represented as functional lists to allow efficient
concatenation.
> newtype Levels a = Levels { levels :: [FunList a] }
Breadth-first search simply concatenates those levels.
> bfs :: Levels a -> [a]
> bfs = toList . foldr append empty . levels
We can apply `CpsMonad` to `Levels` in order to get a monad that
computes levels. We only need to define an instance for `Result` to
convert monadic computations to levels and an instance for `Nondet`
such that the resulting monad is an instance of `MonadPlus`.
The function `result` constructs a single level with a single entry.
> instance Result Levels
> where
> result x = Levels [singleton x]
Failure is represented as an empty list of levels and a choice creates
a new empty level in front of the concatenated levels of the
arguments.
> instance Nondet Levels
> where
> failure = Levels []
> choice a b = Levels (empty : merge (levels a) (levels b))
The function `merge` is like `zipWith append` but does not drop
excessive elements of a longer argument.
> merge :: [FunList a] -> [FunList a] -> [FunList a]
> merge [] ys = ys
> merge xs [] = xs
> merge (x:xs) (y:ys) = append x y : merge xs ys
That's all. Now we can use breadth-first search to enumerate
non-positive numbers.
~~~
*Main> take 10 (bfs (runCpsMonad (upto 0)))
[0,-1,-2,-3,-4,-5,-6,-7,-8,-9]
~~~
Despite our original intention, the function `upto` can also be used
to compute infinitely many results when given an argument less or
equal to zero. Depth-first search fails on these examples but
breadth-first search enumerates them just fine.
If we are curios, we could inline the newtypes again. However, the
previous implementation is of course more appealing because of its
modularity.
> newtype BFS a = BFS {
> unBFS :: forall b . (a -> [[b] -> [b]]) -> [[b] -> [b]]
> }
>
> instance Monad BFS
> where
> return x = BFS (\c -> c x)
> a >>= f = BFS (\c -> unBFS a (\x -> unBFS (f x) c))
>
> instance MonadPlus BFS
> where
> mzero = BFS (\_ -> [])
> mplus a b = BFS (\c -> id : merge' (unBFS a c) (unBFS b c))
>
> merge' :: [[a] -> [a]] -> [[a] -> [a]] -> [[a] -> [a]]
> merge' [] ys = ys
> merge' xs [] = xs
> merge' (x:xs) (y:ys) = (x.y) : merge' xs ys
>
> runBFS :: BFS a -> [a]
> runBFS a = foldr (.) id (unBFS a ((:[]).(:))) []
Pretty neat! This implementation avoids the diagonalization[^diag]
that is necessary in other approaches I am aware of. Has this version
of breadth-first search been documented before?
[^diag]: The presented version of breadth-first search does not *use*
an explicit diagonalization function in the implementation of monadic
bind. Nevertheless, the stolen bind *performs* diagonalization as the
following example demonstrates:
~~~
*Main> take 10 (runBFS (do x <- upto 0; y <- upto 0; return (x,y)))
[(0,0),(-1,0),(0,-1),(-2,0),(-1,-1),(0,-2),(-3,0),(-2,-1),(-1,-2),(0,-3)]
~~~
Final notes
-----------
That was a rather lengthy post so let's summarize. Functional lists do
not allow a natural implementation of monadic bind. Fortunately,
continuation-passing style provides monadic bind for free. Thus,
monads for non-determinism can be constructed modularly from types
that support the remaining monadic operations: a continuation monad
can be built on top of them.
I have applied this approach twice. First, I have reinvented
two-continuation-based depth-first search by plugging it together from
modular parts. I have then replaced the part that represents
non-determinism and discovered an implementation of breadth-first
search that I have not been aware of.
The trick to steal monadic bind is not restricted to
non-determinism. Any other set of effects that can be lifted over the
continuation monad transformer can be extended to a monad. Simply
replace the type class `Nondet` with a different class that specifies
a different set of effects.
Attentive readers may have noticed that the examples in this post are
so simple, they never use bind. Probably, I was too excited about
*stealing* bind. I forgot to *use* it.
Feedback
--------
For feedback, please contact [Sebastian Fischer][sebf] or [comment on
reddit][reddit].
[sebf]: mailto:sebf@informatik.uni-kiel.de
[reddit]: http://www.reddit.com/r/haskell/comments/8ceb3/barefaced_pilferage_of_monadic_bind/