[Haskell-cafe] Fair diagonals
Sebastian Fischer
sebf at informatik.uni-kiel.de
Fri Nov 6 09:05:43 EST 2009
Hello,
like Luke said, the `diagonal` function from `Control.Monad.Omega` is
what Martijn was looking for and unlike what Louis said, it is not
equivalent to `runOmega . each`:
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)]
ghci> take 10 $ (runOmega . mapM each) [[(x,y) | y <-[1..]] | x
<- [1..]]
*** Exception: stack overflow
Here is an alternative implementation of `diagonal` by Mike Spivey
[1]:
diagonal = concat . diag
diag [] = []
diag (xs:xss) = zipCons xs ([]:diag xss)
zipCons [] yss = yss
zipCons xs [] = map (:[]) xs
zipCons (x:xs) (ys:yss) = (x:ys) : zipCons xs yss
It looks subtly different to Luke's version (no special case for
empty `xs` in the definition of `diag`) but shows the same behaviour
on the above input.
This diagonal function (as well as Luke's) also satisfies the property
diagonal (map (:[]) xs) == xs
for all (even infinite) lists `xs`.
Neither `(runOmega . mapM each)` nor `(bfs . mapM fromList)` terminate
if `xs` is infinite. They both yield `[[1,2,3]]` if `xs == [1,2,3]`
whereas `diag` yields `[[1],[2],[3]]`.
Unlike the omega monad, the level monad enumerates the search tree of
a nondeterministic monadic computation in breadth-first order if
`mplus` and `return` are the inner and leaf nodes of the search tree,
respectively. The omega monad enumerates results in a different order
than the level monad which hints at the problem with the associativity
law mentioned by Heinrich:
ghci> let inc x = return x `mplus` return (x+1)
ghci> runOmega (each [0,10] >>= inc >>= inc)
[0,1,1,2,10,11,11,12]
ghci> runOmega (each [0,10] >>= \x -> inc x >>= inc)
[0,1,10,1,11,2,11,12]
ghci> bfs (fromList [0,10] >>= inc >>= inc)
[0,1,1,2,10,11,11,12]
ghci> bfs (fromList [0,10] >>= \x -> inc x >>= inc)
[0,1,1,2,10,11,11,12]
Both `bfs` and `runOmega` use a lot of memory for larger
examples. `idfsBy 1` returns the results in the same order as `bfs`
but uses much less memory at the price of iteratively recomputing the
search tree. The stream-monad package provides a fair nondeterminism
monad which avoids recomputations and has quite good memory
performance (not as good as `idfs` though).
Cheers,
Sebastian
[1]: The Fun of Programming, Chapter 9: Combinators for logic
programming
--
Underestimating the novelty of the future is a time-honored tradition.
(D.G.)
More information about the Haskell-Cafe
mailing list