The list monad is often talked about as representing nondeterministic computation. A function f :: a -> [b] can be though of as a nondeterministic function that takes a value of type a and returns a value of type b, with the list representing the possible return values. This works fine and dandy for finite amounts of nondeterminism, but what if we want to do nondeterministic computation with a potentially infinite number of possibilities?

import Control.Monad

Let's use the list monad to create a list of pairs of small numbers.

pairs = do
    x <- [0, 1, 2]
    y <- [0, 1, 2]
    return (x, y)

this is all well and good -- we get the nine pairs that we're expecting. But what if we want to create a list containing pairs of natural numbers of any size?

bad = do
    x <- [0..]
    y <- [0..]
    return (x, y)

This doesn't work at all! We never get to any of the pairs where x is anything but 0! We know that we can find a bijection between the natural numbers and pairs of natural numbers, and it's not too difficult to find a case where you'd want to iterate over pairs in the product of some infinite spaces, so it'd be nice to have a monad that lets us do essentially that.

If we are going to iterate over such a space, though, we need to ask what order we'd expect out. For the above example with pairs of natural numbers, we'd expect (0,0) to be first, and have pairs ordered by their sum. Between two pairs of the same sum, such as (2,0) and (1,1), it's less clear what order we'd want from them, so let's leave that unspecified.

So we can think of giving each element of our infinite space a grade, and then in our product space the grade of (x,y) will be the grade of x plus the grade of y. Then we'll want to iterate over the elements of the product in ascending order of grade. As long as each grade only has a finite number of elements, that is enough to ensure that we include every pair in our final list. Let's define a datatype for that.

infixr 4 :>
data GradedList a = Empty | [a] :> GradedList a

This is equivalent to a list of lists, but I found it easier to have separate names for the two different types of "cons". So here we have the usual (:) for adding an element to a particular grade, and (:>) for adding an entire grade to a GradedList. The Empty constructor will function like a GradedList with an infinite number of empty grades, but allows our computations to terminate when they know that there's no more work to be done.

The derived Show instance for this type has a few too many parentheses, so we'll define our own.

instance Show a => Show (GradedList a) where
    show Empty = "Empty"
    show (g0 :> gs) = show g0 ++ " :> " ++ show gs

Now let's start with something easy: a Functor instance for GradedList.

instance Functor GradedList where
    fmap f Empty = Empty
    fmap f (g :> gs) = fmap f g :> fmap f gs

This is exactly the functor instance you'd get if you just composed the list functor with itself, and it's exactly what you'd expect it to be if you forgot about the grade structure.

Now let's work toward a Monad instance. Since this is a data structure, it will be easier to think of this Monad instance in terms of join, rather than bind. If we have a GradedList of GradedLists, then let's think about what the first few grades of the join will be.

• The first grade will be the first grade of the GradedLists in the first grade.
• The second grade will be the second grade of the first grade of GradedLists , plus the first grade of the second grade of GradedLists.
• The third grade will be the third grade of the first GradedList, plus the second grade of the second GradedList, plus the first grade of the third GradedList.

It should be pretty clear how this is going. Since we'll be adding together grades a lot, let's write some functions to help with that.

outerZipWith :: ([a] -> [b] -> [c]) -> GradedList a -> GradedList b -> GradedList c
outerZipWith f Empty Empty = Empty
outerZipWith f (a0 :> as) Empty = f a0 [] :> outerZipWith f as Empty
outerZipWith f Empty (b0 :> bs) = f [] b0 :> outerZipWith f Empty bs
outerZipWith f (a0 :> as) (b0 :> bs) = f a0 b0 :> outerZipWith f as bs

Remember that unlike with normal lists, we're thinking of Empty as an infinite string of empty lists.

outerConcat :: GradedList a -> GradedList a -> GradedList a
outerConcat = outerZipWith (++)

So now let's try defining our join. Let's go ahead and imagine that we've folded each grade with outerConcat, so we just have a list of GradedLists, and let's call them L0, L1, L2, and so on. The join we want should look like

L0 + delay 1 L1 + delay 2 L2 + delay 3 L3 + ...

where delay n is an imaginary function that adds n empty grades to the beginning of a GradedList. We can factor this expression as

