# Catamorphism that allows looking at part of the final result

by Joseph Sible   Last Updated May 16, 2019 00:26 AM

Is there a name for a recursion scheme that's like a catamorphism, but that allows peeking at the final result while it's still running? Here's a slighly contrived example:

``````toPercents :: Floating a => [a] -> [a]
toPercents xs = result
where
(total, result) = foldr go (0, []) xs
go x ~(t, r) = (x + t, 100*x/total:r)

{-
>>> toPercents [1,2,3]
[16.666666666666668,33.333333333333336,50.0]
-}
``````

This example uses `total` at each step of the fold, even though its value isn't known until the end. (Obviously, this relies on laziness to work.)

Tags :

Though this is not necessarily what you were looking for, we can encode the laziness trick with a hylomorphism:

``````{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TemplateHaskell #-}

import Data.Functor.Foldable
import Data.Functor.Foldable.TH

data CappedList c a = Cap c | CCons a (CappedList c a)
deriving (Eq, Show, Ord, Functor, Foldable, Traversable)
makeBaseFunctor ''CappedList

-- The seq here has no counterpart in the implementation in the question.
-- It improves performance quite noticeably. Other seqs might be added for
-- some of the other "s", as well as for the percentage; the returns, however,
-- are diminishing.
toPercents :: Floating a => [a] -> [a]
toPercents = snd . hylo percAlg sumCal . (0,)
where
sumCal = \case
(s, []) -> CapF s
(s, a : as) -> s `seq` CConsF a (s + a, as)
percAlg = \case
CapF s -> (s, [])
CConsF a (s, as) -> (s, (a * 100 / s) : as)
``````

This corresponds to the laziness trick because, thanks to hylo fusion, the intermediate `CappedList` never actually gets built, and `toPercents` consumes the input list in a single pass. The point of using `CappedList` is, as moonGoose puts it, placing the sum at the bottom of the (virtual) intermediate structure, so that the list rebuilding being done with `percAlg` can have access to it from the start.

(It is perhaps worth noting that, even though it is done in a single pass, it seems difficult to get nice-and-constant memory usage from this trick, be it with my version or with yours. Suggestions on this front are welcome.)

duplode
May 14, 2019 01:14 AM

Just crazy experiment. I think we can fuse smth.

Also `fix = hylo (\(Cons f a) -> f a) (join Cons)` and we can replace on `fix`

``````toPercents :: Floating a => [a] -> [a]
toPercents xs = result
where
(_, result) = hylo (\(Cons f a) -> f a) (join Cons) \$ \(~(total, _)) ->
let
alg Nil = (0, [])
alg (Cons x (a, as)) = (x + a, 100 * x / total: as)
in
cata alg xs
``````
xgrommx
May 14, 2019 08:02 AM

I don't think there's explicitly a scheme for allowing function 1 to peek at each step at the end result of function 2. It seems like a somewhat odd one to want though. I think that in the end, it's going to boil down to either 1) running function 2, then running function 1 with the known result of function 2 (ie. two passes, which I think is the only way to get constant memory in your example) or 2) running them side-by-side, creating a function thunk (or relying on laziness) to combine them at the end.

The lazy `foldr` version you gave of course translates naturally into a catamorphism. Here's the functionalized catamorphism version,

``````{-# LANGUAGE LambdaCase -#}

import Data.Functor.Foldable

toPercents :: Floating a => [a] -> [a]
toPercents = uncurry (\$) . cata alg
where
alg = \case
Nil -> (const [], 0)
Cons x (f,s) ->  (\t -> 100*x / t : f t, s + x)
``````

It doesn't seem nice stylistically to have to hand-parallelize the two catamorphisms though, particularly as then it doesn't encode the fact that neither stepwise-relies on the other. Hoogle finds bicotraverse, but it's unnecessarily general, so let's write our algebra-parallelization operator `(&&&&)`,

``````import Control.Arrow

(&&&&) :: Functor f => (f a -> c) -> (f b -> d) -> f (a,b) -> (c,d)
f1 &&&& f2 = (f1 . fmap fst &&& f2 . fmap snd)

toPercents' :: Floating a => [a] -> [a]
toPercents' = uncurry (\$) . cata (algList &&&& algSum)

algSum :: (Num a) => ListF a a -> a
algSum = \case
Nil -> fromInteger 0
Cons x !s -> s + x

algList :: (Fractional a) => ListF a (a -> [a]) -> (a -> [a])
algList = \case
Nil -> const []
Cons x s -> (\t -> 100*x / t : s t)
``````
moonGoose
May 15, 2019 17:54 PM

## Related Questions

Updated May 04, 2019 02:26 AM

Updated May 06, 2019 12:26 PM

Updated July 17, 2018 07:26 AM

Updated April 20, 2019 09:26 AM

Updated January 14, 2019 22:26 PM