[Haskell-cafe] Fair diagonals
Martijn van Steenbergen
I am looking for a function that does an N-dimensional diagonal
traversal. I want the traversal to be fair: the sum of the indices of
the produced combinations should be non-decreasing. Let me illustrate
with an example.
The type of a 2-dimensional traversal would look like this:
> diag2 :: [a] -> [b] -> [(a, b)]
The first two arguments are the two half-axes of the grid and the result
is a fair diagonal traversal of all the points. For example:
>> diag2 [1,2,3] [4,5,6,7]
> [(1,4),(2,4),(1,5),(3,4),(1,6),(2,5),(1,7),(3,5),(2,6),(2,7),(3,6),(3,7)]
Of course the function should work on infinite lists:
>> diag2 [1..] [1..]
> [(1,1),(2,1),(1,2),(3,1),...
Or a combination of finite and infinite lists:
>> diag2 [1,2] [1..]
> [(1,1),(2,1),(1,2),(1,3),(2,2),(1,4),...
Notice that in each case the sum of the pairs (which can seen as indices
in these particular examples) are non-decreasing:
>> let sums = map (uncurry (+))
>> sums $ diag2 [1,2,3] [4,5,6,7]
> [5,6,6,7,7,7,8,8,8,9,9,10]
>> sums $ diag2 [1..] [1..]
> [2,3,3,4,4,4,5,5,5,5,6,...
>> sums $ diag2 [1,2] [1..]
> [2,3,3,4,4,5,5,6,6,7,7,...
Similarly for 3 dimensions the type would be:
> diag3 :: [a] -> [b] -> [c] -> [(a, b, c)]
For N dimensions we have to sacrifice some generality and ask all axes
to be of the same type and produce lists instead of tuples, but I'm
perfectly happy with that:
> diagN :: [[a]] -> [[a]]
I have implemented diag2 and diag3 [1] but noticed that the function
bodies increase in size exponentially following Pascal's triangle and
have no clue how to generialize to N dimensions. Can you help me write
diagN?
Bonus points for the following:
* An infinite number of singleton axes produces [origin] (and finishes
computing), e.g. forall (infinite) xs. diagN (map (:[]) xs) == map (:[]) xs
* For equal indices, the traversal biases to axes that are occur early
in the input (but I don't know how to formalize this).
* The implementation shows regularity and elegance.
Many thanks,
Martijn.
[1] http://hpaste.org/fastcgi/hpaste.fcgi/view?id=11515
_______________________________________________
Haskell-Cafe mailing list
Haskel...@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
Luke Palmer
<mar...@van.steenbergen.nl> wrote:
> Dear caf�,
>
> I am looking for a function that does an N-dimensional diagonal traversal. I
> want the traversal to be fair: the sum of the indices of the produced
> combinations should be non-decreasing. Let me illustrate with an example.
>
> The type of a 2-dimensional traversal would look like this:
>>
>> diag2 :: [a] -> [b] -> [(a, b)]
I believe you can get what you want using the diagonal function from
Control.Monad.Omega.
product xs ys = [ [ (x,y) | y <- ys ] | x <- xs ]
diag2 xs ys = diagonal (product xs ys)
I think if you separate taking the cartesian product and flattening
it, like this, you might have an easier time wrangling all the
different variants you want.
Luke
Sjoerd Visscher
diagN :: [[a]] -> [[a]]
diagN = diagN' 0
diagN' :: Integer -> [[a]] -> [[a]]
diagN' i xss = case r of
[] -> []
_ -> r ++ diagN' (i + 1) xss
where r = diagN_i i xss
diagN_i :: Integer -> [[a]] -> [[a]]
diagN_i 0 [] = [[]]
diagN_i _ [] = []
diagN_i _ ([]:xss) = []
diagN_i 0 ((x:xs):xss) = [ x : r | r <- diagN_i 0 xss ]
diagN_i i ((x:xs):xss) = diagN_i (i - 1) (xs:xss) ++ [ x : r | r <-
diagN_i i xss ]
diagN_i produces all the diagonals where the sum of indices sum to i.
The order of the arguments to ++ in the last line determines the bias
to the earlier or later axes.
Where you say you want diagN (map (:[]) xs) == map (:[]) xs, I think
you mean diagN (map (:[]) xs) == [xs], which can never finish when xs
is infinite, because diagN has to check there isn't an empty list in
the list of lists it gets, in which case diagN must return [].
Sjoerd
--
Sjoerd Visscher
sjo...@w3future.com
Twan van Laarhoven
> I believe this does what you want:
>
> <code>
The attached code should be more efficient, since it doesn't use integer indices.
Note that this is just a 'level' monad: the list is stratified into levels, when
combining two levels, the level of the result is the sum of the levels of the
inputs.
map (map sum) . runDiags . traverse each $ [[1..], [1..], [1..]]
[[3],[4,4,4],[5,5,5,5,5,5],[6,6,6,6,6,6,6,6,6,6],[7,7,7,7,7,7,7,7,7,7,7,...
I looked on hackage but I was surprised that I couldn't find this simple monad.
The package level-monad does look very similar, only it uses a different list
type for the representation.
By the way, it seems Omega intentionally doesn't use this design. To quote the
documentation "... a breadth-first search of a data structure can fall short if
it has an infinitely branching node. Omega addresses this problem ..."
Twan
Sjoerd Visscher
On Nov 4, 2009, at 3:21 PM, Twan van Laarhoven wrote:
>
> I looked on hackage but I was surprised that I couldn't find this
> simple monad. The package level-monad does look very similar, only
> it uses a different list type for the representation.
>
indeed, level-monad works as well:
import Control.Monad.Levels
import Data.FMList (fromList)
diagN = bfs . mapM fromList
--
Sjoerd Visscher
sjo...@w3future.com
Heinrich Apfelmus
> I believe you can get what you want using the diagonal function from
> Control.Monad.Omega.
>
> product xs ys = [ [ (x,y) | y <- ys ] | x <- xs ]
> diag2 xs ys = diagonal (product xs ys)
>
> I think if you separate taking the cartesian product and flattening
> it, like this, you might have an easier time wrangling all the
> different variants you want.
Note that Control.Monad.Omega is not a monad. The law of associativity
is broken, at least in a direct sense.
Regards,
apfelmus
Sjoerd Visscher
diagN = concat . foldr f [[[]]]
f :: [a] -> [[[a]]] -> [[[a]]]
f xs ys = foldr (g ys) [] xs
g :: [[[a]]] -> a -> [[[a]]] -> [[[a]]]
g ys x xs = merge (map (map (x:)) ys) ([] : xs)
merge :: [[a]] -> [[a]] -> [[a]]
merge [] ys = ys
merge xs [] = xs
merge (x:xs) (y:ys) = (x++y) : merge xs ys
But my feeling is that this can still be simplified further. Or at
least refactored so it is clear what actually is going on!
Martijn van Steenbergen
> diagN = bfs . mapM fromList
This is awesome guys, thanks so much.
Martijn.
Henning Thielemann
Can someone explain the difference between control-monad-omega and
level-monad?
Bertram Felgenhauer
> Bonus points for the following:
> * An infinite number of singleton axes produces [origin] (and
> finishes computing), e.g. forall (infinite) xs. diagN (map (:[]) xs)
> == map (:[]) xs
This can't be done - you can not produce any output before you have
checked that all the lists are not empty:
diag (replicate n [0] ++ [[]]) == []
Bertram
Martijn van Steenbergen
>
> On Wed, 4 Nov 2009, Sjoerd Visscher wrote:
>
>>
>> On Nov 4, 2009, at 3:21 PM, Twan van Laarhoven wrote:
>>
>> I looked on hackage but I was surprised that I couldn't find
>> this simple
>> monad. The package level-monad does look very similar, only it
>> uses a
>> different list type for the representation.
>>
>>
>> indeed, level-monad works as well:
>>
>> import Control.Monad.Levels
>> import Data.FMList (fromList)
>>
>> diagN = bfs . mapM fromList
>
> Can someone explain the difference between control-monad-omega and
> level-monad?
So from what I understand this is the difference:
Omega is biased towards the lower dimensions while Levels
treats all dimensions equally, or at least more equally. You can
formalize the latter by saying: the sums of the indices should be
non-decreasing.
From Omega's documentation I understand this is on purpose:
"(...) Likewise, a breadth-first search of a data structure can fall
short if it has an infinitely branching node. Omega addresses this
problem by using a "diagonal" traversal that gracefully dissolves such
data."
However, I can't verify this:
> runOmega . mapM each $ map (:[]) [1..]
> *** Exception: stack overflow
Or maybe I misunderstood Omega's documentation.
Martijn.
Luke Palmer
<mar...@van.steenbergen.nl> wrote:
> "(...) Likewise, a breadth-first search of a data structure can fall short
> if it has an infinitely branching node. Omega addresses this problem by
> using a "diagonal" traversal that gracefully dissolves such data."
>
> However, I can't verify this:
>>
>> �runOmega . mapM each $ map (:[]) [1..]
>> *** Exception: stack overflow
>
> Or maybe I misunderstood Omega's documentation.
You are asking for the impossible.
>>> runOmega . mapM each $ [[1],[2],[3],[4],[5],[6]]
[[1,2,3,4,5,6]]
Replace one of them with the empty list
>>> runOmega . mapM each $ [[1],[2],[3],[],[5],[6]]
[]
If any of the lists is empty, the output will be empty. So if you
give it an infinite number of lists, it cannot ever return any
information to you, since at some point in the future it may come
across an empty list.
Unless, of course, it *does* encounter an empty list, in which case it
knows the answer:
runOmega . mapM each $ map (:[]) [1..10] ++ [] ++ map (:[]) [12..]
[]
Luke
Martijn van Steenbergen
> On Fri, Nov 6, 2009 at 3:06 AM, Martijn van Steenbergen
> <mar...@van.steenbergen.nl> wrote:
>> "(...) Likewise, a breadth-first search of a data structure can fall short
>> if it has an infinitely branching node. Omega addresses this problem by
>> using a "diagonal" traversal that gracefully dissolves such data."
>>
>> However, I can't verify this:
>>> runOmega . mapM each $ map (:[]) [1..]
>>> *** Exception: stack overflow
>> Or maybe I misunderstood Omega's documentation.
>
> You are asking for the impossible.
Oh, and I realise now that this has been mentioned two times before
already in this thread. *hangs head in shame*
Are there examples of infinitely branching nodes where it is possible to
give some output? Otherwise I'm not sure what the documentation is saying.
Martijn.
Sebastian Fischer
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.)
Sebastian Fischer
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
mf-hcafe-...@etc-network.de
On Wed, Nov 04, 2009 at 07:01:50PM +0100, Sjoerd Visscher wrote:
> To: Haskell Cafe <haskel...@haskell.org>
> From: Sjoerd Visscher <sjo...@w3future.com>
> Date: Wed, 4 Nov 2009 19:01:50 +0100
> Subject: Re: [Haskell-cafe] Fair diagonals (code golf)
>
> The code by Twan can be reduced to this:
>
> diagN = concat . foldr f [[[]]]
>
> f :: [a] -> [[[a]]] -> [[[a]]]
> f xs ys = foldr (g ys) [] xs
>
> g :: [[[a]]] -> a -> [[[a]]] -> [[[a]]]
> g ys x xs = merge (map (map (x:)) ys) ([] : xs)
>
> merge :: [[a]] -> [[a]] -> [[a]]
> merge [] ys = ys
> merge xs [] = xs
> merge (x:xs) (y:ys) = (x++y) : merge xs ys
>
> But my feeling is that this can still be simplified further. Or at least
> refactored so it is clear what actually is going on!
i wrote another solution:
diag2 xs ys = join . takeWhile (not . null) . map f $ [1..]
where
f i = zip xs' ys'
where
xs' = take i $ drop (i - length ys') xs
ys' = reverse $ take i ys
diag [] = []
diag [q] = [q]
diag qs = foldr f (map (:[]) $ last qs) (init qs)
where
f q' = map (uncurry (++)) . diag2 (map (:[]) q')
diag is the recursion step over the dimensions; diag2 is the base case
with two dimensions. i can see that it's less efficient on
(partially) finite inputs, since i keep dropping increasing prefixes
of xs and ys in the local f in diag2), and there are probably other
issues. but it was fun staring at this problem for a while. :)
matthias