$fib\; 0\; =\; 0$
fib 1 = 1
fib (n+2) = fib (n+1) + fib n

I would like the students to see the derivation as an instance of tupling: to generalise the targeted function by having it return more results, hoping that the generalisation can actually be performed faster. For this problem, one may consider the generalisation:

$fib2\; n\; =\; (fib\; n,\; fib\; (n+1))$

from which we may easily construct a recursive definition for fib2 by simply unfolding and folding the definitions. Once we finish, take fib = fst . fib2.

Tupling and Fold Fusion

As a practice, however, I instructed the students to see this as an instance of fold fusion with the fold on natural numbers:

$foldN\; f\; e\; 0\; =\; e$
foldN f e (n+1) = f (foldN f e n)

The derivation goes like

$\; fib2$
=    { since id = foldN (1+) 0 }
    fib2 . foldN (1+) 0
=    { fold fusion, see below }
    foldN step (0,1)

To derive step through the fusion condition, we reason:

$\; fib2\; (n+1)$
=    { def. of fib2 }
    (fib (n+1), fib (n+2))
=    { def. of fib }
    (fib (n+1), fib (n+1) + fib n)
=    { let step (x,y) = (y,x+y) }
    step (fib n, fib (n+1))
=    { def. of fib2 }
    step (fib2 n)

Therefore, we have fib2 = foldN step (0,1) where step (x,y) = (y,x+y).

Oleg Kiselyov also used a similar definition of fib as a fold (on a list of length n) as an example in his library of fold transformers.

Accumulating Parameters

I was perhaps so happy with seeing fib as a fold-fusion that I forgot one may want a tail recursive definition. This is one of the exercises of the functional programming course (taught by Kung Chen) this year, where the students may just write down the (obvious) tail recursive, linear-time function computing Fibonacci. The hint was to “introduce two accumulating parameters.” Can I derive this definition?

When I taught the students about accumulating parameters, I also told them to “look for some generalisation by adding more parameters.” The canonical example is perhaps generalising quadratic time reverse to fastrev xs ys = reverse xs ++ ys. For fib, it appeared reasonable to generalise the base cases. I was later told by Oleg that this function is called gib:

$gib\; 0\; x\; y\; =\; x$
gib 1 x y = y
gib (n+2) x y = gib (n+1) x y + gib n x y

From this definition, however, a linear-time implementation of gib does not follow immediately. We will need this lemma:

$gib\; n\; (fib\; k)\; (fib\; (k+1))\; =\; fib\; (n+k)$(1)

which can be proved by induction on n. For an intuitive understanding, it says that gib allows us to compute Fibonacci not only from the base cases 0 and 1, but also from the middle: if we take fib k and fib (k+1) as base cases, we get fib (n+k).

The property (1) came from some slides Kung Chen showed me, originated from John Hughes. John Hughes actually suggested to start with (1) as the specification. Either way, I wonder how one could come up with (1) in the first place. Given the definition of gib, (1) can be proved by induction. The rest of the derivation is not too hard. This is the derived program. Details omitted.

$gib\; 0\; x\; y\; =\; x$
gib (n+1) x y = gib n y (x+y)

Tail-Recursive Fibonacci

Meanwhile, Josh Ko gave me this generalisation:

$ffib\; n\; x\; y\; =\; x\; \times \; fib\; n\; +\; y\; \times \; fib\; (n+1)$

The motivation came from, perhaps, the observation that every fib n can always be expressed as an linear combination of some smaller fib i and fib j:

$fib\; 2\; =\; fib\; 1\; +\; fib\; 0$
fib 3 = fib 2 + fib 1 = 2 × fib 1 + fib 0
fib 4 = fib 3 + fib 2 = 2 × fib 2 + fib 1 = 3 × fib1 + 2 × fib 0
:

Given the definition, it is immediate that ffib 0 x y = y and:

$ffib\; (n+1)\; x\; y$
= x × fib (n+1) + y × fib (n+2)
= x × fib (n+1) + y × fib (n+1) + y × fib n
= (x+y) × fib (n+1) + y × fib n
= ffib n y (x+y)

Therefore we have derived:

$ffib\; 0\; x\; y\; =\; y$
ffib (n+1) x y = ffib n y (x+y)

which is more or less what one would expect. It differs from the derived linear-time implementation of gib only on the base case.

Finally, since gib and ffib define similar functions, ffib satisfies a property similar to (1):

$ffib\; n\; (fib\; k)\; (fib\; (k+1))\; =\; fib\; (n+k+1)$(2)

The proof proceeds by induction on n. The base case is trivial. For the inductive case:

$\; ffib\; (n+1)\; (fib\; k)\; (fib\; (k+1))$
= fib k × fib (n+1) + fib (k+1) ×fib (n+2)
= fib k × fib (n+1) + fib (k+1) × fib (n+1) + fib (k+1) × fib n
= (fib k + fib (k+1)) × fib (n+1) + fib (k+1) × fib n
= ffib n (fib (k+1)) (fib (k+2))
=   { induction }
   fib (n+k+2)

thus completes the proof.

Dependent type theory is rich enough to express that a program satisfies an input/output relational specification, but it could be hard to construct the proof term. On the other hand, squiggolists know very well how to show that one relation is included in another by algebraic reasoning. We demonstrate how to encode functional and relational derivations in a dependently typed programming language. A program is coupled with an algebraic derivation from a specification, whose correctness is guaranteed by the type system.

Code accompanying the paper has been developed into an Agda library AoPA.

This paper presents an application of bidirectional transformations to design and implementation of a novel editor supporting interactive refinement in the development of structured documents. The user performs a sequence of editing operations on the document view, and the editor automatically derives an efficient and reliable document source and a transformation that produces the document view. The editor is unique in its programmability, in the sense that transformation can be obtained through editing operations. The main tricks behind are the utilization of the view-updating technique developed in the database community, and a new bidirectional transformation language that can describe not only relationship between the document source and its view, but also data dependency in the view.

The actual property he needs is that FT . C ⊆ C . FT . C where C is a coreflexive, given T ⊆ ⦇S⦈ and F⦇S⦈ . C ⊆ C . F⦇S⦈ . C. It is sufficient to prove this generalised property:

$S\; \subseteq \; C\; .\; S\; \; \Leftarrow \; \; R\; \subseteq \; C\; .\; R\; \; \wedge \; \; S\; \subseteq \; R$

Intuitively speaking, if C covers the range of R and S ⊆ R, then C covers the range of S too.

Well, the proof goes:

$\; C\; .\; S$
= { since C . C = C }
    C . C . S
⊇ { since X ⊇ X ∩ Y }
     C . ((C . S) ∩ R)
⊇ { modular law X ∩ (Y.Z) ⊆ Y . ((Y˘.X) ∩ Z), and C˘ = C }
     S ∩ (C . R)
⊇ { given: R ⊆ C . R }
     S ∩ R
= { given: S ⊆ R }
     S

It is hard to explain the intuition behind the use of modular law. If we take C as a predicate, the property can be written pointwisely as:

$(b\; S\; a\; \Rightarrow \; C\; b\; \wedge \; b\; S\; a)\; \; \Leftarrow \; \; (b\; R\; a\; \Rightarrow \; C\; b\; \wedge \; b\; R\; a)\; \; \wedge \; \; b\; S\; a\; \Rightarrow \; b\; R\; a$

