[Haskell-cafe] Fair diagonals

[Sebastian Fischer]

Hello,

Sjoerd's intuition to reuse a nondeterminism monad in order to
implement fair diagonalisation was insightful and one can implement a
diagonalisation function that satisfies the property

     diagonal (map (:[]) xs)  ==  xs

for all (even infinite) lists `xs` using the level monad.

Here is how. Start with a convoluted definition of `concat` that uses
a list comprehension which does nothing:

     flatten :: [[a]] -> [a]
     flatten xss = concat [ [ x | x <- xs ] | xs <- xss ]

Now, generalise this definition to an arbitrary nondeterminism monad
by translating list comprehension syntax into do notation:

     merge :: MonadPlus m => [[a]] -> m a
     merge xss = join(do xs<-anyOf xss;return(do x<-anyOf xs;return x))

The `anyOf` function is a generalisation of `Data.FMList.fromList` and
`Control.Monad.Omega.each` that is not specific to a specific
nondeterminism monad:

     anyOf :: MonadPlus m => [a] -> m a
     anyOf = msum . map return

In the list monad `merge` is equivalent to `flatten` but different
monads merge the lists in different orders. It turns out that `merge`
implements diagonalisation in the level monad.

The pointfree program [1] knows how to simplify the body of `merge`:

     # pointfree -v "\xss->join(anyOf xss>>=\xs->return(anyOf xs>>=\x- 
 >return x))"
     Transformed to pointfree style:
     join . flip ((>>=) . anyOf) (return . flip ((>>=) . anyOf) return)
     Optimized expression:
     join . flip ((>>=) . anyOf) (return . flip ((>>=) . anyOf) return)
     join . (>>= return . flip ((>>=) . anyOf) return) . anyOf
     join . (return . flip ((>>=) . anyOf) return =<<) . anyOf
     join . (return . (>>= return) . anyOf =<<) . anyOf
     join . (return . (return =<<) . anyOf =<<) . anyOf
     join . (return . id . anyOf =<<) . anyOf
     join . (return . anyOf =<<) . anyOf
     join . (anyOf `fmap`) . anyOf
     (anyOf =<<) . anyOf

Now, specialise for the level monad to get fair diagonalisation:

     diagonal :: [[a]] -> [a]
     diagonal = bfs . (>>= fromList) . fromList

A quick check shows that this function really works for infinite
lists:

     ghci> take 10 $ diagonal [[(x,y) | y <- [1..]] | x <- [1..]]
     [(1,1),(1,2),(2,1),(1,3),(2,2),(3,1),(1,4),(2,3),(3,2),(4,1)]

SmallCheck [2] helps to recognise that the omega monad produces a
different order on some inputs:

     ghci> bfs (anyOf [[1,2,3],[],[],[4]] >>= anyOf)
     [1,2,3,4]
     ghci> runOmega (anyOf [[1,2,3],[],[],[4]] >>= anyOf)
     [1,2,4,3]

In this example, each number n is on the nth diagonal of the
corresponding matrix. Unlike in the omega monad, `merge` faithfully
implements diagonalisation in the level monad.

Cheers,
Sebastian

[1]: http://hackage.haskell.org/package/pointfree
[2]: http://hackage.haskell.org/package/smallcheck

-- 
Underestimating the novelty of the future is a time-honored tradition.
(D.G.)