How to replace hypotheses 0 < d with S d' in Coq?
In Coq, I've the annoying hypotheses that 0 < d, which I need to replace to apply euclid_div_succ_d_theorem to prove euclid_div_theorem as a corollary.
How can I somehow convert the assumptions into the proper form to apply the theorem?
Theorem euclid_div_theorem :
forall d : nat,
0 < d ->
forall n : nat,
exists q r : nat,
n = q * d + r /\ r < d.
Theorem euclid_div_succ_d_theorem :
forall d : nat,
forall n : nat,
exists q r : nat,
n = q * (S d) + r /\ r < (S d).
Using the standard lemmas from the Arith module you can change 0 < d into exists m, d = S m, which (after destruction) gives you the desired result.
Require Import Arith.
Theorem euclid_div_theorem : forall d : nat,
0 < d -> forall n : nat, exists q r : nat, n = q * d + r /\ r < d.
Proof.
intros d H n.
apply Nat.lt_neq, Nat.neq_sym, Nat.neq_0_r in H.
destruct H; rewrite H.
apply euclid_div_succ_d_theorem.
Qed.
Here is how I did it:
Search (exists _, _ = S _). gives us the last lemma (it's easier to go backwards from your goal here, imho):
Nat.neq_0_r: forall n : nat, n <> 0 <-> (exists m : nat, n = S m)
This means we need to infer d <> 0 from 0 < d, so again Search (_ < _ -> _ <> _). yields:
Nat.lt_neq: forall n m : nat, n < m -> n <> m
Now it's easy to see that we need to swap the lhs and rhs of the inequality, so I did Search (?x <> ?y -> ?y <> ?x).:
Nat.neq_sym: forall n m : nat, n <> m -> m <> n
I could've also used a more universal lemma:
not_eq_sym: forall (A : Type) (x y : A), x <> y -> y <> x
It'd give us the same result.
There is, however, a less tedious way of proving the lemma -- you can always use destruct d. and prove it by cases:
intros d H n.
destruct d.
- inversion H. (* H is a contradiction now: `0 < 0` *)
- apply euclid_div_succ_d_theorem.
Related
I have defined a recursive function with fix, and now I want to prove a rewriting equation about it.
The function in question is a bit big, but here is another function that has the same problem.
(Here is an interactive collacoq with it: https://x80.org/collacoq/aweboxoxuy.coq)
Require Import Wf_nat PeanoNat.
Definition test (n: nat): nat.
refine (
let test :=
fix test n (H: Acc lt n) {struct H} :=
if Nat.eq_dec 0 n
then n
else n + test (n-1) _
in
test n (Wf_nat.lt_wf n)).
apply H; auto with arith.
Defined.
(* a unit test to see it works as intended. *)
Check eq_refl (test 4 = 4 + test 3).
I want to prove the following goal
Goal forall n, test (S n) = S n + test n.
Proof.
induction n.
reflexivity.
unfold test.
but when I start working on it, I get a proof term with fix test
Now I just want to unfold this once, but cbv delta evaluates too much.
How can I reduce the fix function definition just once?
Here is the proof obligation
n: nat
IHn: test (S n) = test n + S n
1/1
(fix test (n0 : nat) (H : Acc lt n0) {struct H} : nat :=
match Nat.eq_dec 0 n0 with
| left _ => n0
| right H0 =>
n0 +
test (n0 - 1)
(match H with
| Acc_intro _ H1 => H1
end (n0 - 1)
(Nat.sub_lt n0 1
(Arith_prebase.gt_le_S_stt 0 n0
(Arith_prebase.neq_0_lt_stt n0 H0))
(le_n 1)))
end) (S (S n)) (lt_wf (S (S n))) =
(fix test (n0 : nat) (H : Acc lt n0) {struct H} : nat :=
match Nat.eq_dec 0 n0 with
| left _ => n0
| right H0 =>
n0 +
test (n0 - 1)
(match H with
| Acc_intro _ H1 => H1
end (n0 - 1)
(Nat.sub_lt n0 1
(Arith_prebase.gt_le_S_stt 0 n0
(Arith_prebase.neq_0_lt_stt n0 H0))
(le_n 1)))
end) (S n) (lt_wf (S n)) + S (S n)
Working with function defined by well-foundness is always tricky. One reason is that you are often drown under big terms.
The main problem of your proof is (because of your induction) you are creating (S (S n)) so your function reduces too much by simplification!
As a matter of fact you don't need to prove your lemma by induction.
Let us try to convey some intuition. Your definition looks like.
test n = f n (lt_wf n)
so your function is defined by accessibility with the proof (lt_wf n). What you actually need to prove is that f does not depend on the actual proof.
Lemma f_eq : forall n H1 H2, f n H1 = f n H2.
and you will be able to perform simplification.
Here is a proof of your Lemma
Goal forall n, test (S n) = S n + test n.
Proof.
intros n.
apply f_equal2 with (f := Nat.add); [trivial |].
set (f := ((fix test (k : _) (H : Acc lt k) {struct H} : _ := _))).
set (H := (_ : Acc _ (S n - 1))).
assert (f_eq : forall n H1 H2, f n H1 = f n H2).
- intros n1.
induction n1.
+ intros H1 H2.
dependent inversion H1; dependent inversion H2; simpl; auto.
+ intros H1 H2.
dependent inversion H1; dependent inversion H2.
apply f_equal2 with (f := Nat.add).
* trivial.
* destruct n1; apply IHn1.
- destruct n; apply f_eq.
Qed.
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 }.
*)
Suppose I have some natural numbers d ≥ 2 and n > 0; in this case, I can split off the d's from n and get n = m * dk, where m is not divisible by d.
I'd like to use this repeated removal of the d-divisible parts as a recursion scheme; so I thought I'd make a datatype for the Steps leading to m:
import Data.Nat.DivMod
data Steps: (d : Nat) -> {auto dValid: d `GTE` 2} -> (n : Nat) -> Type where
Base: (rem: Nat) -> (rem `GT` 0) -> (rem `LT` d) -> (quot : Nat) -> Steps d {dValid} (rem + quot * d)
Step: Steps d {dValid} n -> Steps d {dValid} (n * d)
and write a recursive function that computes the Steps for a given pair of d and n:
total lemma: x * y `GT` 0 -> x `GT` 0
lemma {x = Z} LTEZero impossible
lemma {x = Z} (LTESucc _) impossible
lemma {x = (S k)} prf = LTESucc LTEZero
steps : (d : Nat) -> {auto dValid: d `GTE` 2} -> (n : Nat) -> {auto nValid: n `GT` 0} -> Steps d {dValid} n
steps Z {dValid = LTEZero} _ impossible
steps Z {dValid = (LTESucc _)} _ impossible
steps (S d) {dValid} n {nValid} with (divMod n d)
steps (S d) (q * S d) {nValid} | MkDivMod q Z _ = Step (steps (S d) {dValid} q {nValid = lemma nValid})
steps (S d) (S rem + q * S d) | MkDivMod q (S rem) remSmall = Base (S rem) (LTESucc LTEZero) remSmall q
However, steps is not accepted as total since there's no apparent reason why the recursive call is well-founded (there's no structural relationship between q and n).
But I also have a function
total wf : (S x) `LT` (S x) * S (S y)
with a boring proof.
Can I use wf in the definition of steps to explain to Idris that steps is total?
Here is one way of using well-founded recursion to do what you're asking. I'm sure though, that there is a better way. In what follows I'm going to use the standard LT function, which allows us to achieve our goal, but there some obstacles we will need to work around.
Unfortunately, LT is a function, not a type constructor or a data constructor, which means we cannot define an implementation of the
WellFounded
typeclass for LT. The following code is a workaround for this situation:
total
accIndLt : {P : Nat -> Type} ->
(step : (x : Nat) -> ((y : Nat) -> LT y x -> P y) -> P x) ->
(z : Nat) -> Accessible LT z -> P z
accIndLt {P} step z (Access f) =
step z $ \y, lt => accIndLt {P} step y (f y lt)
total
wfIndLt : {P : Nat -> Type} ->
(step : (x : Nat) -> ((y : Nat) -> LT y x -> P y) -> P x) ->
(x : Nat) -> P x
wfIndLt step x = accIndLt step x (ltAccessible x)
We are going to need some helper lemmas dealing with the less than relation, the lemmas can be found in this gist (Order module). It's a subset of my personal library which I recently started. I'm sure the proofs of the helper lemmas can be minimized, but it wasn't my goal here.
After importing the Order module, we can solve the problem (I slightly modified the original code, it's not difficult to change it or write a wrapper to have the original type):
total
steps : (n : Nat) -> {auto nValid : 0 `LT` n} -> (d : Nat) -> Steps (S (S d)) n
steps n {nValid} d = wfIndLt {P = P} step n d nValid
where
P : (n : Nat) -> Type
P n = (d : Nat) -> (nV : 0 `LT` n) -> Steps (S (S d)) n
step : (n : Nat) -> (rec : (q : Nat) -> q `LT` n -> P q) -> P n
step n rec d nV with (divMod n (S d))
step (S r + q * S (S d)) rec d nV | (MkDivMod q (S r) prf) =
Base (S r) (LTESucc LTEZero) prf q
step (Z + q * S (S d)) rec d nV | (MkDivMod q Z _) =
let qGt0 = multLtNonZeroArgumentsLeft nV in
let lt = multLtSelfRight (S (S d)) qGt0 (LTESucc (LTESucc LTEZero)) in
Step (rec q lt d qGt0)
I modeled steps after the divMod function from the contrib/Data/Nat/DivMod/IteratedSubtraction.idr module.
Full code is available here.
Warning: the totality checker (as of Idris 0.99, release version) does not accept steps as total. It has been recently fixed and works for our problem (I tested it with Idris 0.99-git:17f0899c).
I've two Fibonacci implementations, seen below, that I want to prove are functionally equivalent.
I've already proved properties about natural numbers, but this exercise requires another approach that I cannot figure out.
The textbook I'm using have introduced the following syntax of Coq, so it should be possible to prove equality using this notation:
<definition> ::= <keyword> <identifier> : <statement> <proof>
<keyword> ::= Proposition | Lemma | Theorem | Corollary
<statement> ::= {<quantifier>,}* <expression>
<quantifier> ::= forall {<identifier>}+ : <type>
| forall {({<identifier>}+ : <type>)}+
<proof> ::= Proof. {<tactic>.}* <end-of-proof>
<end-of-proof> ::= Qed. | Admitted. | Abort.
Here are the two implementations:
Fixpoint fib_v1 (n : nat) : nat :=
match n with
| 0 => O
| S n' => match n' with
| O => 1
| S n'' => (fib_v1 n') + (fib_v1 n'')
end
end.
Fixpoint visit_fib_v2 (n a1 a2 : nat) : nat :=
match n with
| 0 => a1
| S n' => visit_fib_v2 n' a2 (a1 + a2)
end.
It is pretty obvious that these functions compute the same value for the base case n = 0, but the induction case is much harder?
I've tried proving the following Lemma, but I'm stuck in induction case:
Lemma about_visit_fib_v2 :
forall i j : nat,
visit_fib_v2 i (fib_v1 (S j)) ((fib_v1 j) + (fib_v1 (S j))) = (fib_v1 (add_v1 i (S j))).
Proof.
induction i as [| i' IHi'].
intro j.
rewrite -> (unfold_visit_fib_v2_0 (fib_v1 (S j)) ((fib_v1 j) + (fib_v1 (S j)))).
rewrite -> (add_v1_0_n (S j)).
reflexivity.
intro j.
rewrite -> (unfold_visit_fib_v2_S i' (fib_v1 (S j)) ((fib_v1 j) + (fib_v1 (S j)))).
Admitted.
Where:
Fixpoint add_v1 (i j : nat) : nat :=
match i with
| O => j
| S i' => S (add_v1 i' j)
end.
A note of warning: in what follows I'll to try to show the main idea of such a proof, so I'm not going to stick to some subset of Coq and I won't do arithmetic manually. Instead I'll use some proof automation, viz. the ring tactic. However, feel free to ask additional questions, so you could convert the proof to somewhat that would suit your purposes.
I think it's easier to start with some generalization:
Require Import Arith. (* for `ring` tactic *)
Lemma fib_v1_eq_fib2_generalized n : forall a0 a1,
visit_fib_v2 (S n) a0 a1 = a0 * fib_v1 n + a1 * fib_v1 (S n).
Proof.
induction n; intros a0 a1.
- simpl; ring.
- change (visit_fib_v2 (S (S n)) a0 a1) with
(visit_fib_v2 (S n) a1 (a0 + a1)).
rewrite IHn. simpl; ring.
Qed.
If using ring doesn't suit your needs, you can perform multiple rewrite steps using the lemmas of the Arith module.
Now, let's get to our goal:
Definition fib_v2 n := visit_fib_v2 n 0 1.
Lemma fib_v1_eq_fib2 n :
fib_v1 n = fib_v2 n.
Proof.
destruct n.
- reflexivity.
- unfold fib_v2. rewrite fib_v1_eq_fib2_generalized.
ring.
Qed.
#larsr's answer inspired this alternative answer.
First of all, let's define fib_v2:
Require Import Coq.Arith.Arith.
Definition fib_v2 n := visit_fib_v2 n 0 1.
Then, we are going to need a lemma, which is the same as fib_v2_lemma in #larsr's answer. I'm including it here for consistency and to show an alternative proof.
Lemma visit_fib_v2_main_property n: forall a0 a1,
visit_fib_v2 (S (S n)) a0 a1 =
visit_fib_v2 (S n) a0 a1 + visit_fib_v2 n a0 a1.
Proof.
induction n; intros a0 a1; auto with arith.
change (visit_fib_v2 (S (S (S n))) a0 a1) with
(visit_fib_v2 (S (S n)) a1 (a0 + a1)).
apply IHn.
Qed.
As suggested in the comments by larsr, the visit_fib_v2_main_property lemma can be also proved by the following impressive one-liner:
now induction n; firstorder.
Because of the nature of the numbers in the Fibonacci series it's very convenient to define an alternative induction principle:
Lemma pair_induction (P : nat -> Prop) :
P 0 ->
P 1 ->
(forall n, P n -> P (S n) -> P (S (S n))) ->
forall n, P n.
Proof.
intros H0 H1 Hstep n.
enough (P n /\ P (S n)) by tauto.
induction n; intuition.
Qed.
The pair_induction principle basically says that if we can prove some property P for 0 and 1 and if for every natural number k > 1, we can prove P k holds under the assumption that P (k - 1) and P (k - 2) hold, then we can prove forall n, P n.
Using our custom induction principle, we get the proof as follows:
Lemma fib_v1_eq_fib2 n :
fib_v1 n = fib_v2 n.
Proof.
induction n using pair_induction.
- reflexivity.
- reflexivity.
- unfold fib_v2.
rewrite visit_fib_v2_main_property.
simpl; auto.
Qed.
Anton's proof is very beautiful, and better than mine, but it might be useful, anyway.
Instead of coming up with the generalisation lemma, I strengthened the induction hypothesis.
Say the original goal is Q n. I then changed the goal with
cut (Q n /\ Q (S n))
from
Q n
to
Q n /\ Q (S n)
This new goal trivially implies the original goal, but with it the induction hypothesis becomes stronger, so it becomes possible to rewrite more.
IHn : Q n /\ Q (S n)
=========================
Q (S n) /\ Q (S (S n))
This idea is explained in Software Foundations in the chapter where one does proofs over even numbers.
Because the propostion often is very long, I made an Ltac tactic that names the long and messy term.
Ltac nameit Q :=
match goal with [ _:_ |- ?P ?n] => let X := fresh Q in remember P as X end.
Require Import Ring Arith.
(Btw, I renamed vistit_fib_v2 to fib_v2.)
I needed a lemma about one step of fib_v2.
Lemma fib_v2_lemma: forall n a b, fib_v2 (S (S n)) a b = fib_v2 (S n) a b + fib_v2 n a b.
intro n.
pattern n.
nameit Q.
cut (Q n /\ Q (S n)).
tauto. (* Q n /\ Q (S n) -> Q n *)
induction n.
split; subst; simpl; intros; ring. (* Q 0 /\ Q 1 *)
split; try tauto. (* Q (S n) *)
subst Q. (* Q (S (S n)) *)
destruct IHn as [H1 H2].
assert (L1: forall n a b, fib_v2 (S n) a b = fib_v2 n b (a+b)) by reflexivity.
congruence.
Qed.
The congruence tactic handles goals that follow from a bunch of A = B assumptions and rewriting.
Proving the theorem is very similar.
Theorem fib_v1_fib_v2 : forall n, fib_v1 n = fib_v2 n 0 1.
intro n.
pattern n.
nameit Q.
cut (Q n /\ Q (S n)).
tauto. (* Q n /\ Q (S n) -> Q n *)
induction n.
split; subst; simpl; intros; ring. (* Q 0 /\ Q 1 *)
split; try tauto. (* Q (S n) *)
subst Q. (* Q (S (S n)) *)
destruct IHn as [H1 H2].
assert (fib_v1 (S (S n)) = fib_v1 (S n) + fib_v1 n) by reflexivity.
assert (fib_v2 (S (S n)) 0 1 = fib_v2 (S n) 0 1 + fib_v2 n 0 1) by
(pose fib_v2_lemma; congruence).
congruence.
Qed.
All the boiler plate code could be put in a tactic, but I didn't want to go crazy with the Ltac, since that was not what the question was about.
This proof script only shows the proof structure. It could be useful to explain the idea of the proof.
Require Import Ring Arith Psatz. (* Psatz required by firstorder *)
Theorem fibfib: forall n, fib_v2 n 0 1 = fib_v1 n.
Proof with (intros; simpl in *; ring || firstorder).
assert (H: forall n a0 a1, fib_v2 (S n) a0 a1 = a0 * (fib_v1 n) + a1 * (fib_v1 (S n))).
{ induction n... rewrite IHn; destruct n... }
destruct n; try rewrite H...
Qed.
There is a very powerful library -- math-comp written in the Ssreflect formal proof language that is in its turn based on Coq. In this answer I present a version that uses its facilities. It's just a simplified piece of this development. All credit goes to the original author.
Let's do some imports and the definitions of our two functions, math-comp (ssreflect) style:
From mathcomp
Require Import ssreflect ssrnat ssrfun eqtype ssrbool.
Fixpoint fib_rec (n : nat) {struct n} : nat :=
if n is n1.+1 then
if n1 is n2.+1 then fib_rec n1 + fib_rec n2
else 1
else 0.
Fixpoint fib_iter (a b n : nat) {struct n} : nat :=
if n is n1.+1 then
if n1 is n2.+1
then fib_iter b (b + a) n1
else b
else a.
A helper lemma expressing the basic property of Fibonacci numbers:
Lemma fib_iter_property : forall n a b,
fib_iter a b n.+2 = fib_iter a b n.+1 + fib_iter a b n.
Proof.
case=>//; elim => [//|n IHn] a b; apply: IHn.
Qed.
Now, let's tackle equivalence of the two implementations.
The main idea here, that distinguish the following proof from the other proofs has been presented as of time of this writing, is that we perform
kind of complete induction, using elim: n {-2}n (leqnn n). This gives us the following (strong) induction hypothesis:
IHn : forall n0 : nat, n0 <= n -> fib_rec n0 = fib_iter 0 1 n0
Here is the main lemma and its proof:
Lemma fib_rec_eq_fib_iter : fib_rec =1 fib_iter 0 1.
Proof.
move=>n; elim: n {-2}n (leqnn n)=> [n|n IHn].
by rewrite leqn0; move/eqP=>->.
case=>//; case=>// n0; rewrite ltnS=> ltn0n.
rewrite fib_iter_property.
by rewrite <- (IHn _ ltn0n), <- (IHn _ (ltnW ltn0n)).
Qed.
Here is yet another answer, similar to the one using mathcomp, but this one uses "vanilla" Coq.
First of all, we need some imports, additional definitions, and a couple of helper lemmas:
Require Import Coq.Arith.Arith.
Definition fib_v2 n := visit_fib_v2 n 0 1.
Lemma visit_fib_v2_property n: forall a0 a1,
visit_fib_v2 (S (S n)) a0 a1 =
visit_fib_v2 (S n) a0 a1 + visit_fib_v2 n a0 a1.
Proof. now induction n; firstorder. Qed.
Lemma fib_v2_property n:
fib_v2 (S (S n)) = fib_v2 (S n) + fib_v2 n.
Proof. apply visit_fib_v2_property. Qed.
To prove the main lemma we are going to use the standard well-founded induction lt_wf_ind principle for natural numbers with the < relation (a.k.a. complete induction):
This time we need to prove only one subgoal, since the n = 0 case for complete induction is always vacuously true. Our induction hypothesis, unsurprisingly, looks like this:
IH : forall m : nat, m < n -> fib_v1 m = fib_v2 m
Here is the proof:
Lemma fib_v1_eq_fib2 n :
fib_v1 n = fib_v2 n.
Proof.
pattern n; apply lt_wf_ind; clear n; intros n IH.
do 2 (destruct n; trivial).
rewrite fib_v2_property.
rewrite <- !IH; auto.
Qed.
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.