I’ve been playing with deriving efficient parallel, imperative implementations of "prefix sum" or more generally "left scan". Following posts will explore the parallel & imperative derivations, but as a warm-up, I’ll tackle the functional & sequential case here.

foldl ∷ (b → a → b) → b → [a] → b
foldl f z []     = z
foldl f z (x:xs) = foldl f (z `f` x) xs

foldr ∷ (a → b → b) → b → [a] → b
foldr f z []     = z
foldr f z (x:xs) = x `f` foldr f z xs

scanl ∷ (b → a → b) → b → [a] → [b]

scanl f z [x1, x2,  ⋯ ] ≡ [z, z `f` x1, (z `f` x1) `f` x2, ⋯]

scanr ∷ (a → b → b) → b → [a] → [b]

scanr f z [⋯, xn_1, xn] ≡ [⋯, xn_1 `f` (xn `f` z), xn `f` z, z]

last (scanl f z xs) ≡ foldl f z xs
head (scanr f z xs) ≡ foldr f z xs

last ∘ scanl f z ≡ foldl f z
head ∘ scanr f z ≡ foldr f z

scanl ∷ (b → a → b) → b → [a] → [b]
scanl f z ls = z : (case ls of
                     []   → []
                     x:xs → scanl f (z `f` x) xs)

scanr ∷ (a → b → b) → b → [a] → [b]
scanr _ z []     = [z]
scanr f z (x:xs) = (x `f` q) : qs
                   where qs@(q:_) = scanr f z xs

scanl f z xs = map (foldl f z) (inits xs)
scanr f z xs = map (foldr f z) (tails xs)

scanl f z = map (foldl f z) ∘ inits
scanr f z = map (foldr f z) ∘ tails

inits ∷ [a] → [[a]]
inits []     = [[]]
inits (x:xs) = [[]] ++ map (x:) (inits xs)

tails ∷ [a] → [[a]]
tails []         = [[]]
tails xs@(_:xs') = xs : tails xs'

inits xs = [] : case xs of
                  []     → []
                  (x:xs) → map (x:) (inits xs)

last ∘ scanl f z ≡ foldl f z
head ∘ scanr f z ≡ foldr f z

  scanl f z []
≡ {- scanl spec -}
  map (foldl f z) (inits [])
≡ {- inits def -}
  map (foldl f z) [[]]
≡ {- map def -}
  [foldl f z []]
≡ {- foldl def -}
  [z]

  scanl f z (x:xs)
≡ {- scanl spec -}
  map (foldl f z) (inits (x:xs))
≡ {- inits def -}
  map (foldl f z) ([] : map (x:) (inits xs))
≡ {- map def -}
  foldl f z [] : map (foldl f z) (map (x:) (inits xs))
≡ {- foldl def -}
  z : map (foldl f z) (map (x:) (inits xs))
≡ {- map g ∘ map f ≡ map (g ∘ f) -}
  z : map (foldl f z ∘ (x:)) (inits xs)
≡ {- (∘) def -}
  z : map (λ ys → foldl f z (x:ys)) (inits xs)
≡ {- foldl def -}
  z : map (λ ys → foldl f (z `f` x) ys)) (inits xs)
≡ {- η reduction -}
  z : map (foldl f (z `f` x))) (inits xs)
≡ {- scanl spec -}
  z : scanl f (z `f` x) xs

  scanr f z []
≡ {- scanr spec -}
  map (foldr f z) (tails [])
≡ {- tails def -}
  map (foldr f z) ([[]])
≡ {- map def -}
  [foldr f z []]
≡ {- foldr def -}
  [z]

  scanr f z (x:xs)
≡ {- scanr spec -}
  map (foldr f z) (tails (x:xs))
≡ {- tails def -}
  map (foldr f z) ((x:xs) : tails xs)
≡ {- map def -}
  foldr f z (x:xs) : map (foldr f z) (tails xs)
≡ {- scanr spec -}
  foldr f z (x:xs) : scanr f z xs
≡ {- foldr def -}
  (x `f` foldr f z xs) : scanr f z xs
≡ {- head/scanr property -}
  (x `f` head (scanr f z xs)) : scanr f z xs