where a and b are both universally quantified. We may simplify b S a ⇒ C b ∧ b S a to b S a ⇒ C b, but that makes it more difficult to see the connection. Essentially, I was mimicking the following obvious proof:

$\; C\; b\; \wedge \; b\; S\; a$
⇐ { strengthening }
    C b ∧ b S a ∧ b R a
⇐ { since b R a ⇒ C b ∧ b R a }
    b S a ∧ b R a
⇐ { since b S a ⇒ b R a }
     b S a

The strengthening step corresponds to the use of X ⊇ X ∩ Y, while the next two steps respectively correspond to the last two steps of the point-free proof. The modular law, implicit in the pointwise proof, was used to group C and R to the right places.

It is generally accepted that a relation _<_ is well-founded if, for all x, there is no infinite chain x > x₁ > x₂ > x₃ > …. . A related concept is inducvitity. We say that a relation admits induction of we can use it to perform induction. For example, the less-than ordering on natural number is inductive.

Most of the type theoretical paper I have seen equate well-foundedness to the concept of accessibilty, which I talked about in a previous post. For example, Bengt Nordström [Nor88] introduced the datatype Acc as a “constructively more useful description” of well-foundedness.

Doornbos and Backhouse generalised well-foundedness and other related notions to an arbitrary F-algebra. Well-foundedness, however, was generalised to “having a unique solution.” A relation R : FA ← A is F-well-founded if there is a unique solution for X = S . FX . R.

Reductivity

Inductivity, on the other hand, is generalised to F-reductivity. While F-reductivity is a generalisation of strong induction, Doornbos and Backhouse called it reductivity “in order to avoid confusion with existing notions of inductivity.” [DB95] (Nevertheless, an equivalent concept in Algebra of Programming modelled using membership relation rather than monotype factors, calls itself “inductivity”. Different usage of similar terminology can be rather confusing sometimes.)

A relation R : FA ← A is F-reductive if

$\mu (\lambda P\; .\; R⧷$FP) = id

where ⧷ is the monotype factor defined by ran(R . A) ⊆ B ≡ A ⊆ R⧷B. The function λP . R⧷FP takes coreflexive (a relation that is a subset if id) P to coreflexive R⧷FP, and μ takes its least fixed-point.

Well, it is a definition that is very concise but also very hard to understand, unless you are one of the few who really like these sort of things. If we take P to be a predicate, R\FP expands to a predicate on x that is true if

$\forall y\; .\; y\; R\; x\; \Rightarrow$FP y

Taking the fixed point means to look for the minimum P such that

$\forall x\; .\; (\forall y\; .\; y\; R\; x\; \Rightarrow$FP y) ⇒ P x

The expression now resembles strong induction we all know very well. Computationally, how do we take the fixed point? Of course, by defining a recursive datatype:

data Acc {a : Set}(R : a -> a -> Set) : a -> Set where
  acc : (x : a) -> (forall y -> y < x -> f (Acc R) y) -> Acc R x

where f : (a -> Set) -> (F a -> Set) is the arrow-operation of functor F. When we take F to be the identity functor, it is exactly the definition of accessibility in my previous post! Finally, the requirement that μ(λP . R⧷FP) = id means every element in a is accessible.

So, it seems that reductivity of Doornbos and Backhouse is in fact accessibility, which is often taken by type theorists to be an alternative definition of well-foundedness. Doornbos and Backhouse, however, showed that reductivity guarantees uniqueness solution of hylo equations (which is their definition of F-well-foundedness). The converse, however, is not true in general.

New Reductive Relations from Old

Doornbos and Backhouse also developed some principles to build new reductive relations from existing ones. Let us try to see their Agda counterparts. For simplicity, we take F to be the identity functor in the discussion below.

All initial algebras are reductive. For example, given Pred relating n and suc n, one can show that Pred is reductive.

data Pred : ℕ -> ℕ -> Set where
  pre : (n : ℕ) -> Pred n (suc n)

ℕPred-wf : well-found Pred
ℕPred-wf n = acc n (access n)
  where
    access : (n : ℕ) -> (m : ℕ) -> Pred m n -> Acc Pred m
    access .(suc n) .n (pre n) = acc n (access n)

We have seen in the previous post that the less-than relation is reductive.

If R is reductive and S ⊆ R, then S is reductive too:

acc-⊑ : {a : Set}{S R : a -> a -> Set} ->
      S ⊑ R-> (x : a) -> Acc R x -> Acc S x
acc-⊑ {a}{S} S⊑R x (acc .x h) = acc x access
  where
    access : (y : a) -> (y S x) -> Acc S y
    access y y≪x = acc-⊑ S⊑R y (h y (S⊑R y x ySx))

If f . R . f˘ is reductive for some function f, so is R. This is how we often prove termination of loops using f as the variant.

acc-fRf˘ : {a b : Set}{R : a -> a -> Set}{f : a -> b} ->
    (x : a) -> Acc (fun f ○ R ○ ((fun f) ˘)) (f x) -> Acc R x
acc-fRf˘ {a}{b}{R}{f} x (acc ._ h) = acc x access
  where
    access : (y : a) -> R y x -> Acc R y
    access y xRy = acc-fRf˘ y
      (h (f y) (exists x (exists y (≡-refl , xRy) , ≡-refl)))

where the operators for relational composition (_○_) and converse (_˘) is that defined in AoPA.

Finally, for the special case where F is the identity functor, R is reductive if and only if its transitive closure R⁺ is. Let us first define transitive closure:

data _⁺ {a : Set}(R : a -> a -> Set) : a -> a -> Set where
  ⁺-base : forall {x y} -> R x y -> (R ⁺) x y
  ⁺-step : forall {x z} -> ∃ a (\y -> R y z × (R ⁺) x y) -> (R ⁺) x z

The “if” direction is easy. Let us prove the “only-if” direction.

acc-tc : {a : Set}{R : a -> a -> Set} ->
    (x : a) -> Acc R x -> Acc (R ⁺) x
acc-tc {a}{R} x ac = acc x (access x ac)
  where
    access : (x : a) -> Acc R x ->
        (y : a) -> (R ⁺) y x -> Acc (R ⁺) y
    access x (acc .x h) y (⁺-base yRx) = acc-tc y (h y yRx)
    access x (acc .x h) y (⁺-step (exists z (zRx , yR⁺z))) =
      access z (h z zRx) y yR⁺z

Combined with the proof that Pred is reductive, we have another way to show that the less-than relation is reductive. One may compare it with the proof of well-found _<′_ in the previous post.

References

[DB95] Henk Doornbos and Roland Backhouse. Induction and recursion on datatypes. B. Moller, editor, Mathematics of Program Construction, 3rd Internatinal Conference, volume 947 of LNCS, pages 242-256. Springer-Verslag, July 1995.

[DB96] Henk Doornbos and Roland Backhouse. Reductivity. Science of Computer Programming, 26, pp. 217–236, 1996.

[Nor88] Bengt Nordström. Terminating general recursion. BIT archive, Volume 28, Issue 3, pp 605-619. 1988.

