[Haskell-cafe] Fair diagonals (code golf)

[mf-hcafe-15c311f0c at etc-network.de]

On Wed, Nov 04, 2009 at 07:01:50PM +0100, Sjoerd Visscher wrote:
> To: Haskell Cafe <haskell-cafe at haskell.org>
> From: Sjoerd Visscher <sjoerd at 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