≡ {- factor out shared expression -}
  (x `f` head qs) : qs where qs = scanr f z xs
≡ {- stylistic variation -}
  (x `f` q) : qs where qs@(q:_) = scanr f z xs

This post is part four of the zip folding series inspired by Max Rabkin’s Beautiful folding post. I meant to write one little post, but one post turned into four. When I sense that something can be made simpler/clearer, I can’t leave it be.

To review:

• Part One related Max’s data representation of left folds to type class morphisms, a pattern that’s been steering me lately toward natural (inevitable) design of libraries.
• Part Two simplified that representation to help get to the essence of zipping, and in doing so lost the expressiveness necessary to define Functorand Applicative instaces.
• Part Three proved the suitability of the zipping definitions in Part Two.

This post shows how to restore the Functor and Applicative (very useful composition tools) to folds but does so in a way that leaves the zipping functionality untouched. This new layer is independent of folding and can be layered onto any zippable type.

You can get the code described below.

Edits:

• 2009-02-15: Simplified WithCont, collapsing two type parameters into one. Added functor comment about cfoldlc'.

What’s missing?

Max’s fold type packages up the first two arguments of foldl' and adds on an post-fold step, as needed for fmap:

data Fold b c = forall a. F (a -> b -> a) a (a -> c)  -- clever version

The simpler, less clever version just has the two foldl' arguments, and no forall:

data Fold b a = F (a -> b -> a) a                     -- simple version

Removing Max’s post-fold step gets to the essence of fold zipping but loses some useful composability. In particular, we can no longer define Functor and Applicative instances.

The difference between the clever version and the simple one is a continuation and a forall, which we can write down as follows:

data WithCont z c = forall a. WC (z a) (a -> c)

The clever version is equivalent to the following:

type FoldC b = WithCont (Fold b)

Interpreting a FoldC just interprets the Fold and then applies the continuation:

cfoldlc :: FoldC b a -> [b] -> a
cfoldlc (WC f k) = k . cfoldl f

(In a more general setting, use fmap in place of (.) to give meaning to WithCont.)

Add a copy of WithCont, for reasons explained later, and use it for strict folds.

data WithCont' z c = forall a. WC' (z a) (a -> c)

type FoldC' b = WithCont' (Fold b)

cfoldlc' :: FoldC' b a -> [b] -> a
cfoldlc' (WC' f k) = k . cfoldl' f

From Zip to Functor and Applicative

It’s now a simple matter to recover the lost Functor and Applicative instances, for both non-strict and strict zipping. The Applicative instances rely on zippability:

instance Functor (WithCont z) where
  fmap g (WC f k) = WC f (g . k)

instance Zip z => Applicative (WithCont z) where
  pure a = WC undefined (const a)
  WC hf hk <*> WC xf xk =
    WC (hf `zip` xf) ( (a,a') -> (hk a) (xk a'))