In dependently typed programming, we would like to ensure that proof terms are terminating. Apart from the type checker, Agda employs a separate termination checker. How it exactly works is still at times mysterious to me, but basically it recognises a program as terminating if some of its arguments become “structurally” smaller after each recursive call. This is already far more expressive than I thought — quite a number of programs can be written by structural recursion. Still, we occasionally need some more flexibility. One of such occasion was when I wished to express terminating unfolds in AoPA. For another example, consider this function mentioned in the paper Terminating General Recursion by Bengt Nordström:

$f\; (n,\; k)\; =\; if\; k\; \le \; n\; then\; n\; else\; f(f\; (n\; +\; 1,\; k),\; k)$

It is a variation of McCarthy’s 91 function, used as a popular example due to its non-trivial recursion pattern. Can we express this function in Agda while informing the termination checker that it does terminate?

Given a relation < that has been shown to be well-founded, we know that a recursively defined function is terminating if its arguments becomes “smaller” with respect to < at each recursive call. We can encode such well-founded recursion in Agda’s style of structural recusion. The earliest paper I could find about such encoding is Terminating General Recursion by Bengt Nordström. It may have appeared in other forms, however.

Accessibility

Given a binary relation _<_ : a -> a -> Set, an element x is in the well-founded subset of < if there is no infinite chain of x₁, x₂, x₃ ... such that x > x₁ > x₂ > x₃ > .... The relation is well-founded if all elements of a are in its well-founded subset. The less-than ordering on natural number is well-founded, while the greater-than ordering is not. A more constructive way to talk about well-foundedness is via accessibility. Given a relation _<_ : a -> a -> Set, the proposition Acc _<_ x states that x is accessible under relation <. An element x : a is accessible if all y : a “smaller” than x are accessible:

data Acc {a : Set}(_<_ : a -> a -> Set) : a -> Set where
  acc : (x : a) -> (forall y -> y < x -> Acc _<_ y) -> Acc _<_ x

A relation _<_ : a -> a -> Set is well-founded if all elements in a are accessible:

well-found : {a : Set} -> (a -> a -> Set) -> Set
well-found _<_ = forall x -> Acc _<_ x

For an example, consider the less-than-or-equal-to ordering on natural numbers. It is usually modelled by a datatype stating that 0 ≤ n for all n and that 1+m ≤ 1+n follows from m ≤ n. The strictly-less-than ordering is defined by m < n = 1+m ≤ n. For well-foundedness proofs, however, the following definitions turn out to be more convenient:

data _≤′_ : ℕ -> ℕ -> Set where
  ≤′-refl : forall {n} -> n ≤′ n
  ≤′-step : forall {m n} -> m ≤′ n -> m ≤′ suc n

_<′_ : ℕ -> ℕ -> Set
m <′ n = suc m ≤′ n


Let’s prove that <′ is well-founded:

ℕ<-wf : well-found _<′_
ℕ<-wf n = acc n (access n)
  where
    access : (n : ℕ) -> (m : ℕ) -> m <′ n -> Acc _<′_ m
    access zero m ()
    access (suc n) .n ≤′-refl = acc n (access n)
    access (suc n) m (≤′-step m<n) = access n m m<n

An operational intuition for access: knowing that m <′ n, access demonstrates that it is possible to reach m from n in a finite number of steps.

Well-Founded Recursion

As an inductively defined datatype, Acc naturally induces a fold operator:

acc-fold : {a : Set} (_<_ : a -> a -> Set) {P : a -> Set} ->
  ((x : a) -> (forall y -> y < x -> P y) -> P x) ->
    (z : a) -> Acc _<_ z -> P z
acc-fold _<_ Φ z (acc .z h) =
  Φ z (\y y<z -> acc-fold _<_ Φ y (h y y<z))

Its type says that if we can provide a function Φ that proves some property P x for all x provided that P y has been proved for all y < x, then P holds for all accessible elements in a. Recall strong induction.

When < is well-founded, all elements are accessible. Therefore we can define:

rec-wf : {a : Set} {_<_ : a -> a -> Set} {P : a -> Set} ->
  well-found _<_ ->
    ((x : a) -> ((y : a) -> y < x -> P y) -> P x) ->
      (x : a) -> P x
rec-wf {a}{_<_} wf f x = acc-fold _<_ f x (wf x)

For an example, consider the function half : ℕ -> ℕ which divides a natural number by two. It can be defined by structural recursion:

half : ℕ -> ℕ
half zero = zero
half (suc zero) = zer0
half (suc (suc n)) = suc (half n)

But if we define half by well-founded recursion anyway, it looks like:

half : ℕ -> ℕ
half = rec-wf ℕ<-wf body
  where
    body : (n : ℕ) -> ((m : ℕ) -> m <′ n -> ℕ) -> ℕ
    body zero rec = zero
    body (suc zero) rec = zero
    body (suc (suc n)) rec = suc (rec n (≤′-step ≤′-refl))

Notice how rec-wf ℕ<-wf behaves like a fixed-point operator taking the “fixed-point” of body. The recursive call is replaced by a function rec, having type (m : ℕ) -> m <′ n -> ℕ. To call rec, the programmer has to provide a proof that the argument is indeed getting smaller with respect to the relation _<_.

Upper-Bounded Reverse Ordering

As a practice, let us consider another ordering. For a given natural number k, define n ◁ m = m < n ≤ k. That is, for m and n upper-bounded by k, the one closer to k is considered smaller. Apparently ◁ is well-founded. I tried to encode it in Agda by:

_<_≤_ : ℕ -> ℕ -> ℕ -> Set
m < n ≤ k = (m <′ n) × (n ≤′ k)

◁ : ℕ -> ℕ -> ℕ -> Set
(◁ k) m n = n < m ≤ k

However, the accessibility proof became very difficult to construct. I ended up defining yet another variation of the less-than-or-equal-to ordering:

data _≤′′_ : ℕ -> ℕ -> Set where
  ≤′′-refl : forall {n} -> n ≤′′ n
  ≤′′-step : forall {m n} -> suc m ≤′′ n -> m ≤′′ n

and defined m < n ≤ k = (m <′′ n) × (n ≤′′ k).

A number of properties can be proved about ≤′:

m≤n⇒m≤1+n : forall {m n} -> m ≤′′ n -> m ≤′′ (suc n)
m<n⇒¬n≤m : forall {m n} -> m <′′ n -> ¬ (n ≤′′ m)
¬[m<n∧n≤m] : forall {m n} -> ¬ (m <′′ n × n ≤′′ m)
≤′′-trans : forall {m n k} -> m ≤′′ n -> n ≤′′ k -> m ≤′′ k
≤′′-antisym : forall {m n} -> m ≤′′ n -> n ≤′′ m -> m ≡ n

Some of the properties above depends on the following:

¬1+n≤n : forall {n} -> ¬ (suc n ≤′′ n)

which I have not yet proved.

Now let us show that ◁ k is well-founded.

ℕ◁-wf : forall k -> well-found (◁ k)
ℕ◁-wf k m = acc m access
  where
   access : forall n -> (m < n ≤ k) -> Acc (◁ k) n
   access n (m<n , n≤k) =
    ◁-access k m n (≤′′-trans m<n n≤k) (m<n , n≤k)

