Fair diagonals

[Martijn van Steenbergen-2]

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)]

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
Haskell-Cafe@...
http://www.haskell.org/mailman/listinfo/haskell-cafe

[Luke Palmer-2]

On Tue, Nov 3, 2009 at 1:42 PM, Martijn van Steenbergen
<martijn@...> 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
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@...
http://www.haskell.org/mailman/listinfo/haskell-cafe

[Arkleseizure]

+1 on Control.Monad.Omega.  In point of fact, your diagN function is simply

diagN = runOmega . mapM Omega

You'll find it an interesting exercise to grok the source of Control.Monad.Omega, obviously, but essentially, you're replacing concatMap with a fair (diagonal) traversal order version.

Louis Wasserman
wasserman.louis@...
http://profiles.google.com/wasserman.louis

_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@...
http://www.haskell.org/mailman/listinfo/haskell-cafe

[Martijn van Steenbergen-2]

Louis Wasserman wrote:
> +1 on Control.Monad.Omega.  In point of fact, your diagN function is simply
>
> diagN = runOmega . mapM Omega
>
> You'll find it an interesting exercise to grok the source of
> Control.Monad.Omega, obviously, but essentially, you're replacing
> concatMap with a fair (diagonal) traversal order version.

Thanks for the replies!

I've looked at Omega but it's not fair enough. The sums of the indices
are not non-decreasing:

map sum $ runOmega . mapM each $ [[1..], [1..], [1..]]
[3,4,4,4,5,5,5,5,6,6,5,6,6,7,7,5,6,7,7,8,8,6,6,7,8,8,9,9,6,7,...

Is there another way to use Omega that meets this (very important)
criterion or is Omega not the right tool here?

Thanks,

Martijn.
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@...
http://www.haskell.org/mailman/listinfo/haskell-cafe

[Sjoerd Visscher-2]

I believe this does what you want:

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

On Nov 3, 2009, at 9:42 PM, Martijn van Steenbergen 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)]
>
> 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
> Haskell-Cafe@...
> http://www.haskell.org/mailman/listinfo/haskell-cafe

--
Sjoerd Visscher
sjoerd@...



_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@...
http://www.haskell.org/mailman/listinfo/haskell-cafe

[Twan van Laarhoven]

Sjoerd Visscher wrote:

> 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

-- A simple 'level' monad type

module MonadDiags where

import Control.Applicative
import Control.Monad

apD :: [[a -> b]] -> [[a]] -> [[b]]
apD [] _  = []
apD _  [] = []
apD (xx:xs) ys = unionD (map apXX ys) ([] : apD xs ys)
   where apXX yy = xx <*> yy


unionD :: [[a]] -> [[a]] -> [[a]]
unionD [] ys = ys
unionD xs [] = xs
unionD (x:xs) (y:ys) = (x++y) : unionD xs ys


-- Now to wrap things up in an applicative functor

newtype Diags a = Diags { runDiags :: [[a]] }

instance Functor Diags where
   fmap f = Diags . map (map f) . runDiags

instance Applicative Diags where
   pure a = Diags [[a]]
   a <*> b = Diags (runDiags a `apD` runDiags b)

instance Alternative Diags where
   empty = Diags [[]]
   a <|> b = Diags (runDiags a `unionD` runDiags b)

each :: [a] -> Diags a
each = Diags . map return


-- And if we want a monad, we should also have a join function

joinD :: [[Diags a]] -> [[a]]
joinD [] = []
joinD (xx:xs) = unionsD (map runDiags xx) `unionD` ([] : joinD xs)

unionsD :: [[[a]]] -> [[a]]
unionsD = foldr unionD []

instance Monad Diags where
    return = pure
    a >>= b = Diags (joinD (runDiags $ fmap b a))
    fail _ = empty

instance MonadPlus Diags where
    mzero = empty
    mplus = (<|>)

_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@...
http://www.haskell.org/mailman/listinfo/haskell-cafe

[Sjoerd Visscher-2]

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

sjoerd@...

