Stefan Kahrs <[EMAIL PROTECTED]> writes:
> I liked Mark's version, but let me add a related challenge.
>
> I defined a translation of //-list comprehensions
> that is analogous to the foldr-translation of list comprehensions
> (which optimises the map-concat approach) but works in the infinite case
> as well.
>
> This requires an operator foldrinf, of type:
>
> foldrinf :: (a -> [b] -> [b]) -> [a] -> [b] -> [b]
>
This is actually
foldrinf :: (a -> [b] -> [b]) -> [b] -> [a] -> [b]
> The idea is that the [a] list is our input, and the
> [b] list is an already-built result which we have to interleave
> with putting further elements into this using the input list
> and our operation (the first paramater).
>
> A translation using this operator would be something like this:
> start with
>
> pairdiag = [(x,y) // x<-[1..], y<-[2..]]
>
> and the translation gives
> pairdiag = foldrinf newop1 [] [1..]
> newop1 x y = foldrinf (newop2 x) y [2..]
> newop2 x y z = (x,y) : z
>
> And diag itself can be written as:
> diag xs = [ x // y<-xs, x<-y ]
> which translates into:
> diag xs = foldrinf op [] xs
> op x y = foldrinf (:) y x
>
> The operator foldrinf can be defined as follows:
>
> foldrinf op ys xs =
> folly ys xs 0
> where
> folly ys (x:xs) n = op x (aux n ys)
> where aux 0 bs = folly bs xs (n+1)
> aux n (b:bs) = b : aux (n-1) bs
> aux n [] = foldr op [] xs
> folly ys [] n = ys
>
> But, of course, this is ugly, with numbers and stuff...
> So the challenge is to clean up this version so that it
> looks just as nice as Mark's diag operator.
>
What the hell is going on here? ;-)
Trying to understand, I first strived to make aux more self-contained:
DiagSK1:
> diag xs = foldrinf op [] xs
> op x y = foldrinf (:) y x
> foldrinf :: (a -> [b] -> [b]) -> [b] -> [a] -> [b]
> foldrinf op ys xs =
> folly ys xs 0
> where
> folly ys [] n = ys
> folly ys (x:xs) n = op x (aux n n ys xs)
> where aux m 0 bs [] = bs
> aux m 0 bs (x:xs) = op x (aux (m+1) (m+1) bs xs)
> aux m n (b:bs) xs = b : aux m (n-1) bs xs
> aux m n [] xs = foldr op [] xs
Then eliminate folly and make aux fully independent:
DiagSK2:
> diag xs = foldrinf op [] xs
> op x y = foldrinf (:) y x
> foldrinf :: (a -> [b] -> [b]) -> [b] -> [a] -> [b]
> foldrinf op ys [] = ys
> foldrinf op ys (x:xs) = op x (aux op 0 0 ys xs)
> aux :: (b -> [c] -> [c]) -> Integer -> Integer -> [c] -> [b] -> [c]
> aux op m 0 bs [] = bs
> aux op m 0 bs (x:xs) = op x (aux op (m+1) (m+1) bs xs)
> aux op m n [] xs = foldr op [] xs
> aux op m n (b:bs) xs = b : aux op m (n-1) bs xs
This allows to play around with aux, understand what it does,
and reprogram it:
DiagSK3:
> diag xs = foldrinf op [] xs
> op x y = foldrinf (:) y x
> foldrinf :: (a -> [b] -> [b]) -> [b] -> [a] -> [b]
> foldrinf op ys [] = ys
> foldrinf op ys (x:xs) = op x (aux op split0 split1 ys xs)
> type Split a = [a] -> ([a] -> [a] , [a])
> split0, split1 :: Split a
> split0 l = (id,l)
> split1 = sshift split0
> sshift :: Split a -> Split a
> sshift split l = let p@(h,t) = split l
> in case t of
> [] -> p
> (x:xs) -> ((h . (x :)) , xs)
> aux :: (a -> [b] -> [b]) -> Split b -> Split b -> [b] -> [a] -> [b]
> aux op init follow bs xs =
> let (bh,bt) = init bs
> in bh (if null bt
> then foldr op [] xs
> else case xs of
> [] -> bt
> (x : xs) -> op x (aux op follow (sshift follow) bt xs))
Now we can observe that the to split arguments always follow each other,
so we can eliminate one:
DiagSK4:
> diag xs = foldrinf op [] xs
> op x y = foldrinf (:) y x
> foldrinf :: (a -> [b] -> [b]) -> [b] -> [a] -> [b]
> foldrinf op ys [] = ys
> foldrinf op ys (x:xs) = op x (aux op split0 ys xs)
> type Split a = [a] -> ([a] -> [a] , [a])
> split0 :: Split a
> split0 l = (id,l)
> sshift :: Split a -> Split a
> sshift split l = let p@(h,t) = split l
> in case t of
> [] -> p
> (x:xs) -> ((h . (x :)) , xs)
> aux :: (a -> [b] -> [b]) -> Split b -> [b] -> [a] -> [b]
> aux op split bs xs =
> let (bh,bt) = split bs
> in bh (if null bt
> then foldr op [] xs
> else case xs of
> [] -> bt
> (x : xs) -> op x (aux op (sshift split) bt xs))
Unfortunately, however, this time it wasn't really worth all the effort:
20000 200000 2000000
DiagMPJ 0:00.16 0:02.32 0:37.55
DiagMPJ1 0:00.12 0:01.50 0:23.83
DiagMPJ2 0:00.12 0:01.50 0:24.35
DiagWK1 0:00.12 0:01.34 0:19.02
DiagWK2 0:00.12 0:01.35 0:19.09
DiagWK3 0:00.12 0:01.34 0:18.82
DiagSK 0:01.01 0:45.25
DiagSK3 0:01.13 1:35.33
DiagSK4 0:01.17 1:35.77
We can claw back a little bit by using a more sophisticated split type:
DiagSK5 0:00.69 0:47.19
DiagSK5:
> diag xs = foldrinf op [] xs
> op x y = foldrinf (:) y x
> foldrinf :: (a -> [b] -> [b]) -> [b] -> [a] -> [b]
> foldrinf op ys [] = ys
> foldrinf op ys (x:xs) = op x (aux op split0 ys xs)
> type Split a = ([a] -> [a]) -> ([a] -> [a]) -> ([a] -> [a])
> split0 :: Split a
> split0 pt ph l = ph (pt l)
> sshift :: Split a -> Split a
> sshift split pt ph [] = ph (pt [])
> sshift split pt ph (x : xs) = split pt (ph . (x:)) xs
> aux :: (a -> [b] -> [b]) -> Split b -> [b] -> [a] -> [b]
> aux op split bs xs =
> let pt bt = if null bt
> then foldr op [] xs
> else case xs of
> [] -> bt
> (x : xs) -> op x (aux op (sshift split) bt xs)
> in split pt id bs
This should now be even more cryptic than the original version ;-)
Have fun!
Wolfram