The function ◁-access needs, apart from proofs of m < n and n ≤ k, a proof of m < k, which can be established by transitivity of ≤′. The definition is shown below:

◁-access : forall k m n ->
    (m <′′ k) -> (m < n ≤ k) -> Acc (◁ k) n
◁-access .(suc m) m .(suc m) ≤′′-refl (≤′′-refl , 1+m≤1+m) =
  acc (suc m)
    (\y 1+m<y∧y≤1+m -> ⊥-elim (¬[m<n∧n≤m] 1+m<y∧y≤1+m))
◁-access k m .(suc m) (≤′′-step 1+m<k) (≤′′-refl , 1+m≤k) =
  acc (suc m) (\y -> ◁-access k (suc m) y 1+m<k)
◁-access .(suc m) m n ≤′′-refl (≤′′-step 1+m<n , n≤1+m) =
  acc n (⊥-elim (m<n⇒¬n≤m 1+m<n n≤1+m))
◁-access k m n (≤′′-step 1+m<k) (≤′′-step 1+m<n , n≤k) =
  ◁-access k (suc m) n 1+m<k (1+m<n , n≤k)

It is perhaps quite hard to understand unless you try to construct it yourself. The reader only needs to notice that in the two recursive calls to ◁-access (in the second and the last clause), the argument m is incremented to suc m. That is why we need to include a proof term of m <′′ k as an argument, which becomes structurally smaller in the recursive calls. This is how we inform the termination checker that, although m increases, the distance between m and k shrinks. The proof of n ≤ k, on the other hand, is used to establish the contradictions in the first and the third clause.

A Variation of McCarthy’s 91 Function

Back to the function f mentioned in the beginning, whose native Agda translation:

f k n with k ≤? n
... | yes _ = n
... | no _ = f k (f k (suc n))

certainly does not pass the termination check.

In fact, the second argument (n) to f becomes smaller with respect to ◁ k. This is obvious for the inner recursive call (f k (suc n)) since k ≰ n implies n < 1 + n ≤ k. To prove the termination of the outer recursive call, we have to show that f k n actually computes the maximum of k and n. Since k ≰ n, we have f k (suc n) = k. Therefore, f k (suc n) is smaller than n with respect to ◁ k.

To prove the termination of f we have to prove something about its result. One of the possible ways to do so is to define:

P : ℕ -> ℕ -> Set
P k n = ∃ ℕ (\fn -> n ≤′′ k -> fn ≡ k)

and extend the type of f to:

f : (k : ℕ) -> (n : ℕ) -> P k n

Now that f returns an existential type, we have to pattern math its result. A definition of f may look like:

f k = rec-wf (ℕ◁-wf k) body
 where
  body : (i : ℕ) -> ((j : ℕ) -> i < j ≤ k -> P k j) -> P k i
  body n rec with (k ≤′′? n)
  … | inj₁ k≤n = exists n (\n≤k -> ≤′′-antisym n≤k k≤n)
  … | inj₂ n<k with rec (1 + n) (≤′′-refl , n<k)
  …  | exists m 1+n≤k⇒m≡k with rec m (n<m , m≤k)
  …    | exists h m≤k⇒h≡k = exists h (\_ -> h≡k)
   where
    m≡k = 1+n≤k⇒m≡k n<k
    n<m = ≡-subst (\i -> n <′′ i) (≡-sym m≡k) n<k
    m≤k = ≡-subst (\i -> m ≤′′ i) m≡k ≤′′-ref
    h≡k = m≤k⇒h≡k m≤k

However, Agda’s scoping rule with the presence of both with and where still confuses me. Eventually I had to inline the subordinate proofs, which gives me:

f : (k : ℕ) -> (n : ℕ) -> P k n
f k = rec-wf (ℕ◁-wf k) body
 where
  body : (i : ℕ) -> ((j : ℕ) -> i < j ≤ k -> P k j) -> P k i
  body n rec with (k ≤′′? n)
  … | inj₁ k≤n = exists n (\n≤k -> ≤′′-antisym n≤k k≤n)
  … | inj₂ n<k with rec (1 + n) (≤′′-refl , n<k)
  …  | exists m 1+n≤k⇒m≡k with 1+n≤k⇒m≡k n<k
  …   | m≡k with rec m (≡-subst (\i -> n <′′ i) (≡-sym m≡k) n<k ,
        ≡-subst (\i -> m ≤′′ i) m≡k ≤′′-refl)
  …    | exists h m≤k⇒h≡k =
          exists h (\_ -> m≤k⇒h≡k (≡-subst (\i -> m ≤′′ i) m≡k ≤′′-refl))

Unfortunately it looks quite remote from the original f. Nevertheless, it does pass the termination checker of Agda.

unfoldr↓ : {a : Set}(b : ℕ -> Set){n : ℕ} ->
    (f : forall {i} -> b (suc i) -> ⊤ ⊎ (a × b i)) ->
      b n -> [ a ]
unfoldr↓ b {zero} f y = []
unfoldr↓ b {suc i} f y with f y
… | inj₁ _ = []
… | inj₂ (x , y’) = unfoldr↓ b {i} f y’

The definition passes the termination check, apparently, because unfoldr↓ is defined inductively on n.

To generate a descending a list, one may invent a datatype Wrap that wraps the seed, whose bound is simply the seed itself:

data Wrap : ℕ -> Set where
      W : (n : ℕ) -> Wrap n

The list may then be generated by an unfold:

dec : forall {i} -> Wrap (suc i) -> ⊤ ⊎ (ℕ × Wrap i)
dec {i} (W .(suc i)) = inj₂ (i , W i)

down↓ : ℕ -> [ ℕ ]
down↓ n = unfoldr↓ Wrap dec (W n)


Of course, this would defeat my original goal of reusing the non-dependently typed dec, which is probably a bad idea anyway.

To show that the bound need not be exact, let’s try to generate a descending list whose elements are decremented by 2 in each step. We may use this slightly generalised wrapper:

data Wrap2 : ℕ -> Set where
      W2 : (x : ℕ) -> (bnd : ℕ) -> x ≤ bnd -> Wrap2 bnd

and a function dec2 that decrements a suc i-bounded seed by 2 but showing that the new seed is bounded by i:

dec2 : forall {i} -> Wrap2 (suc i) -> ⊤ ⊎ (ℕ × WAlt i)
dec2 {i} (W2 0 .(1 + i) _) = inj₁ tt
dec2 {i} (W2 1 .(1 + i) _) = inj₁ tt
dec2 {i} (W2 (suc (suc n)) .(1 + i) 2+n≤1+i) =
    inj₂ (n , W2 n i (suc-≤-weaken-l (≤-pred 2+n≤1+i)))


The list can then be unfolded by:

down↓2 : ℕ -> [ ℕ ]
down↓2 n = unfoldr↓ Wrap2 dec2 (W2 n n ≤-refl)

where suc-≤-weaken-l is a proof of forall {m n} -> suc m ≤ n -> m ≤ n.

Unfolding a Tree

It is an easy exercise to come up with a tree version of the unfold above:

unfoldT↓ : {a : Set}(b : ℕ -> Set){n : ℕ} ->
  (f : forall {i} -> b (suc i) -> a ⊎ (b i × b i)) ->
    B n -> Tree a
