Let's suppose that I have
type T
wellfounded relation R: T->T->Prop
function F1: T->T that makes argument "smaller"
condition C: T->Prop that describes "start values" of R
function F2: T->T that makes argument "bigger"
How can I make Fixpoint that looks similar to this:
Fixpoint Example (n:T):X :=
match {C n} + {~C n} with
left _ => ... |
right _ => Example (F1 n)
end.
And how I can make possible the following usage of tactic 'induction' (or similar):
Theorem ...
Proof.
...
induction n F.
(* And now I have two goals:
the first with assumption C n and goal P n,
the second with assumption P n and goal P (F2 n) *)
...
Qed.
I tried to do that with type nz: {n:nat | n<>O} (looking in the chapter 7.1 of Certified Programming with Dependent Types book) but got only this far:
Require Import Omega.
Definition nz: Set := {n:nat | n<>O}.
Theorem nz_t1 (n:nat): S n<>O. Proof. auto. Qed.
Definition nz_eq (n m:nz) := eq (projT1 n) (projT1 m).
Definition nz_one: nz := exist _ 1 (nz_t1 O).
Definition nz_lt (n m:nz) := lt (projT1 n) (projT1 m).
Definition nz_pred (n:nz): nz := exist _ (S (pred (pred (projT1 n)))) (nz_t1 _).
Theorem nz_Acc: forall (n:nz), Acc nz_lt n.
Proof.
intro. destruct n as [n pn], n as [|n]. omega.
induction n; split; intros; destruct y as [y py]; unfold nz_lt in *; simpl in *.
omega.
assert (y<S n\/y=S n). omega. destruct H0.
assert (S n<>O); auto.
assert (nz_lt (exist _ y py) (exist _ (S n) H1)). unfold nz_lt; simpl; assumption.
fold nz_lt in *. apply Acc_inv with (exist (fun n0:nat=>n0<>O) (S n) H1). apply IHn.
unfold nz_lt; simpl; assumption.
rewrite <- H0 in IHn. apply IHn.
Defined.
Theorem nz_lt_wf: well_founded nz_lt. Proof. exact nz_Acc. Qed.
Lemma pred_wf: forall (n m:nz), nz_lt nz_one n -> m = nz_pred n -> nz_lt m n.
Proof.
intros. unfold nz_lt, nz_pred in *. destruct n as [n pn], m as [m pm]. simpl in *.
destruct n, m; try omega. simpl in *. inversion H0. omega.
Defined.
I couldn't understand what happens further because it was too complicated for me.
P.S. As I see it - there isn't any good enough tutorial about general recursion and induction in Coq for beginners. At least I could find. :(
I'll try to write a more complete answer later, but Coq has a command called Function that makes it easier to write functions whose arguments decrease according to some well-ordering. Look for the command on the reference manual (http://coq.inria.fr/distrib/current/refman/Reference-Manual004.html#hevea_command48), specifically the "wf" variant.
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.
(* 4. Let oddn and evenn be the predicates that test whether a given number
is odd or even. Show that the sum of an odd number with an even number is odd. *)
Inductive oddn : nat -> Prop :=
| odd1 : oddn 1
| odd2 : forall n, oddn n -> oddn (S (S n)).
Inductive evenn : nat -> Prop :=
| even1 : evenn 0
| even2 : forall n, evenn n -> evenn (S (S n)).
Theorem odd_add : forall n m, oddn n -> evenn m -> oddn (n + m).
Proof. intros. destruct m.
+ Search add. rewrite <- plus_n_O. apply H.
+ destruct H.
++ simpl. apply odd2.
I don't know how can I prove this theorem, since I can not link oddn with evenn.
(* 6. We call a natural number good if the sum of all
its digits is divisible by 5. For example 122 is good
but 93 is not. Define a function count such that
(count n) returns the number of good numbers smaller than
or equal to n. Here we assume that 0 <= n < 10000.
Hint: You may find the "let ... in" struct useful. You may
directly use the div and modulo functions defined in the
standard library of Coq. *)
Definition isGood(n:nat) : bool :=
Fixpoint count (n : nat) : nat :=
match n with
| 0 => 1
| S n' => if isGood n then 1 + count n'
else count n'
end.
Compute count 15.
Example count_test1 : count 15 = 3.
Proof. reflexivity. Qed.
Example count_test2 : count 2005 = 401.
Proof. reflexivity. Qed.
For the second problem, I got stuck because the recursion I defined won't be accepted by Coq(non-decreasing?).
I just got stuck with these two problems, can anyone work them out?
If you want to define independently oddnand even, you may prove a lemma which relates these two predicates, like:
Remark R : forall n, (evenn n <-> oddn (S n)) /\
(oddn n <-> evenn (S n)).
(* proof by induction on n *)
Then, it's easy to apply this remark for solving your first exercise.
Please note that you may define even and odd in several other ways:
as mutually inductive predicates
with existential quantifiers
define even, then oddin function of even
...
I don't understand the problem with the second exercise.
A few days ago, we discussed about a function sum_digits you can use (with modulo) to define isGood.
Your function count looks OK, but quite inefficient (with Peano natural numbers).
I've got stuck with theorem which is easy to formulate:
"If the maximal element of the vector is 0 then each element of the vector is 0".
The goal is to be able to use such an idiom as "fold_left orb false v".
So my first aim is to prove this particular lemma:
Lemma all_then_some (A:Type) :
forall (n:nat) (p:Fin.t (S n))
(v : Vector.t bool (S n))
(H : (Vector.fold_left orb false v) = false),
(Vector.nth v p) = false.
Proof.
...
Some thoughts:
1) To strengthen the hypothesis and prove something like this:
(forall (b:bool), (List.fold_left orb l b) = b) <->
(forall (p:nat), (List.nth p l false) = false)
(** NB: variant for lists here! **)
2) Use principle "rectS" from the standard library /Vectors/Fin.v
3) Use small scale reflection library.
UPDATE: to find the partial solution please see my answer below.(ged)
UPDATE2: Solution is here: https://github.com/georgydunaev/TRASH/blob/master/UNIV_INST.v
(it is called "Theorem all_then_someV")
You can indeed use a more structured lemma from math-comp, a quick example [that can surely be improved]:
From mathcomp Require Import all_ssreflect.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Lemma nat_of_bool_inj : injective nat_of_bool.
Proof. by case=> [] []. Qed.
Lemma all_false n (r : n.-tuple bool) :
\max_(i in 'I_n) tnth r i <= 0 ->
forall i, tnth r i = false.
Proof.
by move/bigmax_leqP => H i; apply/nat_of_bool_inj/eqP; rewrite -leqn0 H.
Qed.
You have some more specialized lemmas relating \big[orb/false] with has.
The code consists of two parts:
I have proved my lemma for List in the 1st part and, similarly, I have almost proved for Vector in the 2nd part.
There is a problem in the last step of the second part.
("induction p." causes "Abstracting over the terms "n0" and "p" leads to a term … which is ill-typed". I don't understand what shall I do instead of "induction p.".)
(*PART 1*)
Require Import Coq.Lists.List.
Import ListNotations.
Fixpoint A2 l :fold_left orb l true = true.
Proof.
destruct l; simpl.
reflexivity.
apply A2.
Defined.
Theorem A1 (x y:bool): (orb x y = false)->(x=false)/\(y=false).
Proof. intro H. destruct x, y; firstorder || inversion H. Defined.
Fixpoint A0 b l : fold_left orb (b :: l) false = orb b (fold_left orb l false) .
Proof.
destruct l.
simpl. firstorder.
simpl.
destruct b.
simpl.
apply A2.
simpl.
reflexivity.
Defined.
Fixpoint all_then_some (l:list bool) {struct l}:
(List.fold_left orb l false) = false ->
(forall (p:nat), (List.nth p l false) = false).
Proof.
intros.
destruct l. simpl. destruct p; trivial.
simpl.
rewrite A0 in H.
pose (Q:=A1 _ _ H).
destruct Q.
destruct p. trivial.
apply all_then_some.
trivial.
Defined.
(*PART 2*)
Require Import Coq.Vectors.Vector.
Import VectorNotations.
Fixpoint B2 (n:nat) (l:t bool n) :fold_left orb true l = true.
Proof.
destruct l; simpl.
reflexivity.
apply B2.
Defined.
Fixpoint B0 b (n:nat) (l:t bool n) :
fold_left orb false (b :: l) = orb b (fold_left orb false l) .
Proof.
destruct l.
simpl. firstorder.
simpl.
destruct b.
simpl.
apply B2.
simpl.
reflexivity.
Defined.
Fixpoint all_then_someV (n:nat) (l:Vector.t bool n) {struct l}:
(Vector.fold_left orb false l ) = false ->
(forall p, (Vector.nth l p ) = false).
Proof.
intros.
induction l eqn:equa.
inversion p. (* simpl. destruct p; trivial.*)
(*simpl.*)
rewrite B0 in H.
pose (Q:=A1 _ _ H).
destruct Q.
induction p.
I think something like the following code can help (because "destruct" tactic is like "_rect" application), but I am not sure.
Definition G0 h (n:nat) (l:Vector.t bool n) := fold_left orb false (h :: l) = false.
fold G0 in H.
assert (vari : G0 h n l).
exact H.
clear H.
revert h l vari.
set (P := fun n p => forall (h : bool) (l : t bool n) (_ : G0 h n l),
#eq bool (#nth bool (S n) (cons bool h n l) p) false).
unshelve eapply (#Fin.rectS P).
UPDATE2: Solution is here: https://github.com/georgydunaev/TRASH/blob/master/UNIV_INST.v
(it is called "Theorem all_then_someV")
Given the procedure even, I want to prove that even (n * (S n)) = true for all natural numbers n.
Using induction, this is easily seen to be true for the case n = 0. However, the case (S n) * (S (S n)) is hard to simplify.
I've considered proving the lemma that even (m * n) = even m /\ even n, but this doesn't seem to be easier.
Also, it is easy to see that if even n = true iff. even (S n) = false.
Fixpoint even (n: nat) : bool :=
match n with
| O => true
| 1 => false
| S (S n') => even n'
end.
Can someone give a hint on how to prove this using a "beginner's" subset of Coq?
This is a case where a more advanced induction principle can be useful. It is briefly described in this answer.
Require Import Coq.Arith.Arith.
Require Import Coq.Bool.Bool.
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 ? ? ? n. enough (P n /\ P (S n)) by tauto.
induction n; intuition.
Qed.
Now, let's define several helper lemmas. They are obvious and can be easily proved using the pair_induction principle and some proof automation.
Lemma even_mul2 : forall n, Nat.even (2 * n) = true.
Proof.
induction n; auto.
now replace (2 * S n) with (2 + 2 * n) by ring.
Qed.
Lemma even_add_even : forall m n,
Nat.even m = true ->
Nat.even (m + n) = Nat.even n.
Proof.
now induction m using pair_induction; auto.
Qed.
Lemma even_add_mul2 : forall m n,
Nat.even (2 * m + n) = Nat.even n.
Proof.
intros; apply even_add_even, even_mul2.
Qed.
Lemma even_S : forall n,
Nat.even (S n) = negb (Nat.even n).
Proof.
induction n; auto.
simpl (Nat.even (S (S n))). (* not necessary -- just to make things clear *)
apply negb_sym. assumption.
Qed.
The following lemma shows how to "distribute" even over multiplication. It plays an important role in the proof of our main goal. As almost always generalization helps a lot.
Lemma even_mult : forall m n,
Nat.even (m * n) = Nat.even m || Nat.even n.
Proof.
induction m using pair_induction; simpl; auto.
intros n. replace (n + (n + m * n)) with (2 * n + m * n) by ring.
now rewrite even_add_mul2.
Qed.
Now, the proof of the goal is trivial
Goal forall n, Nat.even (n * (S n)) = true.
intros n. now rewrite even_mult, even_S, orb_negb_r.
Qed.
Can someone give a hint on how to prove this using a "beginner's" subset of Coq?
You can consider this a hint, since it reveals the general structure of a possible proof. The automatic tactics may be replaced by the "manual" tactics like with rewrite, apply, destruct and so on.
I'd like to contribute a shorter proof using the mathcomp lib:
From mathcomp Require Import all_ssreflect all_algebra.
Lemma P n : ~~ odd (n * n.+1).
Proof. by rewrite odd_mul andbN. Qed.
odd_mul is proved by simple induction, as well as odd_add.
Another version, in the spirit of #ejgallego's answer.
Let's give another definition for the even predicate. The purpose of this is to make proofs by simple induction easy, so there is no need of using pair_induction. The main idea is that we are going to prove some properties of even2 and then we'll use the fact that Nat.even and even2 are extensionally equal to transfer the properties of even2 onto Nat.even.
Require Import Coq.Bool.Bool.
Fixpoint even2 (n : nat) : bool :=
match n with
| O => true
| S n' => negb (even2 n')
end.
Let's show that Nat.even and even2 are extensionally equal.
Lemma even_S n :
Nat.even (S n) = negb (Nat.even n).
Proof. induction n; auto. apply negb_sym; assumption. Qed.
Lemma even_equiv_even2 n :
Nat.even n = even2 n.
Proof. induction n; auto. now rewrite even_S, IHn. Qed.
Some distribution lemmas for even2:
Lemma even2_distr_add m n :
even2 (m + n) = negb (xorb (even2 m) (even2 n)).
Proof.
induction m; simpl.
- now destruct (even2 n).
- rewrite IHm. now destruct (even2 m); destruct (even2 n).
Qed.
Lemma even2_distr_mult m n :
even2 (m * n) = even2 m || even2 n.
Proof.
induction m; auto; simpl.
rewrite even2_distr_add, IHm.
now destruct (even2 m); destruct (even2 n).
Qed.
Finally, we are able to prove our goal, using the equality between Nat.even and even2.
Goal forall n, Nat.even (n * (S n)) = true.
intros n.
now rewrite even_equiv_even2, even2_distr_mult, orb_negb_r.
Qed.
A short version that makes use of the standard library:
Require Import Coq.Arith.Arith.
Goal forall n, Nat.even (n * (S n)) = true.
intros n.
now rewrite Nat.even_mul, Nat.even_succ, Nat.orb_even_odd.
Qed.
For what it's worth, here is my take on the solution. The essential idea is, instead of proving a predicate P n, prove instead P n /\ P (S n), which is equivalent, but the second formulation allows to use simple induction.
Here is the complete proof:
Require Import Nat.
Require Import Omega.
Definition claim n := even (n * (S n)) = true.
(* A technical Lemma, needed in the proof *)
Lemma tech: forall n m, even n = true -> even (n + 2*m) = true.
Proof.
intros. induction m.
* simpl. replace (n+0) with n; intuition.
* replace (n + 2 * S m) with (S (S (n+2*m))); intuition.
Qed.
(* A simple identity, that Coq needs help to prove *)
Lemma ident: forall n,
(S (S n) * S (S (S n))) = (S n * S( S n) + 2*(S (S n))).
(* (n+2)*(n+3) = (n+1)*(n+2) + 2*(n+2) *)
Proof.
intro.
replace (S (S (S n))) with ((S n) + 2) by intuition.
remember (S (S n)) as m.
replace (m * (S n + 2)) with ((S n + 2) * m) by intuition.
intuition.
Qed.
(* The claim to be proved by simple induction *)
Lemma nsn: forall n, claim n /\ claim (S n).
Proof.
intros.
unfold claim.
induction n.
* intuition.
* intuition. rewrite ident. apply tech; auto.
Qed.
(* The final result is now a simple corollary *)
Theorem thm: forall n, claim n.
Proof.
apply nsn.
Qed.
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.