_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@...
http://www.haskell.org/mailman/listinfo/haskell-cafe

[Heinrich Apfelmus]

Luke Palmer wrote:
> 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

--
http://apfelmus.nfshost.com

_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@...
http://www.haskell.org/mailman/listinfo/haskell-cafe

[Sjoerd Visscher-2]

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!

--
Sjoerd Visscher
sjoerd@...



_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@...
http://www.haskell.org/mailman/listinfo/haskell-cafe

[Martijn van Steenbergen-2]

Sjoerd Visscher wrote:
> diagN = bfs . mapM fromList

This is awesome guys, thanks so much.

Martijn.

_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@...
http://www.haskell.org/mailman/listinfo/haskell-cafe

[Arkleseizure]

I figured out an inductive approach as follows, which lets you derive stripeN from stripe(N-1).  This could be TemplateHaskell'd if you have a bound on N; I'm still trying to figure out a type-magical alternative.

Suppose stripe(N-1) :: x -> [b] -> [c]

Then

stripeN :: (a -> [b]) -> x -> [a] -> [[c]]
stripeN f x [] = []
stripeN f x (a:as) = case stripe(N-1) x (f a) of

[] -> stripeN f x as
(b:bs) -> [b]:zipCons bs (stripeN f x as)

and then diagN is obtained by applying concat an appropriate number of times.  It's fair.  The real-question is how to type-magically work it for arbitrarily many coordinates...


Louis Wasserman
wasserman.louis@...
http://profiles.google.com/wasserman.louis

On Wed, Nov 4, 2009 at 4:38 AM, Martijn van Steenbergen <martijn@...> wrote:

Louis Wasserman wrote:

+1 on Control.Monad.Omega.  In point of fact, your diagN function is simply

diagN = runOmega . mapM Omega

You'll find it an interesting exercise to grok the source of Control.Monad.Omega, obviously, but essentially, you're replacing concatMap with a fair (diagonal) traversal order version.

Thanks for the replies!

I've looked at Omega but it's not fair enough. The sums of the indices are not non-decreasing:

map sum $ runOmega . mapM each $ [[1..], [1..], [1..]]
[3,4,4,4,5,5,5,5,6,6,5,6,6,7,7,5,6,7,7,8,8,6,6,7,8,8,9,9,6,7,...

Is there another way to use Omega that meets this (very important) criterion or is Omega not the right tool here?

Thanks,

Martijn.

_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@...
http://www.haskell.org/mailman/listinfo/haskell-cafe

[Henning Thielemann]

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?
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@...
http://www.haskell.org/mailman/listinfo/haskell-cafe

[Bertram Felgenhauer-2]

Martijn van Steenbergen wrote:
> 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
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@...
http://www.haskell.org/mailman/listinfo/haskell-cafe

[Martijn van Steenbergen-2]

Henning Thielemann wrote:

>
> 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.
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@...
http://www.haskell.org/mailman/listinfo/haskell-cafe

[Luke Palmer-2]

On Fri, Nov 6, 2009 at 3:06 AM, Martijn van Steenbergen
<martijn@...> 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
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@...
http://www.haskell.org/mailman/listinfo/haskell-cafe

[Martijn van Steenbergen-2]

Luke Palmer wrote:

> On Fri, Nov 6, 2009 at 3:06 AM, Martijn van Steenbergen
> <martijn@...> 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.

_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@...
http://www.haskell.org/mailman/listinfo/haskell-cafe

[Sebastian Fischer]

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.)



_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@...
http://www.haskell.org/mailman/listinfo/haskell-cafe

[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.)



_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@...
http://www.haskell.org/mailman/listinfo/haskell-cafe

[mf-hcafe-15c311f0c]

On Wed, Nov 04, 2009 at 07:01:50PM +0100, Sjoerd Visscher wrote:

> To: Haskell Cafe <haskell-cafe@...>
> From: Sjoerd Visscher <sjoerd@...>
> 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
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@...
http://www.haskell.org/mailman/listinfo/haskell-cafe