unfoldT↓ b {0} f y = Nul
unfoldT↓ b {suc i} f y with f y
... | inj₁ x = Tip x
... | inj₂ (y₁ , y₂) =
    Bin (unfoldT↓ b {i} f y₁) (unfoldT↓ b {i} f y₂)

To deal with the second task of building a roughly balanced binary tree, one may try this wrapper:

data Split (a : Set): ℕ -> Set where
  Sp : (xs : [ a ]) -> (bnd : ℕ) ->
    length xs < bnd -> Split a bnd

and try to code up a generator function split↓ having this type:

split↓ : forall {a i} -> Split a (suc i) -> a ⊎ (Split a i × Split a i)


The function split↓ I eventually come up with, however, is much more complicated than I had wished. Even worse, it is now split↓ that fails to pass the termination check.

Ulf Norell suggested some possible fixes. The difficulties, however, is probably a hint that there is something wrong in my approach in the first place. Rather than trying to fix it, Nils Anders showed me how he would tackle the problem from the beginning.

Using Well-Founded Recursion

Nils Anders showed me how to define unfoldT↓ using well-founded recursion. For a simplified explanation, the Standard Library provides a function <-rec having type (after normalisation):

<-rec : (P : ℕ -> Set) ->
  (f : (i : ℕ) -> (rec : (j : ℕ) -> j <′ i -> P j) -> P i) ->
    (x : ℕ) -> P x

With <-rec one can define functions on natural numbers by recursion, provided that the argument strictly decreases in each recursive call. P is the type of the result, parameterised by the input. The function f is a template that specifies the body of the recursion which, given i, computes some result of type P i. The functional argument rec is supposed to be the recursive call. The constraint j <′ i, however, guarantees that it accepts only inputs strictly smaller than i (the ordering <′ is a variation of < that is more suitable for this purpose). One may perhaps think of <-rec as a fixed-point operator computing the fixed-point of f, only that f has to take i before rec because the latter depends on the former.

Let us try to define an unfold on trees using <-rec. The “base-functor” of the datatype Tree⁺ a is F b = a ⊎ b × b. One of the lessons we have learnt is that it would be more convenient for the generating function to return the bound information. We could use a type like this:

F a b k = a ⊎ ∃ (ℕ × ℕ) (\(i , j) -> b i × b j × i <′ k × j <′ k)

But it is perhaps more reader-friendly to define the base functor as a datatype:

data Tree⁺F (a : Set) (b : ℕ -> Set) : ℕ -> Set where
  tip : forall {k} -> a -> Tree⁺F a b k
  bin : forall {i j k} ->
      b i -> b j -> i <′ k -> j <′ k -> Tree⁺F a b k


The generating function for the unfold should thus have type forall {a b i} -> b i -> Tree⁺F a b i.

The function unfoldT↓F is the template for unfoldT↓:

unfoldT↓F : {a : Set} {b : ℕ -> Set} ->
  (f : forall {i} -> b i -> Tree⁺F a b i) ->
   (n : ℕ) -> ((i : ℕ) -> i <′ n -> b i -> Tree⁺ a) ->
    b n -> Tree⁺ a
unfoldT↓F f n rec y with f y
… | tip a = Tip⁺ a
… | bin {i} {j} y₁ y₂ i<n j<n =
    Bin⁺ (rec i i<n y₁) (rec j j<n y₂)


Now unfoldT↓ can be defined by:

unfoldT↓ : {a : Set} {b : ℕ -> Set} ->
  (f : forall {i} -> b i -> Tree⁺F a b i) ->
    forall {n} -> b n -> Tree⁺ a
unfoldT↓ {a}{b} f {n} y =
    <-rec (\n -> b n -> Tree⁺ a) (unfoldT↓F f) n y

All the definition above makes no recursive calls. All the tricks getting us through the termination check are hidden in <-rec. How is it defined?

Well-Founded Recursion Defined on <′

Currently, well-founded recursion are defined in Induction and its sub-modules. They are very interesting modules to study. The definitions there, however, are very abstract. To understand how <-rec works, let’s try to implement our own.

This is the definition of <′ from Data.Nat:

data _≤′_ : Rel ℕ where
≤′-refl : forall {n} -> n ≤′ n
≤′-step : forall {m n} -> m ≤′ n -> m ≤′ suc n

_<′_ : Rel ℕ
m <′ n = suc m ≤′ n

Recall that the recursion template f has type forall i -> (forall j -> j <′ i -> P j) -> P i. That is, given i, f computes P i, provided that we know of a method to compute P j for all j <′ i. Let us try to construct such a method using f. The function guard f i computes f, provided that the input is strictly smaller than i:

guard : {P : ℕ -> Set} ->
   (forall i -> (forall j -> j <′ i -> P j) -> P i) ->
      forall i -> forall j -> j <′ i -> P j
guard f zero _ ()
guard f .(suc j) j ≤′-refl = f j (guard f j)
guard f (suc i) j (≤′-step j<i) = guard f i j j<i

Observe that guard terminates because it is defined inductively on i. If we discard the type information, all what guard f i j is to make a call to f j. Before doing so, however, it checks through the proof to make sure that j is strictly smaller than i. In f j (guard f j), the call to guard f j ensures that subsequent calls to f are given arguments smaller than j.

Now <-rec can be defined by:

<-rec : (P : ℕ -> Set) ->
   (forall i -> (forall j -> j <′ i -> P j) -> P i) ->
      forall n -> P n
<-rec P f n = f n (guard f n)

In Induction.Nat, <-rec is an instance of well-founded recursion defined using the concept of accessibility, defined in Induction.WellFounded. I find them very interesting modules about which I hope to understand more.

To be continued…

sort-der : ∃ ([ Val ] -> [ Val ]) (\f -> ordered? ○ permute ⊒ fun f )
sort-der = exists (
  ⊒-begin
      ordered? ○ permute
  ⊒⟨ (\vs -> ·-monotonic ordered? (permute-is-fold vs)) ⟩
      ordered? ○ foldR combine nil
  ⊒⟨ foldR-fusion ordered? ins-step ins-base ⟩
      foldR (fun (uncurry insert)) nil
  ⊒⟨ foldR-to-foldr insert [] ⟩
      fun (foldr insert [])
  ⊒∎)

isort : [ Val ] -> [ Val ]
isort = witness sort-der


The type of sort-der is a proposition that there exists a program of type [ Val ] → [ Val ] that is contained in ordered ? ◦ permute, a relation mapping a list to one of its ordered permutations. The combinator fun embeds a function in a relation. Relations on each line are related by relational inclusion (⊒), while the proof of inclusion are given in angle brackets. In the final step, the relation foldR (fun (uncurry insert)) nil is refined to a function using the rule:

foldR-to-foldr : {A B : Set} -> (f : A -> B -> B) -> (e : B) ->
    foldR (fun (uncurry f)) (singleton e) ⊒ fun (foldr f e)


which says that a relational fold is a functional fold if the algebra (f) is a function. When the proof is completed, an algorithm isort is obtained by extracting the witness of the proposition. It is an executable program that is backed by the type system to meet the specification.

