I started working in ocaml and i can't figure out a small thing about nat types - functional-programming

I am trying to write a function of type nat -> nat -> nat -> nat
which i named sudan_nat it works on the principle of sudan function
**
Wikipedia:
https://en.wikipedia.org/wiki/Sudan_function
//This is the type definition
type nat = Zero | Succ of nat
let add_nat m n =
let rec helper m = match m with Zero -> n | Succ m -> Succ (helper m)
in helper m
let zero_nat = Zero
let one_nat = Succ zero_nat
let two_nat = Succ one_nat
let four_nat = add_nat two_nat two_nat`
let sudan_nat m n p =
let rec helper m n = match m with Zero -> n | Succ m -> Succ (helper m n)
in helper (add_nat (add_nat m n) p) one_nat
This is the code i wrote for the sudan_nat
My case for testing output is
((sudan_nat one_nat two_nat two_nat) = (add_nat (add_nat four_nat four_nat) four_nat))
Succ (Succ (Succ (Succ (Succ (Succ Zero)))))
This is the result for left side
Succ
(Succ
(Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero)))))))))))
This is the result of right side i have been scratching my head for hours now any kind of suggestion is welcomed thank you

four_nat is Succ (Succ (Succ (Succ Zero))). That's 4 Succ constructors. You've added 3 of these together, so you have... 12. 4 times 3 = 12.
When it comes to evaluating sudan_nat nat_one nat_two nat_two it breaks down:
sudan_nat nat_one nat_two nat_two
helper (add_nat (add_nat nat_one nat_two) nat_two) one_nat
helper (add_nat (add_nat Zero nat_two) nat_two) one_nat
helper (add_nat nat_two nat_two) one_nat
helper nat_four one_nat
...
Succ (Succ (Succ (Succ (Succ Zero))))
As an additional style suggestion, you may wish to define a module to organize your code.
module Nat =
struct
type t = Zero | Succ of t
let add m n =
let rec helper m =
match m with
| Zero -> n
| Succ m -> Succ (helper m)
in
helper m
let one = Succ Zero
let two = Succ (Succ Zero)
let four = add two two
let sudan m n p =
let rec helper m n =
match m with
| Zero -> n
| Succ m -> Succ (helper m n)
in
helper (add (add m n) p) one
end

Related

Function termination proof in Isabelle

I have datatype stack_op which consists of several (~20) cases. I'm trying write function which skips some of that cases in list:
function (sequential) skip_expr :: "stack_op list ⇒ stack_op list" where
"skip_expr [] = []"
| "skip_expr ((stack_op.Unary _)#other) = (skip_expr other)"
| "skip_expr ((stack_op.Binary _)#other) = skip_expr (skip_expr other)"
| "skip_expr ((stack_op.Value _)#other) = other"
| "skip_expr other = other"
by pat_completeness auto termination by lexicographic_order
which seems to always terminate. But trying by lexicographic order generates such unresolved cases:
Calls:
c) stack_op.Binary uv_ # other ~> skip_expr other
Measures:
1) size_list size
2) length
Result matrix:
1 2
c: ? ?
(size_change also desn't work)
I've read https://isabelle.in.tum.de/dist/Isabelle2021/doc/functions.pdf, but it couldn't help. (Maybe there are more complex examples of tremination use?)
I tried to rewrite function adding another param:
function (sequential) skip_expr :: "stack_op list ⇒ nat ⇒ stack_op list" where
"skip_expr l 0 = l"
| "skip_expr [] _ = []"
| "skip_expr ((stack_op.Unary _)#other) depth = (skip_expr other (depth - 1))"
| "skip_expr ((stack_op.Binary _)#other) depth =
(let buff1 = (skip_expr other (depth - 1))
in (skip_expr buff1 (length buff1)))"
| "skip_expr ((stack_op.Value _)#other) _ = other"
| "skip_expr other _ = other"
by pat_completeness auto
termination by (relation "measure (λ(_,dep). dep)") auto
which generates unresolved subgoal:
1. ⋀other v. skip_expr_dom (other, v) ⟹ length (skip_expr other v) < Suc v
which I also don't how to proof.
Could anyone how such cases solved (As I can understand there is some problem with two-level recursive call on rigth side of stack_op.Binary case)? Or maybe there is another way to make such skip?
Thanks in advance
The lexicographic_order method simply tries to solve the arising goals with the simplifier, so if the simplifier gets stuck you end up with unresolved termination subgoals.
In this case, as you identified correctly, the problem is that you have a nested recursive call skip_expr (skip_expr other). This is always problematic because at this stage, the simplifier knows nothing about what skip_expr does to the input list. For all we know, it might just return the list unmodified, or even a longer list, and then it surely would not terminate.
Confronting the issue head on
The solution is to show something about length (skip_expr …) and make that information available to the simplifier. Because we have not yet shown termination of the function, we have to use the skip_expr.psimps rules and the partial induction rule skip_expr.pinduct, i.e. every statement we make about skip_expr xs always has as a precondition that skip_expr actually terminates on the input xs. For this, there is the predicate skip_expr_dom.
Putting it all together, it looks like this:
lemma length_skip_expr [termination_simp]:
"skip_expr_dom xs ⟹ length (skip_expr xs) ≤ length xs"
by (induction xs rule: skip_expr.pinduct) (auto simp: skip_expr.psimps)
termination skip_expr by lexicographic_order
Circumventing the issue
Sometimes it can also be easier to circumvent the issue entirely. In your case, you could e.g. define a more general function skip_exprs that skips not just one instruction but n instructions. This you can define without nested induction:
fun skip_exprs :: "nat ⇒ stack_op list ⇒ stack_op list" where
"skip_exprs 0 xs = xs"
| "skip_exprs (Suc n) [] = []"
| "skip_exprs (Suc n) (Unary _ # other) = skip_exprs (Suc n) other"
| "skip_exprs (Suc n) (Binary _ # other) = skip_exprs (Suc (Suc n)) other"
| "skip_exprs (Suc n) (Value _ # other) = skip_exprs n other"
| "skip_exprs (Suc n) xs = xs"
Equivalence to your skip_expr is then straightforward to prove:
lemma skip_exprs_conv_skip_expr: "skip_exprs n xs = (skip_expr ^^ n) xs"
proof -
have [simp]: "(skip_expr ^^ n) [] = []" for n
by (induction n) auto
have [simp]: "(skip_expr ^^ n) (Other # xs) = Other # xs" for xs n
by (induction n) auto
show ?thesis
by (induction n xs rule: skip_exprs.induct)
(auto simp del: funpow.simps simp: funpow_Suc_right)
qed
lemma skip_expr_Suc_0 [simp]: "skip_exprs (Suc 0) xs = skip_expr xs"
by (simp add: skip_exprs_conv_skip_expr)
In your case, I don't think it actually makes sense to do this because figuring out the termination is fairly easy, but it may be good to keep in mind.

Prove recursive function exists using only `nat_ind`

I'm trying to prove the following in Coq:
∀ B: Type, ∀ a: B, ∀ b: nat -> B -> B, ∃ f: nat -> B, f 0 = a ∧ ∀ n: nat, f (S n) = b n (f n).
Which implies that a fairly general class of recursive functions exist. I know that I can construct that function using Fixpoint items or fix expressions, but I want to not use it, and instead use nat_ind defined with this type:
∀ P: nat → Prop, P 0 → (∀ n: nat, P n → P (S n)) → ∀ n: nat, P n
I believe this is possible since nat_ind behaves like a recursion combinator. But I didn't figured it out how to prove it. The problem is that the induction variable is inside of ∃ f guard, and I don't have access to it. I'm able to prove something like this:
∀ B: Type, ∀ a: B, ∀ b: nat -> B -> B, ∀ m: nat,
∃ f: nat -> B, f 0 = a ∧ ∀ n: nat, n < m -> f (S n) = b n (f n)
But it doesn't help in proving the original one I think.
Is it possible to prove the original one without using fix directly? I'm ok with using double negation and other well-known axioms if needed. Using nat_rec and nat_rect is also fine, but only as an opaque axiom. Precisely, using those are fine:
Axiom nat_rec2: ∀ P : nat → Set, P 0 → (∀ n : nat, P n → P (S n)) → ∀ n : nat, P n.
Axiom nat_rect2: ∀ P : nat → Type, P 0 → (∀ n : nat, P n → P (S n)) → ∀ n : nat, P n.
The problem seems to be to obtain recursion from the following axiomatization of nat:
Parameter nat : Type.
Parameter O : nat.
Parameter S : nat -> nat.
Parameter disjoint_O_S : forall n, O <> S n.
Parameter injective_S : forall n n', S n = S n' -> n = n'.
Parameter nat_rect : forall P: nat -> Type, P O -> (forall n: nat, P n -> P (S n)) -> forall n : nat, P n.
Where the main issue is that the nat_rect axiom has no computational behavior, so although we might define a recursor B -> (nat -> B -> B) -> nat -> B as nat_rect (fun _ => B), we can't prove anything about it.
The solution is to first encode the graph of the desired recursive function f as a relation, and then use nat_rect to produce a dependent pair, of a value that is going to be f n with evidence that that value is in the graph of f.
Section Rec.
Context (B : Type) (a : B) (b : nat -> B -> B).
Inductive graph : nat -> B -> Prop :=
| recO : graph O a
| recS n y : graph n y -> graph (S n) (b n y)
.
Lemma graph_fun : forall n, { y | forall y', y = y' <-> graph n y' }.
Proof.
induction n as [ | n IH ] using nat_rect.
- exists a; split.
+ intros <-. constructor.
+ inversion 1; [ reflexivity | ]. contradiction (disjoint_O_S n); auto.
- destruct IH as [y IH]. exists (b n y); split.
+ intros <-. constructor. apply IH. auto.
+ inversion 1; subst. contradiction (disjoint_O_S n); auto.
apply injective_S in H0. subst.
apply IH in H1. subst; auto.
Qed.
Theorem nat_rec : exists (f : nat -> B), f O = a /\ forall n, f (S n) = b n (f n).
Proof.
exists (fun n => proj1_sig (graph_fun n)). split.
- apply (proj2_sig (graph_fun O)). constructor.
- intros n. apply (proj2_sig (graph_fun (S n))).
constructor. apply (proj2_sig (graph_fun n)).
reflexivity.
Qed.
End Rec.
If you have the Prop inductor nat_ind instead of nat_rect, that same technique can be adapted by also assuming the axiom constructive_indefinite_description (which actually lets you reconstruct nat_rect, but here you can more simply apply it at the beginning of graph_fun):
From Coq Require Import IndefiniteDescription.
About constructive_indefinite_description.
(*
constructive_indefinite_description :
forall (A : Type) (P : A->Prop),
(exists x, P x) -> { x : A | P x }.
*)

Should I use universal quantification in lemma formulation?

For
datatype natural = Zero | Succ natural
primrec add :: "natural ⇒ natural ⇒ natural"
where
"add Zero m = m"
| "add (Succ n) m = Succ (add n m)"
I prove
lemma add_succ_right: "⋀ m n. add m (Succ n) = Succ (add m n)"
For being mathematical, it is important to have universal quantification. However, for using this fact in the simplifier, it is better to do it without:
lemma add_succ_right_rewrite: "add m (Succ n) = Succ (add m n)"
What is the common wisdom about these versions, which one should I prefer in what circumstances?
Isabelle/HOL has three ways to universally quantify over variables in lemma statements:
lemma 1: "⋀m n. add m (Succ n) = Succ (add m n)"
lemma 2:
fixes m n
shows "add m (Succ n) = Succ (add m n)"
lemma 3: "∀m n. add m (Succ n) = Succ (add m n)"
Additionally, free variables in lemma statements become automatically quantified:
lemma 4: "add m (Succ n) = Succ (add m n)"
Lemmas 1, 2, and 4 yield the same theorem, which can be used in identical ways later on. Lemma 3 uses the HOL universal quantifier instead of the quantification from the meta-logic. Therefore, extra work is needed to instantiate the quantifier in lemma 3. Thus, this version should only be used in special circumstances.
The version in lemma 1 dates back to when the Isar language was not in its current state and is thus somewhat out-dated. Therefore, I would suggest to prefer version 2 (if you want to explicitly mention the quantified variables), or 4 (if not).

How to prove the reversion of a doubling function equals the doubling of a reversion function in Isabelle?

I have a function that doubles the elements of a list in the form
double [x1, x2, ...] = [x1, x1, x2, x2, ...]
namely
fun double :: " 'a list ⇒ 'a list"
where
"double [] = []" |
"double (x#xs) = x # x # double xs"
and a function that reverses the elements of a list with the help of another function snoc that adds an element to the right side of a list:
fun snoc :: "'a list ⇒ 'a ⇒ 'a list"
where
"snoc [] x = [x]" |
"snoc (y # ys) x = y # (snoc ys x)"
fun reverse :: "'a list ⇒ 'a list"
where
"reverse [] = []" |
"reverse (x # xs) = snoc (reverse xs) x"
Now I want to prove that
lemma rev_double: "rev (double xs) = double (rev xs)"
is true.
I tried to apply induction on xs
lemma rev_double: "rev (double xs) = double (rev xs)"
by (induction xs)
and I wrote an auxiliary lemma double_snoc that ensures that doubling a list is the same as doubling its first element and the rest of the list (which uses the function snocleft which inserts an element at the left end of a list)
fun snocleft::"'a list ⇒ 'a ⇒ 'a list "
where
"snocleft [] x = [x]" |
"snocleft (y # ys) x = x # (y # ys)"
lemma double_snoc: "double (snocleft xs y) = y # y # double xs"
by (induction xs) auto
I still haven't made any progress in proving the lemma. Do you have some solutions or hints on how to set up the prove?
You define your function as reverse, but in all of your lemmas, you use rev, referring to the pre-defined list reversal function rev.
What you mean is probably this:
lemma reverse_double: "reverse (double xs) = double (reverse xs)"
If you attempt to prove this by induction (with apply (induction xs)), you will get stuck in the induction case with the following goal:
snoc (snoc (double (reverse xs)) a) a =
double (snoc (reverse xs) a)
This should be intuitively obvious: if you first snoc and then double, it is the same as first doubling and then snoc-ing twice. So let's prove this as an auxiliary lemma:
lemma double_snoc: "double (snoc xs x) = snoc (snoc (double xs) x) x"
by (induction xs) auto
Now the proof of reverse_double goes through automatically:
lemma reverse_double: "reverse (double xs) = double (reverse xs)"
by (induction xs) (auto simp: double_snoc)

Assisting Agda's termination checker

Suppose we define a function
f : N \to N
f 0 = 0
f (s n) = f (n/2) -- this / operator is implemented as floored division.
Agda will paint f in salmon because it cannot tell if n/2 is smaller than n. I don't know how to tell Agda's termination checker anything. I see in the standard library they have a floored division by 2 and a proof that n/2 < n. However, I still fail to see how to get the termination checker to realize that recursion has been made on a smaller subproblem.
Agda's termination checker only checks for structural recursion (i.e. calls that happen on structurally smaller arguments) and there's no way to establish that certain relation (such as _<_) implies that one of the arguments is structurally smaller.
Digression: Similar problem happens with positivity checker. Consider the standard fix-point data type:
data μ_ (F : Set → Set) : Set where
fix : F (μ F) → μ F
Agda rejects this because F may not be positive in its first argument. But we cannot restrict μ to only take positive type functions, or show that some particular type function is positive.
How do we normally show that a recursive functions terminates? For natural numbers, this is the fact that if the recursive call happens on strictly smaller number, we eventually have to reach zero and the recursion stops; for lists the same holds for its length; for sets we could use the strict subset relation; and so on. Notice that "strictly smaller number" doesn't work for integers.
The property that all these relations share is called well-foundedness. Informally speaking, a relation is well-founded if it doesn't have any infinite descending chains. For example, < on natural numbers is well founded, because for any number n:
n > n - 1 > ... > 2 > 1 > 0
That is, the length of such chain is limited by n + 1.
≤ on natural numbers, however, is not well-founded:
n ≥ n ≥ ... ≥ n ≥ ...
And neither is < on integers:
n > n - 1 > ... > 1 > 0 > -1 > ...
Does this help us? It turns out we can encode what it means for a relation to be well-founded in Agda and then use it to implement your function.
For simplicity, I'm going to bake the _<_ relation into the data type. First of all, we must define what it means for a number to be accessible: n is accessible if all m such that m < n are also accessible. This of course stops at n = 0, because there are no m so that m < 0 and this statement holds trivially.
data Acc (n : ℕ) : Set where
acc : (∀ m → m < n → Acc m) → Acc n
Now, if we can show that all natural numbers are accessible, then we showed that < is well-founded. Why is that so? There must be a finite number of the acc constructors (i.e. no infinite descending chain) because Agda won't let us write infinite recursion. Now, it might seem as if we just pushed the problem back one step further, but writing the well-foundedness proof is actually structurally recursive!
So, with that in mind, here's the definition of < being well-founded:
WF : Set
WF = ∀ n → Acc n
And the well-foundedness proof:
<-wf : WF
<-wf n = acc (go n)
where
go : ∀ n m → m < n → Acc m
go zero m ()
go (suc n) zero _ = acc λ _ ()
go (suc n) (suc m) (s≤s m<n) = acc λ o o<sm → go n o (trans o<sm m<n)
Notice that go is nicely structurally recursive. trans can be imported like this:
open import Data.Nat
open import Relation.Binary
open DecTotalOrder decTotalOrder
using (trans)
Next, we need a proof that ⌊ n /2⌋ ≤ n:
/2-less : ∀ n → ⌊ n /2⌋ ≤ n
/2-less zero = z≤n
/2-less (suc zero) = z≤n
/2-less (suc (suc n)) = s≤s (trans (/2-less n) (right _))
where
right : ∀ n → n ≤ suc n
right zero = z≤n
right (suc n) = s≤s (right n)
And finally, we can write your f function. Notice how it suddenly becomes structurally recursive thanks to Acc: the recursive calls happen on arguments with one acc constructor peeled off.
f : ℕ → ℕ
f n = go _ (<-wf n)
where
go : ∀ n → Acc n → ℕ
go zero _ = 0
go (suc n) (acc a) = go ⌊ n /2⌋ (a _ (s≤s (/2-less _)))
Now, having to work directly with Acc isn't very nice. And that's where Dominique's answer comes in. All this stuff I've written here has already been done in the standard library. It is more general (the Acc data type is actually parametrized over the relation) and it allows you to just use <-rec without having to worry about Acc.
Taking a more closer look, we are actually pretty close to the generic solution. Let's see what we get when we parametrize over the relation. For simplicity I'm not dealing with universe polymorphism.
A relation on A is just a function taking two As and returning Set (we could call it binary predicate):
Rel : Set → Set₁
Rel A = A → A → Set
We can easily generalize Acc by changing the hardcoded _<_ : ℕ → ℕ → Set to an arbitrary relation over some type A:
data Acc {A} (_<_ : Rel A) (x : A) : Set where
acc : (∀ y → y < x → Acc _<_ y) → Acc _<_ x
The definition of well-foundedness changes accordingly:
WellFounded : ∀ {A} → Rel A → Set
WellFounded _<_ = ∀ x → Acc _<_ x
Now, since Acc is an inductive data type like any other, we should be able to write its eliminator. For inductive types, this is a fold (much like foldr is eliminator for lists) - we tell the eliminator what to do with each constructor case and the eliminator applies this to the whole structure.
In this case, we'll do just fine with the simple variant:
foldAccSimple : ∀ {A} {_<_ : Rel A} {R : Set} →
(∀ x → (∀ y → y < x → R) → R) →
∀ z → Acc _<_ z → R
foldAccSimple {R = R} acc′ = go
where
go : ∀ z → Acc _ z → R
go z (acc a) = acc′ z λ y y<z → go y (a y y<z)
If we know that _<_ is well-founded, we can skip the Acc _<_ z argument completly, so let's write small convenience wrapper:
recSimple : ∀ {A} {_<_ : Rel A} → WellFounded _<_ → {R : Set} →
(∀ x → (∀ y → y < x → R) → R) →
A → R
recSimple wf acc′ z = foldAccSimple acc′ z (wf z)
And finally:
<-wf : WellFounded _<_
<-wf = {- same definition -}
<-rec = recSimple <-wf
f : ℕ → ℕ
f = <-rec go
where
go : ∀ n → (∀ m → m < n → ℕ) → ℕ
go zero _ = 0
go (suc n) r = r ⌊ n /2⌋ (s≤s (/2-less _))
And indeed, this looks (and works) almost like the one in the standard library!
Here's the fully dependent version in case you are wondering:
foldAcc : ∀ {A} {_<_ : Rel A} (P : A → Set) →
(∀ x → (∀ y → y < x → P y) → P x) →
∀ z → Acc _<_ z → P z
foldAcc P acc′ = go
where
go : ∀ z → Acc _ z → P z
go _ (acc a) = acc′ _ λ _ y<z → go _ (a _ y<z)
rec : ∀ {A} {_<_ : Rel A} → WellFounded _<_ →
(P : A → Set) → (∀ x → (∀ y → y < x → P y) → P x) →
∀ z → P z
rec wf P acc′ z = foldAcc P acc′ _ (wf z)
I would like to offer a slightly different answer than the ones given above. In particular, I want to suggest that instead of trying to somehow convince the termination checker that actually, no, this recursion is perfectly fine, we should instead try to reify the well-founded-ness so that the recursion is manifestly fine in virtue of being structural.
The idea here is that the problem comes from being unable to see that n / 2 is somehow a "part" of n. Structural recursion wants to break a thing into its immediate parts, but the way that n / 2 is a "part" of n is that we drop every other suc. But it's not obvious up front how many to drop, we have to look around and try to line things up. What would be nice is if we had some type that had constructors for "multiple" sucs.
To make the problem slightly more interesting, let's instead try to define the function that behaves like
f : ℕ → ℕ
f 0 = 0
f (suc n) = 1 + (f (n / 2))
that is to say, it should be the case that
f n = ⌈ log₂ (n + 1) ⌉
Now naturally the above definition won't work, for the same reasons your f won't. But let's pretend that it did, and let's explore the "path", so to speak, that the argument would take through the natural numbers. Suppose we look at n = 8:
f 8 = 1 + f 4 = 1 + 1 + f 2 = 1 + 1 + 1 + f 1 = 1 + 1 + 1 + 1 + f 0 = 1 + 1 + 1 + 1 + 0 = 4
so the "path" is 8 -> 4 -> 2 -> 1 -> 0. What about, say, 11?
f 11 = 1 + f 5 = 1 + 1 + f 2 = ... = 4
so the "path" is 11 -> 5 -> 2 -> 1 -> 0.
Well naturally what's going on here is that at each step we're either dividing by 2, or subtracting one and dividing by 2. Every naturally number greater than 0 can be decomposed uniquely in this fashion. If it's even, divide by two and proceed, if it's odd, subtract one and divide by two and proceed.
So now we can see exactly what our data type should look like. We need a type that has a constructor that means "twice as many suc's" and another that means "twice as many suc's plus one", as well as of course a constructor that means "zero sucs":
data Decomp : ℕ → Set where
zero : Decomp zero
2*_ : ∀ {n} → Decomp n → Decomp (n * 2)
2*_+1 : ∀ {n} → Decomp n → Decomp (suc (n * 2))
We can now define the function that decomposes a natural number into the Decomp that corresponds to it:
decomp : (n : ℕ) → Decomp n
decomp zero = zero
decomp (suc n) = decomp n +1
It helps to define +1 for Decomps:
_+1 : {n : ℕ} → Decomp n → Decomp (suc n)
zero +1 = 2* zero +1
(2* d) +1 = 2* d +1
(2* d +1) +1 = 2* (d +1)
Given a Decomp, we can flatten it down into a natural number that ignores the distinctions between 2*_ and 2*_+1:
flatten : {n : ℕ} → Decomp n → ℕ
flatten zero = zero
flatten (2* p) = suc (flatten p)
flatten (2* p +1 = suc (flatten p)
And now it's trivial to define f:
f : ℕ → ℕ
f n = flatten (decomp n)
This happily passes the termination checker with no trouble, because we're never actually recursing on the problematic n / 2. Instead, we convert the number into a format that directly represents its path through the number space in a structurally recursive way.
Edit It occurred to me only a little while ago that Decomp is a little-endian representation of binary numbers. 2*_ is "append 0 to the end/shift left 1 bit" and 2*_+1 is "append 1 to the end/shift left 1 bit and add one". So the above code is really about showing that binary numbers are structurally recursive wrt dividing by 2, which they ought to be! That makes it much easier to understand, I think, but I don't want to change what I wrote already, so we could instead do some renaming here: Decomp ~> Binary, 2*_ ~> _,zero, 2*_+1 ~> _,one, decomp ~> natToBin, flatten ~> countBits.
After accepting Vitus' answer, I discovered a different way to accomplish the goal of proving a function terminates in Agda, namely using "sized types." I am providing my answer here because it seems acceptable, and also for critique of any weak points of this answer.
Sized types are described:
http://arxiv.org/pdf/1012.4896.pdf
They are implemented in Agda, not only MiniAgda; see here: http://www2.tcs.ifi.lmu.de/~abel/talkAIM2008Sendai.pdf.
The idea is to augment the data type with a size that allows the typechecker to more easily prove termination. Size is defined in the standard library.
open import Size
We define sized natural numbers:
data Nat : {i : Size} \to Set where
zero : {i : Size} \to Nat {\up i}
succ : {i : Size} \to Nat {i} \to Nat {\up i}
Next, we define predecessor and subtraction (monus):
pred : {i : Size} → Nat {i} → Nat {i}
pred .{↑ i} (zero {i}) = zero {i}
pred .{↑ i} (succ {i} n) = n
sub : {i : Size} → Nat {i} → Nat {∞} → Nat {i}
sub .{↑ i} (zero {i}) n = zero {i}
sub .{↑ i} (succ {i} m) zero = succ {i} m
sub .{↑ i} (succ {i} m) (succ n) = sub {i} m n
Now, we may define division via Euclid's algorithm:
div : {i : Size} → Nat {i} → Nat → Nat {i}
div .{↑ i} (zero {i}) n = zero {i}
div .{↑ i} (succ {i} m) n = succ {i} (div {i} (sub {i} m n) n)
data ⊥ : Set where
record ⊤ : Set where
notZero : Nat → Set
notZero zero = ⊥
notZero _ = ⊤
We give division for nonzero denominators.
If the denominator is nonzero, then it is of the form, b+1. We then do
divPos a (b+1) = div a b
Since div a b returns ceiling (a/(b+1)).
divPos : {i : Size} → Nat {i} → (m : Nat) → (notZero m) → Nat {i}
divPos a (succ b) p = div a b
divPos a zero ()
As auxiliary:
div2 : {i : Size} → Nat {i} → Nat {i}
div2 n = divPos n (succ (succ zero)) (record {})
Now we can define a divide and conquer method for computing the n-th Fibonacci number.
fibd : {i : Size} → Nat {i} → Nat
fibd zero = zero
fibd (succ zero) = succ zero
fibd (succ (succ zero)) = succ zero
fibd (succ n) with even (succ n)
fibd .{↑ i} (succ {i} n) | true =
let
-- When m=n+1, the input, is even, we set k = m/2
-- Note, ceil(m/2) = ceil(n/2)
k = div2 {i} n
fib[k-1] = fibd {i} (pred {i} k)
fib[k] = fibd {i} k
fib[k+1] = fib[k-1] + fib[k]
in
(fib[k+1] * fib[k]) + (fib[k] * fib[k-1])
fibd .{↑ i} (succ {i} n) | false =
let
-- When m=n+1, the input, is odd, we set k = n/2 = (m-1)/2.
k = div2 {i} n
fib[k-1] = fibd {i} (pred {i} k)
fib[k] = fibd {i} k
fib[k+1] = fib[k-1] + fib[k]
in
(fib[k+1] * fib[k+1]) + (fib[k] * fib[k])
You cannot do this directly: Agda's termination checker only considers recursion ok on arguments that are syntactically smaller. However, the Agda standard library provides a few modules for proving termination using a well-founded order between the arguments of the functions. The standard order on natural numbers is such an order and can be used here.
Using the code in Induction.*, you can write your function as follows:
open import Data.Nat
open import Induction.WellFounded
open import Induction.Nat
s≤′s : ∀ {n m} → n ≤′ m → suc n ≤′ suc m
s≤′s ≤′-refl = ≤′-refl
s≤′s (≤′-step lt) = ≤′-step (s≤′s lt)
proof : ∀ n → ⌊ n /2⌋ ≤′ n
proof 0 = ≤′-refl
proof 1 = ≤′-step (proof zero)
proof (suc (suc n)) = ≤′-step (s≤′s (proof n))
f : ℕ → ℕ
f = <-rec (λ _ → ℕ) helper
where
helper : (n : ℕ) → (∀ y → y <′ n → ℕ) → ℕ
helper 0 rec = 0
helper (suc n) rec = rec ⌊ n /2⌋ (s≤′s (proof n))
I found an article with some explanation here. But there may be better references out there.
A similar question appeared on the Agda mailing-list a few weeks ago and the consensus seemed to be to inject the Data.Nat element into Data.Bin and then use structural recursion on this representation which is well-suited for the job at hand.
You can find the whole thread here : http://comments.gmane.org/gmane.comp.lang.agda/5690
You can avoid using well-founded recursion. Let's say you want a function, that applies ⌊_/2⌋ to a number, until it reaches 0, and collects the results. With the {-# TERMINATING #-} pragma it can be defined like this:
{-# TERMINATING #-}
⌊_/2⌋s : ℕ -> List ℕ
⌊_/2⌋s 0 = []
⌊_/2⌋s n = n ∷ ⌊ ⌊ n /2⌋ /2⌋s
The second clause is equivalent to
⌊_/2⌋s n = n ∷ ⌊ n ∸ (n ∸ ⌊ n /2⌋) /2⌋s
It's possible to make ⌊_/2⌋s structurally recursive by inlining this substraction:
⌊_/2⌋s : ℕ -> List ℕ
⌊_/2⌋s = go 0 where
go : ℕ -> ℕ -> List ℕ
go _ 0 = []
go 0 (suc n) = suc n ∷ go (n ∸ ⌈ n /2⌉) n
go (suc i) (suc n) = go i n
go (n ∸ ⌈ n /2⌉) n is a simplified version of go (suc n ∸ ⌊ suc n /2⌋ ∸ 1) n
Some tests:
test-5 : ⌊ 5 /2⌋s ≡ 5 ∷ 2 ∷ 1 ∷ []
test-5 = refl
test-25 : ⌊ 25 /2⌋s ≡ 25 ∷ 12 ∷ 6 ∷ 3 ∷ 1 ∷ []
test-25 = refl
Now let's say you want a function, that applies ⌊_/2⌋ to a number, until it reaches 0, and sums the results. It's simply
⌊_/2⌋sum : ℕ -> ℕ
⌊ n /2⌋sum = go ⌊ n /2⌋s where
go : List ℕ -> ℕ
go [] = 0
go (n ∷ ns) = n + go ns
So we can just run our recursion on a list, that contains values, produced by the ⌊_/2⌋s function.
More concise version is
⌊ n /2⌋sum = foldr _+_ 0 ⌊ n /2⌋s
And back to the well-foundness.
open import Function
open import Relation.Nullary
open import Relation.Binary
open import Induction.WellFounded
open import Induction.Nat
calls : ∀ {a b ℓ} {A : Set a} {_<_ : Rel A ℓ} {guarded : A -> Set b}
-> (f : A -> A)
-> Well-founded _<_
-> (∀ {x} -> guarded x -> f x < x)
-> (∀ x -> Dec (guarded x))
-> A
-> List A
calls {A = A} {_<_} f wf smaller dec-guarded x = go (wf x) where
go : ∀ {x} -> Acc _<_ x -> List A
go {x} (acc r) with dec-guarded x
... | no _ = []
... | yes g = x ∷ go (r (f x) (smaller g))
This function does the same as the ⌊_/2⌋s function, i.e. produces values for recursive calls, but for any function, that satisfies certain conditions.
Look at the definition of go. If x is not guarded, then return []. Otherwise prepend x and call go on f x (we could write go {x = f x} ...), which is structurally smaller.
We can redefine ⌊_/2⌋s in terms of calls:
⌊_/2⌋s : ℕ -> List ℕ
⌊_/2⌋s = calls {guarded = ?} ⌊_/2⌋ ? ? ?
⌊ n /2⌋s returns [], only when n is 0, so guarded = λ n -> n > 0.
Our well-founded relation is based on _<′_ and defined in the Induction.Nat module as <-well-founded.
So we have
⌊_/2⌋s = calls {guarded = λ n -> n > 0} ⌊_/2⌋ <-well-founded {!!} {!!}
The type of the next hole is {x : ℕ} → x > 0 → ⌊ x /2⌋ <′ x
We can easily prove this proposition:
open import Data.Nat.Properties
suc-⌊/2⌋-≤′ : ∀ n -> ⌊ suc n /2⌋ ≤′ n
suc-⌊/2⌋-≤′ 0 = ≤′-refl
suc-⌊/2⌋-≤′ (suc n) = s≤′s (⌊n/2⌋≤′n n)
>0-⌊/2⌋-<′ : ∀ {n} -> n > 0 -> ⌊ n /2⌋ <′ n
>0-⌊/2⌋-<′ {suc n} (s≤s z≤n) = s≤′s (suc-⌊/2⌋-≤′ n)
The type of the last hole is (x : ℕ) → Dec (x > 0), we can fill it by _≤?_ 1.
And the final definition is
⌊_/2⌋s : ℕ -> List ℕ
⌊_/2⌋s = calls ⌊_/2⌋ <-well-founded >0-⌊/2⌋-<′ (_≤?_ 1)
Now you can recurse on a list, produced by ⌊_/2⌋s, without any termination issues.
I encountered this sort of problem when trying to write a quick sort function in Agda.
While other answers seem to explain the problem and solutions more generally, coming from a CS background, I think the following wording would be more accessible for certain readers:
The problem of working with the Agda termination checker comes down to how we can internalize the termination checking process.
Suppose we want to define a function
func : Some-Recursively-Defined-Type → A
func non-recursive-case = some-a
func (recursive-case n) = some-other-func (func (f n)) (func (g n)) ...
In many of the cases, we the writers know f n and g n are going to be smaller than recursive-case n. Furthermore, it is not like the proofs for these being smaller are super difficult. The problem is more about how we can communicate this knowledge to Agda.
It turns out we can do this by adding a timer argument to the definition.
Timer : Type
Timer = Nat
measure : Some-Recursively-Defined-Type → Timer
-- this function returns an upper-bound of how many steps left to terminate
-- the estimate should be tight enough for the non-recursive cases that
-- given those estimates,
-- pattern matching on recursive cases is obviously impossible
measure = {! !}
func-aux :
(timer : Timer) -- the timer,
(actual-arguments : Some-Recursively-Defined-Type)
(timer-bounding : measure actual-arguments ≤ timer)
→ A
func-aux zero non-recursive-case prf = a
-- the prf should force args to only pattern match to the non-recursive cases
func-aux (succ t) non-recursive-case prf = a
func-aux (succ t) (recursive-case n) prf =
some-other-func (func-aux t (f n) prf') (func-aux t (g n) prf'') ... where
prf' : measure (f n) ≤ t
prf' = {! !}
prf'' : measure (g n) ≤ t
prf'' = {! !}
With these at hand, we can define the function we want as something like the following :
func : Some-Recursively-Defined-Type → A
func x with measure x
func x | n = func-aux n x (≤-is-reflexive n)
Caveat
I have not taken into account anything about whether the computation would be efficient.
While Timer type is not restricted to be Nat (but for all types with which we have a strong enough order relation to work with), I think it is pretty safe to say we don't gain much even if we consider such generality.

Resources