L0 + delay 1 (L1 + delay 1 (L2 + delay 1 (L3 + ...)))

And now we notice that we can take the first grade of L0 out of the sum and return it immediately. After handling the cases with Empty, we'll end up with something like this (It's not named join to avoid conflicting with the function in Control.Monad).

glJoin :: GradedList (GradedList a) -> GradedList a
glJoin Empty = Empty
glJoin (g0 :> gs) = case foldr outerConcat Empty g0 of
    Empty -> [] :> glJoin gs
    (x0 :> xs) -> x0 :> outerConcat xs (glJoin gs)

And we'll define our Monad instance (Actually, this isn't quite a valid instance):

instance Monad GradedList where
    return x = [x] :> Empty
    x >>= f = glJoin (fmap f x)

We also already essentially have a monoid structure here in outerConcat, so we'll define a MonadPlus instance as well.

instance MonadPlus GradedList where
    mzero = Empty
    mplus = outerConcat

Now let's look at some of the things we can do with this structure. Here are some functions that will be useful for playing with the examples.

toList :: GradedList a -> [a]
toList Empty = []
toList (g0 :> gs) = g0 ++ toList gs

takeGrades :: Int -> GradedList a -> GradedList a
takeGrades 0 _ = Empty
takeGrades _ Empty = Empty
takeGrades n (g0 :> gs) = g0 :> takeGrades (n-1) gs

uniqueGrades :: [a] -> GradedList a
uniqueGrades [] = Empty
uniqueGrades (x:xs) = [x] :> uniqueGrades xs

And we'll define a graded list of natural numbers.

nat = uniqueGrades [0..]

We can represent finite nondeterminism just fine.

ex1 = do
    x <- [0] :> [1] :> [2] :> Empty
    y <- [0] :> [1] :> [2] :> Empty
    z <- [0] :> [1] :> [2] :> Empty
    return (x,y,z)

and infinite nondeterminism too! (try takeGrades 5 ex2, for example) The fact that infinite nondeterminism works is really just a byproduct of the fact that each finite grade of the result comes from only a finite number of branches in the nondeterministic computation.

ex2 = do
    x <- nat
    y <- nat
    z <- nat
    return (x,y,z)

We can combine an infinite number of infinite lists into a single list, where every element will be represented. Here are two ways to implement it.

infMerge :: [[a]] -> [a]
infMerge = toList . join . uniqueGrades . map uniqueGrades
infMerge' lists = toList $ do
    list <- uniqueGrades lists
    x <- uniqueGrades list
    return x

ex3 = infMerge $ [[(x, y) | y <- [0..]] | x <- [0..]]
ex3' = infMerge' $ [[(x, y) | y <- [0..]] | x <- [0..]]

Now unfortunately, the Monad instance I gave above doesn't actually satisfy the monad laws. To demonstrate that, let's create a three layer structure of triples of natural numbers and try collapsing it to one layer in the two possible ways.

nat3 :: GradedList (GradedList (GradedList (Integer, Integer, Integer)))
nat3 = do
    x <- nat
    return $ do
        y <- nat
        return $ do
            z <- nat
            return (x,y,z)

ex4 = takeGrades 5 . join . join $ nat3
ex4' = takeGrades 5 . join . fmap join $ nat3

What we find is that ex4 and ex4' differ, but only in a sense that we don't really care about. Remember that when we thought about what ordering we want at the beginning, we decided that it wasn't so important in which order we got tuples of the same total grade. In these two cases, the grade levels all contain the same elements, but potentially in a different order.

We could get a true Monad instance that does follow the laws if we could change the representations of the grade levels to an unordered container, such as a multiset. Unfortunately, such strutures aren't very nice to work with. The most straightforward way to implement such a structure requires an ordering on our base type, and there isn't a very clean way to deal with Monad instances that only work on a restricted set of base types.

Alternatively, we can say that this instance satisfies the laws if we're willing to relax our notion of equality to ignore the order of elements within each grade.

I'll end with an example of what our MonadPlus instance allows us to do.

ex5 = do
    a <- nat
    b <- nat
    guard (((a + 2*b) `mod` 3) == 0)
    return (a,b)