One may wonder: why insertion sort, rather than something more interesting such as mergesort or quicksort? Because we have not yet figured out how to properly deal with hylomorphism yet. One of the things still missing in AoPA is a treatment of unfolds. AoPA attempts to model the category of sets and relations. In this context one can talk about unfolds because they are simply the converses of folds. We perform the derivations in terms of folds, and refine the converse of a relational fold to a functional unfold provided that the coalgebra is a function:

foldR˘-to-unfoldr : {A B : Set} -> (f : B -> ⊤ ⊎ (A × B)) ->
    (foldR ((fun f) ˘ ○ (fun inj₂)) (\b -> isInj₁ (f b))) ˘ ⊒ fun (unfoldr f)


where ˘ denotes relational converse and unfoldr is given by the usual definition (one that a Haskell programmer would expect, modulo syntax):

unfoldr : {A B : Set} -> (B -> ⊤ ⊎ (A × B)) -> B -> [ A ]
unfoldr f b with f b
… | inj₁ _ = []
… | inj₂ (a , b’) = a ∷ unfoldr f b’

The only problem is that this unfoldr cannot pass the termination check of Agda.

My first thought was to wait until Agda supports codata and coinduction. However, the reason I wanted an unfold in AoPA in the first place was to compose it with a fold to form a hylomorphism, which is not allowed if the unfold returns codata. I then attempted to model unfolds in a way similar to what we did in relational program derivation. We know that the recursive equation:

$R\; =\; S\; ○$FR ○ T
$$

has a unique solution R = ⦇S⦈ ○ ⦇T⦈˘ if and only if T is well-founded. In program derivation, the proof of well-foundedness is usually given separately. Therefore I hope to come up with a variation of unfoldr which, given a proof of well-foundedness, somehow passes the termination check.

During DTP 2008, I consulted a number of people and was suggested at least three solutions. I am going to summarise them in turn.

Canonical Examples

With each approach I would like to tackle two tasks. Given the following function dec:

dec : ℕ -> ⊤ ⊎ (ℕ × ℕ)
dec zero = inj₁ tt
dec (suc n) = inj₂ (n , n)

One may attempt to define a function down using unfoldr such that down n produces a list from n to 0. As mentioned above, unfoldr cannot pass the termination check. In fact, even the following definition fails the termination check:

down : ℕ -> [ ℕ ]
down n with dec n
… | inj₁ _ = []
… | inj₂ (a , n’) with down n’
…    | x = a ∷ x

The first task is to define down using some kind of unfold.

In the second tasks, given a non-empty list, we would like to distribute its elements to a roughly balanced binary tree. The list and the tree are define by:

data List⁺ (a : Set) : Set where
    [_]⁺ : a -> List⁺ a
    _∷⁺_ : a -> List⁺ a -> List⁺ a
data Tree⁺ (a : Set) : Set where
    Tip⁺ : a -> Tree⁺ a
    Bin⁺ : Tree⁺ a -> Tree⁺ a -> Tree⁺ a

If we apply, for example, foldT merge wrap, we get merge sort (I use non-empty lists to save the constructor for empty trees). In Haskell, one might first define a function that splits a list to roughly two halfs, something equivalent to this:

split⁺ : {a : Set} -> List⁺ a -> a ⊎ (List⁺ a × List⁺ a)
split⁺ [ x ]⁺ = inj₁ x
split⁺ (x ∷⁺ xs) with split⁺ xs
… | inj₁ y = inj₂ ([ y ]⁺ , [ x ]⁺)
… | inj₂ (ys , zs) = inj₂ (zs , x ∷⁺ ys)

and use an unfold on Tree⁺. The second task is to construct a function expand : {a : Set} -> List⁺ a -> Tree⁺ a that builds a roughly balanced tree, using some kind of unfold that makes use of split⁺, or at least some variation of it.

Josh Ko’s Approach

Josh and I tried to extend unfolds with extra arguments representing a bound and proofs that the bound decreases with each call to f:

unfoldr↓ : {a b : Set} {_≾_ : b -> ℕ -> Set} ->
  (f : b -> ⊤ ⊎ (a × b)) -> (y : b) -> (t : ℕ) ->
  y ≾ t -> (forall {y} -> y ≾ zero -> f y ≡ inj₁ tt) ->
    (forall {y} t' {x y'} ->
         y ≾ suc t' -> f y ≡ inj₂ (x , y') -> y' ≾ t')
      -> [ a ]

Apart from the generating function f and the seed b, the function unfoldr↓ takes a bound t, a natural number. The seed and the bound is related by ≾, to be defined for each specific problem. Before producing the list, unfoldr↓ demands that the current seed is bounded by the bound (y ≾ t), a proof that f must yield inj₁ when the bound is zero, and a proof that if f returns inj₂ (x , y'), the new seed y' is bounded by a strictly smaller bound.

To define unfoldr↓ we need the inspect idiom (see the explanation in Relation.Binary.PropositionalEquality):

unfoldr↓ f y t y≾t p1 p2 with inspect (f y)
... | (inj₁ tt) with-≡ inj₁≡fy = []
… | (inj₂ (x , y’)) with-≡ inj₂≡fy with t
…  | zero = contradiction (p1 y≾t)
        (\fy≡inj₁ -> inj₁≢inj₂ (≡-sym (≡-trans inj₂≡fy fy≡inj₁)))
…  | suc t’ = x ∷ unfoldr↓ f y’ t’
            (p2 t’ y≾t (≡-sym inj₂≡fy)) p1 p2

Notice that unfoldr↓ passes the termination check because it pattern matches on t.

Descending List

For the first task, the seed is a natural number, and we may simply define ≾ to be ≤:

_≾_ : ℕ -> ℕ -> Set
n ≾ c = n ≤ c

Then down↓ can be defined in terms of unfoldr↓ and dec by:

stop : forall {n} -> n ≾ zero -> dec n ≡ inj₁ tt
stop {.zero} z≤n = ≡-refl

proceed : forall {n} c' {x n'} -> n ≾ suc c' -> dec n ≡ inj₂ (x , n') -> n' ≾ c'
proceed {.zero} c' {x} {n'} z≤n dec-zero≡inj₂ = contradiction dec-zero≡inj₂ inj₁≢inj₂
proceed {suc m} c' {.m} {.m} (s≤s m≤c') ≡-refl = m≤c'

down↓ : ℕ -> [ ℕ ]
down↓ n = unfoldr↓ dec n n ≤-refl stop proceed

where ≤-refl : forall x -> x ≤ x.

Expanding a Binary Tree

The unfold above can be generalised to trees in the obvious way:

unfoldT↓ : {a b : Set} {_≼_ : b -> ℕ -> Set} ->
  (f : b -> a ⊎ b × b) -> (y : b) -> (n : ℕ) ->
   y ≼ n -> (forall y -> y ≼ zero -> ∃ a (\x -> f y ≡ inj₁ x)) ->
    (forall y i y₁ y₂ ->
        y ≼ suc i -> f y ≡ inj₂ (y₁ , y₂) -> (y₁ ≼ i × y₂ ≼ i))
    -> Tree⁺ a
unfoldT↓ f y n y≼n p₁ p₂ with inspect (f y)
... | inj₁ x with-≡ _ = Tip⁺ x
... | inj₂ (y₁ , y₂) with-≡ inj₂≡fy with n
...  | zero = contradiction (proof (p₁ y y≼n))
      (\fy≡inj₁ -> inj₁≢inj₂ (≡-sym (≡-trans inj₂≡fy fy≡inj₁)))