instance Functor (WithCont' z) where
  fmap g (WC' f k) = WC' f (g . k)

instance Zip' z => Applicative (WithCont' z) where
  pure a = WC' undefined (const a)
  WC' hf hk <*> WC' xf xk =
    WC' (hf `zip'` xf) ( (P a a') -> (hk a) (xk a'))

Now the reason for the duplicate WithCont definition becomes apparent. Instance selection in Haskell is based entirely on the “head” of an instance. If both Applicative instances used WithCont, the compiler would consider them to overlap.

Morphism proofs

It remains to prove that our interpretation functions are Functor and Applicative morphisms. I’ll show the non-strict proofs. The strict morphism proofs go through similarly.

Functor

The Functor morphism property for non-strict folding:

cfoldlc (fmap g wc) == fmap g (cfoldlc wc)

Adding some structure:

cfoldlc (fmap g (WC f k)) == fmap g (cfoldlc (WC f k))

Proof:

cfoldlc (fmap g (WC f k))

  == {- fmap on WithCont -}

cfoldlc (WC f (g . k))

  == {- cfoldlc def -}

(g . k) . cfoldl f

  == {- associativity of (.)  -}

g . (k . cfoldl f)

  == {- cfoldl def -}

g . cfoldlc (WC f k)

  == {- fmap on functions -}

fmap g (cfoldlc (WC f k))

Applicative

Applicative has two methods, so cfoldlc must satisfy two morphism properties. One for pure:

cfoldlc (pure a) == pure a

Proof:

cfoldlc (pure a)

  == {- pure on WithCont -}

cfoldlc (WC undefined (const a))

  == {- cfoldlc def -}

const a . cfoldl undefined

  == {- property of const -}

const a

  == {- pure on functions -}

pure a

And one for (<*>):

cfoldlc (wch <*> wcx) == cfoldlc wch <*> cfoldlc wcx

Adding structure:

cfoldlc ((WC hf hk) <*> (WC xf xk)) == cfoldlc (WC hf hk) <*> cfoldlc (WC xf xk)

Proof:

cfoldlc ((WC hf hk) <*> (WC xf xk))

  == {- (<*>) on WithCont -}

cfoldlc (WC (hf `zip` xf) ( (a,a') -> (hk a) (xk a')))

  == {- cfoldlc def -}

( (a,a') -> (hk a) (xk a')) . cfoldl (hf `zip` xf)

  == {- Zip morphism law for Fold -}

( (a,a') -> (hk a) (xk a')) . (cfoldl hf `zip` cfoldl xf)

  == {- zip def on functions -}

( (a,a') -> (hk a) (xk a')) .  bs -> (cfoldl hf bs, cfoldl xf bs)

  == {- (.) def -}

 bs -> (hk (cfoldl hf bs)) (xk (cfoldl xf bs))

  == {- (<*>) on functions -}

(hk . cfoldl hf bs) <*> (xk . cfoldl xf)

  == {- cfoldlc def, twice -}

cfoldlc (WC hf hk) <*> cfoldlc (WC xf xk)

That’s it.

I like that WithCont allows composing the morphism proofs, in addition to the implementations.

The post More beautiful fold zipping showed a formulation of left-fold zipping, simplified from the ideas in Max Rabkin’s Beautiful folding. I claimed that the semantic functions are the inevitable (natural) ones in that they preserve zipping stucture. This post gives the promised proofs.

The correctness of fold zipping can be expressed as follows. Is cfoldl a Zip morphism, and is cfoldl' a Zip' morphism? (See More beautiful fold zipping for definitions of these functions and classes, and see Simplifying semantics with type class morphisms for the notion of type class morphisms.)

Non-strict

The non-strict version is simpler, though less useful. We want to prove

cfoldl (f `zip` f') == cfoldl f `zip` cfoldl f'

First, substitute the definition of zip for functions.

instance Zip ((->) u) where zip = liftA2 (,)

This definition is a standard one for zipping applicative functors. Given the Applicative instance for functions, this Zip instance is equivalent to

instance Zip ((->) u) where r `zip` s =  u -> (r u, s u)

So the Zip morphism property becomes

cfoldl (f `zip` f') bs == (cfoldl f bs, cfoldl f' bs)

We’ll want some structure to our folds as well:

cfoldl (F op e `zip` F op' e') bs
  == (cfoldl (F op e) bs, cfoldl (F op' e') bs)

Simplify the LHS:

cfoldl (F op e `zip` F op' e') bs

  == {- Fold zip def -}

cfoldl (F op'' (e,e')) bs
  where (a,a') `op''` b = (a `op` b, a' `op'` b)

  == {- cfoldl def -}

foldl op'' (e,e') bs
  where (a,a') `op''` b = (a `op` b, a' `op'` b)

Then simplify the RHS:

(cfoldl (F op e) bs, cfoldl (F op' e') bs)

  == {- cfoldl def -}

(foldl op e bs, foldl op' e' bs)

So the morphism law becomes

foldl op'' (e,e') bs == (foldl op e bs, foldl op' e' bs)
  where
    (a,a') `op''` b = (a `op` b, a' `op'` b)

We’ll prove this form inductively in the list bs, using the definition of foldl:

foldl :: (a -> b -> a) -> a -> [b] -> a
foldl op a []     = a
foldl op a (b:bs) = foldl op (a `op` b) bs

First, empty lists.

foldl op'' (e,e') [] where op'' = ...

  == {- foldl def  -}

(e,e')

  == {- foldl def, twice -}

(foldl op e [], foldl op' e' [])

Next, non-empty lists.

foldl op'' (e,e') (b:bs) where op'' = ...

  == {- foldl def -}

foldl op'' ((e,e') `op''` b) bs where op'' = ...

  == {- op'' definition -}

foldl op'' (e `op` b, e' `op'` b) bs where op'' = ...

  == {- induction hypothesis -}

(foldl op (e `op` b) bs, foldl op' (e' `op'` b) bs)

  == {- foldl def, twice -}

(foldl op e (b:bs), foldl op' e' (b:bs))

Strict

The morphism law:

cfoldl' (f `zip'` f') == cfoldl' f `zip'` cfoldl' f'

which simplifies to

foldl' op'' (P e e') bs == P (foldl' op e bs) (foldl' op' e' bs)
  where
    P a a' `op''` b = P (a `op` b) (a' `op'` b)

This property can be proved similarly to the non-strict version. The new aspect is manipulating the use of seq.

Again, use induction on lists, guided by the fold definition:

foldl' :: (a -> b -> a) -> a -> [b] -> a
foldl' op a []     = a
foldl' op a (b:bs) =
  let a' = a `op` b in a' `seq` foldl' f a' bs

First, empty lists.

foldl op'' (P e e') [] where op'' = ...

  == {- foldl def  -}

P e e'

  == {- foldl def, twice -}

P (foldl op e []) (foldl op' e' [])

Next, non-empty lists. For simplicity, I’ll inline the let in the definition of foldl' (which affects performance but not meaning):

foldl' op'' (P e e') (b:bs) where op'' = ...

  == {- foldl' def -}

((P e e') `op''` b) `seq`
foldl' op'' ((P e e') `op''` b) bs where op'' = ...

  == {- op'' definition -}

P (e `op` b) (e' `op'` b) `seq`
foldl' op'' (P (e `op` b) (e' `op'` b)) bs

  == {- induction hypothesis -}

P (e `op` b) (e' `op'` b) `seq`
P (foldl' op (e `op` b) bs) (foldl' op' (e' `op` b) bs)

  == {- P strictness -}

P (e `op` b) (e' `op'` b) `seq`
P ((e  `op` b) `seq` foldl' op  (e  `op` b) bs)
  ((e' `op` b) `seq` foldl' op' (e' `op` b) bs)

  == {- foldl' def, twice -}

P (foldl' op e (b:bs)) (foldl' op' e' (b:bs))

That’s it.

My previous post, Another lovely example of type class morphisms, placed some standard structure around Max Rabkin’s Beautiful folding, using type class morphisms to confirm that the Functor and Applicative instances agreed with their inevitable meanings.

In the process of working out the Applicative case, I realized the essence of fold zipping was getting a bit obscured. This post simplifies Max’s Fold data type a bit and shows how to zip strict left folds in the simpler setting. You can get the code described here.

Edits:

• 2008-11-15: I renamed the Pair and Pair' classes to Zip and Zip'.

A simpler fold

The strict left-folding functional is

foldl' :: (a -> b -> a) -> a -> [b] -> a

Max’s fold type packages up the first two arguments of foldl' and adds on an post-fold step, as needed for fmap:

data Fold b c = forall a. F (a -> b -> a) a (a -> c)  -- clever version

A simpler, less clever version just has the two foldl' arguments, and no forall:

data Fold b a = F (a -> b -> a) a  -- simple version

I’ll use this simpler version for zipping and later enhance it for fmap.

The strict interpretation of Fold simply unpacks and folds:

cfoldl' :: Fold b a -> [b] -> a
cfoldl' (F op e) = foldl' op e

Zipping is then just a simplification of the (<*>) definition in the previous post. As before, P is a type and constructor of strict pairs.

data P c c' = P !c !c'

zipF' :: Fold b a -> Fold b a' -> Fold b (P a a')
F op e `zipF'` F op' e' = F op'' (P e e')
 where
   P a a' `op''` b = P (a `op` b) (a' `op'` b)

We can also define non-strict counterparts:

cfoldl :: Fold b a -> [b] -> a
cfoldl (F op e) = foldl op e

zipF :: Fold b a -> Fold b a' -> Fold b (a,a')
F op e `zipF` F op' e' = F op'' (e,e')
 where
   (a,a') `op''` b = (a `op` b, a' `op'` b)

More type classes …

A previous post suggested a criterion for inevitability of interpretation functions like cfoldl and cfoldl'. Whatever class instances exists for the source type (Fold here), interpretation functions should be “type class morphisms” for those classes, which loosely means that the meaning of a method is the same method on the meaning.

Where’s the type class for our simplified Fold? It lacks the magic ingredient Max added to make it a Functor and an Applicative, namely the post-fold step.

However, there’s another class that’s just the thing:

class Zip f where zip :: f a -> f b -> f (a,b)

(I’ve used this class with type representations and user interfaces.)

The Zip class from TypeCompose is almost identical to the Zip class in category-extras. The latter class requires Functor, however, which is too restrictive for the simplified Fold type.

Our non-strict left folds have a Zip instance:

instance Zip (Fold b) where zip = zipF

For strict folds, define a strict variant on Zip:

class Zip' f where zip' :: f a -> f b -> f (P a b)

and a Zip' instance for Fold:

instance Zip' (Fold b) where zip' = zipF'

… and more morphisms

These zipping classes have associated morphism properties. A function q mapping from one Zip instance to another is a “Zip morphism” when

q (f `zip` g) == q f `zip` q g

for all folds f and g.

Similarly for Zip' morphisms:

q (f `zip'` g) == q f `zip'` q g

In other words, q distributes over zip or zip'.

As I’ll show in another post, the two interpretation functions cfoldl and cfoldl' are Zip and Zip' morphisms, respectively, i.e.,

cfoldl  (f `zip`  g) == cfoldl  f `zip`  cfoldl  g

cfoldl' (f `zip'` g) == cfoldl' f `zip'` cfoldl' g

which means that zip folding as defined above works correctly.

What’s next?

I like to keep blog posts fairly short, so I’ll share two more pieces of this story in upcoming blog posts:

• Regaining the lost Functor and Applicative instances.
• The Zip and Zip' morphism proofs for zip folding.

I read Max Rabkin’s recent post Beautiful folding with great excitement. He shows how to make combine multiple folds over the same list into a single pass, which can then drastically reduce memory requirements of a lazy functional program. Max’s trick is giving folds a data representation and a way to combine representations that corresponds to combining the folds.

Peeking out from behind Max’s definitions is a lovely pattern I’ve been noticing more and more over the last couple of years, namely type class morphisms.

Folds as data

Max gives a data representation of folds and adds on an post-fold step, which makes them composable.

data Fold b c = forall a. F (a -> b -> a) a (a -> c)

The components of a Fold are a (strict left) fold’s combiner function and initial value, plus a post-fold step. This interpretation is done by a function cfoldl', which turns these data folds into function folds:

cfoldl' :: Fold b c -> [b] -> c
cfoldl' (F op e k) = k . foldl' op e

where foldl' is the standard strict, left-fold functional:

foldl' :: (a -> b -> a) -> a -> [b] -> a
foldl' op a []     = a
foldl' op a (b:bs) =
  let a' = a `op` b in a' `seq` foldl' f a' bs

Standard classes

As Twan van Laarhoven pointed out in a comment on Max’s post, Fold b is a functor and an applicative functor, so some of Max’s Fold-manipulating functions can be replaced by standard vocabulary.

The Functor instance is pretty simple:

instance Functor (Fold b) where
  fmap h (F op e k) = F op e (h . k)

The Applicative instance is a bit trickier. For strictness, Max used used a type of strict pairs:

data Pair c c' = P !c !c'

The instance:

instance Applicative (Fold b) where
  pure a = F (error "no op") (error "no e") (const a)

  F op e k <*> F op' e' k' = F op'' e'' k''
   where
     P a a' `op''` b = P (a `op` b) (a' `op'` b)
     e''             = P e e'
     k'' (P a a')    = (k a) (k' a')

Given that Fold b is an applicative functor, Max’s bothWith function is then liftA2. Max’s multi-cfoldl' rule then becomes:

forall c f g xs.
   h (cfoldl' f xs) (cfoldl' g xs) == cfoldl' (liftA2 h f g) xs

thus replacing two passes with one pass.

Beautiful properties

Now here’s the fun part. Looking at the Applicative instance for ((->) a), the rule above is equivalent to

forall c f g.
  liftA2 h (cfoldl' f) (cfoldl' g) == cfoldl' (liftA2 h f g)

Flipped around, this rule says that liftA2 distributes over cfoldl'. Or, “the meaning of liftA2 is liftA2“. Neat, huh?

Moreover, this liftA2 property is equivalent to the following:

forall f g.
  cfoldl' f <*> cfoldl' g == cfoldl' (f <*> g)

This form is one of the two Applicative morphism laws (which I usually write in the reverse direction):

For more about these morphisms, see Simplifying semantics with type class morphisms. That post suggests that semantic functions in particular ought to be type class morphisms (and if not, then you’d have an abstraction leak). And cfoldl' is a semantic function, in that it gives meaning to a Fold.

The other type class morphisms in this case are

cfoldl' (pure a  ) == pure a

cfoldl' (fmap h f) == fmap h (cfoldl' f)

Given the Functor and Applicative instances of ((->) a), these two properties are equivalent to

cfoldl' (pure a  ) == const a

cfoldl' (fmap h f) == h . cfoldl' f

or

cfoldl' (pure a  ) xs == a

cfoldl' (fmap h f) xs == h (cfoldl' f xs)

Rewrite rules

Max pointed out that GHC does not handle his original multi-cfoldl' rule. The reason is that the head of the LHS (left-hand side) is a variable. However, the type class morphism laws have constant (known) functions at the head, so I expect they could usefully act as fusion rewrite rules.

Inevitable instances

Given the implementations (instances) of Functor and Applicative for Fold, I’d like to verify that the morphism laws for cfoldl' (above) hold.

Functor

Start with fmap. The morphism law:

cfoldl' (fmap h f) == fmap h (cfoldl' f)

First, give the Fold argument more structure, so that (without loss of generality) the law becomes

cfoldl' (fmap h (F op e k)) == fmap h (cfoldl' (F op e k))

The game is to work backward from this law to the definition of fmap for Fold. I’ll do so by massaging the RHS (right-hand side) into the form cfoldl' (...), where “...” is the definition fmap h (F op e k).

fmap h (cfoldl' (F op e k))

  ==  {- inline cfoldl' -}

fmap h (k . foldl' op e)

  ==  {- inline fmap on functions -}

h . (k . foldl' op e)

  ==  {- associativity of (.) -}

(h . k) . foldl' op e

  ==  {- uninline cfoldl' -}

cfoldl' (F op e (h . k))

  ==  {- uninline fmap on Fold  -}

cfoldl' (fmap h (F op e k))

This proof show why Max had to add the post-fold function k to his Fold type. If k weren’t there, we couldn’t have buried the h in it.

More usefully, this proof suggests how we could have discovered the fmap definition. For instance, we might have tried with a simpler and more obvious Fold representation:

data FoldS a b = FS (a -> b -> a) a

Getting into the fmap derivation, we’d come to

h . foldsl' op e

and then we’d be stuck. But not really, because the awkward extra bit (h .) beckons us to generalize by adding Max’s post-fold function.

Applicative

Next pure:

cfoldl' (pure a) == pure a

Reason as before, starting with the RHS

pure a

  ==  {- inline pure on functions -}

const a

  ==  {- property of const -}

const a . foldl op e

  ==  {- uninline cfoldl' -}

cfoldl' (F (const a) op e)

The imaginative step was inventing structure to match the definition of cfoldl'. This definition is true for any values of op and e, so we can use bottom in the definition:

instance Applicative (Fold b) where
  pure a = F undefined undefined (const a)

As Twan noticed, the existential (forall) also lets us pick defined values for op and e. He chose (_ _ -> ()) and ().

The derivation of (<*>) is trickier and is the heart of the problem of fusing folds to reduce multiple traversals to a single one. Why the heart? Because (<*>) is all about combining two things into one.

Intermission

I’m taking a break here. While fiddling with a proof of the (<*>) morphism law, I realized a simpler way to structure these folds, which will be the topic of an upcoming post.