...  | suc m with p₂ y m y₁ y₂ y≼n (≡-sym inj₂≡fy)
...    | (y₁≼m , y₂≼m) = Bin⁺ (unfoldT↓ f y₁ m y₁≼m p₁ p₂)
      (unfoldT↓ f y₂ m y₂≼m p₁ p₂)

One would wonder whether the condition (y₁ ≼ i × y₂ ≼ i) is too restrictive. When the proposition has to be proved inductively, we may need a stronger inductive hypothesis, for example, that both y₁ and y₂ are bounded by half of suc i. The current definition luckily works for our second task. We may need some generalisation later.

Repeated calls to split⁺ eventually terminates because the lengths of the lists are strictly decreasing. Therefore we define:

_#≤_ : {A : Set} -> List⁺ A -> ℕ -> Set
xs #≤ n = pred (length⁺ xs) ≤ n

With properly defined lemma1 and lemma2, we can expand the tree by unfoldT↓:

expand↓ : {a : Set} -> List⁺ a -> Tree⁺ a
expand↓ {a} xs = unfoldT↓ {a} {List⁺ a} {_#≤_} split⁺ xs
      (pred (length⁺ xs)) ≤-refl lemma1 lemma2

where the two lemmas respectively have types:

lemma1 : {a : Set}(xs : List⁺ a) ->
   xs #≤ zero -> ∃ a (\x -> split⁺ xs ≡ inj₁ x)
lemma2 : {a : Set} (xs : List⁺ a) (i : ℕ)
  (ys : List⁺ a) (zs : List⁺ a) ->
  xs #≤ suc i -> split⁺ xs ≡ inj₂ (ys , zs) -> ys #≤ i × zs #≤ i

Definition of lemma1 is a simple application of contradiction. On the other hand, lemma2 is very tedious to define. It appears to me that the definition inevitably becomes cumbersome because split⁺ and lemma2 are defined separately. It could be much easier if split⁺ is defined to return the computed results as well as some proofs about them. For my application in AoPA, however, I would prefer to be able to reuse the old split⁺. I don’t know a good solution yet.

Nils Anders Danielsson suggested that it would be nicer to integrate the bound into the type of the seed, while Conor McBride suggested yet another approach. I will try to summarise them next time.

To be continued…

Dependent type theory is rich enough to express that a program satisfies an input/output relational specification, but it could be hard to construct the proof term. On the other hand, squiggolists know very well how to show that one relation is included in another by algebraic reasoning. The AoPA library allows one to encode Algebra of Programming style program derivation, both functional and relational, in Agda.

Example

The following is a derivation of insertion sort in progress:

sort-der : ∃ ([ Val ] -> [ Val ]) (\f -> ordered? ○ permute ⊒ fun f )
sort-der = exists (
  ⊒-begin
      ordered? ○ permute
  ⊒⟨ (\vs -> ·-monotonic ordered? (permute-is-fold vs)) ⟩
      ordered? ○ foldR combine nil
  ⊒⟨ foldR-fusion ordered? ins-step ins-base ⟩
      foldR (fun (uncurry insert)) nil
  ⊒⟨ { foldR-to-foldr insert []}0 ⟩
      { fun (foldr insert [])
  ⊒∎ }1)

isort : [ Val ] -> [ Val ]
isort = witness sort-der


The type of sort-der is a proposition that there exists a program of type [ Val ] → [ Val ]that is contained in ordered ? ◦ permute , a relation mapping a list to one of its ordered permutations. The proof proceeds by derivation from the specification towards the algorithm. The first step exploits monotonicity of ◦ and that permute can be expressed as a fold. The second step makes use of relational fold fusion. The shaded areas denote interaction points — fragments of (proof ) code to be completed. The programmer can query Agda for the expected type and the context of the shaded expression. When the proof is completed, an algorithm isort is obtained by extracting the witness of the proposition. It is an executable program that is backed by the type system to meet the specification.

The complete program is in the Example directory of the code.

The Code

The code consists of the following files and folders:

• AlgebraicReasoning: a number of modules supporting algebraic reasoning. At present we implement our own because the PreorderReasoning module in earlier versions of the Standard Library was not expressive enough for our need. We may adapt to the new Standard Library later.
• ConvFunThm: the converse-of-a-function theorem.
• Examples: currently we have prepared two examples: a functional derivation of the maximum segment sum problem, and a relational derivation of insertion sort (following the paper Functional Algorithm Design by Richard Bird).
• Fold: a key module defining fold on lists, universal property of fold, fold-fusion theorem, etc.
• Relations: modules defining various properties of relations.
• Sets: a simple encoding of sets, upon with Relations are built.

The module Unfold is not yet complete.

Download

The library is still under development. To grab the latest code, install darcs and check our the code from the repository:

darcs get http://pc-scm.iis.sinica.edu.tw/repos/AoPA


A gzipped tarball of the latest stable release is also available.

Back in 2003 when I just started my postdoc in PSD Lab in University of Tokyo, my colleagues there were discussing about the third homomorphism theorem. The theorem says that if a function f can be expressed both as a foldr and a foldl:

$f\; =\; foldr\; (\ll )\; e$
f = foldl (≫) e

there exists some associative binary operator ⊚ such that

$f\; []\; =\; e$
f [a] = a ≪ e = e ≫ a
f (xs ⧺ ys) = f xs ⊚ f ys

Being a list homomorphism implies the potential of parallel computation.

The paper we studied was, of course, The Thrid Homomorphism Theorem by Jeremy. The aim then was to automatically, or semi-automatically, derive ⊚, given ≪, ≫, and e. The motivating examples include:

• f = sum, where ⊚ can simply be +.
• f = sort, where ⊚ can be the function merge merging two sorted lists.
• f = scanr ⊛ e. While scanr appears to be an inherently sequential function, it is actually possible to compute f “from the middle”, provided that ⊛ is associative, if we take xs ⊚ (y : ys) = map (⊛y) xs ⧺ (y : ys).

Can we come up with a method to derive ⊚ for all these examples?

I myself was not particularly interested in automation. I was interested in the challenge for two reasons. Firstly, it appears that some kind of inverse function is needed. Secondly, when I looked at Jeremy’s proof, I felt there is a relational proof inside waiting to be discovered. So I tried.

Setting the Stage

For the ease of point-free calculation, we define alternatives of folds where the input is paired with the base-cases:

$foldrp\; (\ll )\; ([],a)\; =\; a$
foldrp (≪) (x:xs,a) = x ≪ foldrp (≪) (xs,a)
foldlp (≫) (a,[]) = a
foldlp (≫) (a, xs⧺[x]) = foldlp (≫) (a,xs) ≫ x

The advantage is that we can shift a suffix or a prefix of the input list to the base case. That is:

$foldr\; (\ll )\; e\; (xs⧺ys)\; =\; foldrp\ll \; (xs,\; foldr\ll \; e\; ys)$
foldl (≫) e (xs⧺ys) = foldlp≪ (foldlp≪ e xs, ys)

or, in point-free style:

$foldr\; (\ll )\; e\; .\; cat\; =\; foldrp\; (\ll )\; .\; (id\; \times \; foldr\; (\ll )\; e)$(1)
foldl (≫) e . cat = foldlp (≫) . (foldlp (≫) e × id) (2)

where cat (xs,ys) = xs ⧺ ys and (f × g) (a,b) = (f a, g b).

The key property, however, is one that was shown in (possibly among other literature) Algebra of Programming: for a simple relation (i.e. a partial function) S, we have:

$S\; .\; S°\; .\; S\; =\; S$

where ° stands for relational converse (the relational concept of an “inverse function”).

Recall our aim: given f, look for ⊚ such that f xs ⊚ f ys = f (xs⧺ys). It translates to point-free style as ⊚ . (f × f) = f . cat.

Proving the Theorem

The third homomorphism theorem is a direct corollary of the following lemma:

Lemma 1: f = foldr (≪) e = f = foldl (≫) e implies that f is prefix and postfix insensitive. That is:

$f\; xs\; =\; f\; xs’\; \wedge \; f\; ys\; =\; f\; ys’\; \Rightarrow \; f\; (xs⧺ys)\; =\; f\; (xs’⧺ys’).$

In point-free style: f . cat . (f°. f × f°. f) = f . cat.

Once we have the lemma proved, the theorem follows by taking ⊚ = f . cat . (f °× f °). It has to be a (partial) function because ⊚ . (f × f) = f . cat is a function. Futhermore, ⊚ is associative because cat is.

The proof of Lemma 1 is simply some applications of (1), (2), and S . S° . S = S:

$\; f\; .\; cat$
=      { (1) }
     foldrp (≪) . (id × f)
=      { since f . f° . f = f }
     foldrp (≪) . (id × f) . (id × f° . f)
=      { (1) }
     f . cat . (id × f° . f)
=      { (2) }
     foldlp (≫) . (f × id) . (id × f° . f)
=      { since f . f° . f = f }
     foldlp (≫) . (f × id) . (f° . f × f° . f)
=      { (2) }
     f . cat . (f° . f × f° . f)

The proof is still the same as that of Jeremy’s, but in a relational disguise.

Refining to Functions

To derive actual algorithms, we have yet to refine ⊚ = f . cat . (f°× f°) so that it uses functional components only. We shall pick some g ⊆ f° whose domain equals the range of f, such that ⊚ = f . cat . (g × g). (An equality, rather than inclusion, holds because ⊚ in both definitions are partial functions having the same domain.)

For example, consider the special case sum = foldr (+) 0 = foldl (+) 0. Here ⊚ = sum . cat . (sum°× sum°). One simple choice is to pick wrap ⊆ sum°, where wrap a = [a]. In this case a ⊚ b = sum [a, b] = a + b.

For sort, define sorted = ran sort. It is a partial function such that sorted xs = xs iff xs is sorted. Notice that sorted ⊆ sort°. Therefore, a possible choice for ⊚ would be sort . cat (sorted × sorted) — concatenating two sorted lists, and sort them again. Jeremy then went on with this definition and proved that ⊚ = merge, taking advantage of the fact that both input lists are sorted.

Some more Properties

Some more properties are needed to deal with scanr. The following properties allow foldrp and foldrp to proceed by shifting elements of the list to the base case:

$foldrp\; (\ll )\; (xs⧺[x],a)\; =\; foldrp\; (\ll )\; (xs,\; x\; \ll \; a)$
foldlp (≫) (a, x:xs) = foldlp (≫) (a ≫ x, xs) (3)

When simple approaches of refining ⊚ = f . cat . (f°× f°) does not work, the following approach sometimes does. Since f is a fold, one may attempt to take one of the f° as an unfold, thus forming an “unfold, then fold” pattern:

$⊚\; =\; f\; .\; cat\; .\; (f°\times \; f°)$
=      { (1) }
    foldrp (≪) . (id × f) . (f°× f°)
⊇      { since f . f° ⊇ ran f }
    foldrp (≪) . (f°× ran f)
=      { since f = foldl ≫ [] }
    foldrp (≪) . ((foldl ≫ [])°× ran f)

Symetrically,

$⊚\; =\; foldlp\; (\gg )\; .\; (ran\; f\; \times \; (foldr\; \ll \; [])°)$(4)

Scanr “from the Middle”

Finally, consider f = scanr ⊛ e for some associative ⊛. A scan can be defined both as a foldr and a foldl as below:

$scanr\; ⊛\; e\; =\; foldr\; \ll \; []$
    x ≪ [] = [x]
    x ≪ (y : xs) = x ⊛ y : y : xs
scanr ⊛ e = foldl ≫ []
    xs ≫ x = map (⊛x) xs ⧺ [x]

From ⊚ = f . cat . (f°× f°), we can prove that xs ⊚ (y : ys) = map (⊛ y) xs ⧺ ys. Here is the inductive case:

$xs\; ⊚\; (x\; :\; y\; :\; ys)$
=      { (4) }
    foldlp (≫) (xs, (foldr ≪ [])° (x : y :ys))
=      { definition of ≪, let z ⊛ y = x }
    foldlp (≫) (xs, z : (foldr ≪ [])° (y :ys))
=      { (3) }
    foldlp (≫) (xs ≫ z, (foldr ≪ [])° (y :ys))
=      { (4) }
    (xs ≫ z) ⊚ (y : ys)
=      { induction }
    map (⊛ y) (xs ≫ z) ⧺ (y:ys)
=      { definition of ≫ }
    map (⊛ y) (map (⊛ z) xs ⧺ z) ⧺ (y:ys)
=      { associtivity of ⊛, z ⊛ y =x }
    map (⊛ x) xs ⧺ [x] ⧺ (y:ys)

Prologue

Given the complexity of the proof above, I did not think there was a hope to automatically construct ⊚ for a reasonably useful set of list homomorphisms. My colleagues were talking about “weak inverses” — their attempts to look for a refinement of f°, which I considered too ad-hoc.

Being just graduated from AoP, I was perhaps too arrogant and proud of all the clever derivation we did to care about automatic program construction. (Like Jeremy, in the end of my thesis I quoted “善數不用籌策 (Those who good at calculation need no mechanical aids)” from 老子 Lao Tzu. And didn’t Dijkstra say “I hardly used the computer they gave me. I was perfectly happy without it.”?) The relational method, which seemed to cover everything, gave me a false feeling that I knew the problem inside out.

Last year, however, my colleagues and I met again and I was told that they eventually published a paper on this subject:

Kazutaka Morita, Akimasa Morihata, Kiminori Matsuzaki, Zhenjiang Hu, Masato Takeichi. Automatic Inversion Generates Divide-and-Conquer Parallel Programs, PLDI 2007.

They focused on weak inverses that returns only lists with fixed lengths. The advantage is that calculations like the one above are no longer necessary — since the lists are of fixed-length, ⊚ always takes constant time. On the other hand, scanr and scanl are special cases dealt with on a different level. Such distinction is enforced by the language they allow to construct f. No, they do not seem to have handled sort. But their approach still covered a reasonably useful collection of functions.

Well, I think the moral is that we cannot just stop when it appears that is no elegant solution that suits our taste. It sometimes pays to get our hands dirty, through which we may eventually discover the beauty within.