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.
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 an undergraduate student trying to prove correctness and termination of imperative version of Euclidean gcd and Euclidean extended gcd algorithm. I used IMP language to implement the first one and Hoare logic to prove correctness and termination:
lemma "⊢{λs. s ''a'' = n ∧ s ''b'' = m ∧ n > 0 ∧ m > 0 ∧ (gcd (s ''a'') (s ''b'') = gcd (n) (m))}
WHILE (Or (Less (V ''b'') (V ''a'')) (Less (V ''a'') (V ''b'')))
DO (IF (Less (V ''b'') (V ''a'')) THEN
(''a'' ::= Sub (V ''a'') (V ''b''))
ELSE
(''b'' ::= Sub (V ''b'') (V ''a'')))
{λs. s ''a'' = gcd (s ''A'') (s ''B'')}"
apply (rule While'[where P = "λs. s ''a'' = n ∧ s ''b'' = m ∧ 0 < n ∧ 0 < m ∧ gcd (s ''a'') (s ''b'') = gcd n m"])
apply auto
apply (rule Assign')
apply auto
prefer 2
apply (rule Assign')
apply auto
remaining sub goals are:
proof (prove)
goal (3 subgoals):
1. ⋀s. 0 < s ''a'' ⟹ m = s ''b'' ⟹ n = s ''a'' ⟹ s ''a'' < s ''b'' ⟹ False
2. ⋀s. 0 < s ''b'' ⟹ m = s ''b'' ⟹ n = s ''a'' ⟹ s ''b'' < s ''a'' ⟹ False
3. ⋀s. n = s ''a'' ⟹ m = s ''a'' ⟹ 0 < s ''a'' ⟹ s ''b'' = s ''a'' ⟹ s ''a'' = gcd (s ''A'') (s ''B'')
and I don't now how to finish the proof. The gcd function here is default gcd from GCD library. I also tried this definition from Arith2 library:
definition cd :: "[nat, nat, nat] ⇒ bool"
where "cd x m n ⟷ x dvd m ∧ x dvd n"
definition gcd :: "[nat, nat] ⇒ nat"
where "gcd m n = (SOME x. x>0 ∧ cd x m n & (∀y.(cd y m n) ⟶ y dvd x))"
Is what I wrote correct and how should I continue? Should I use these definitions instead or should I write recursive version of gcd function myself? Is this approach correct?
First of all, you have a type in one place, where you talk about s ''A'' and s ''B'' instead of s ''a'' and s ''b''. But that is of course not the problem you were asking about.
The problem here is that the precondition is too strong to work with the WHILE rule. It contains the conditions s ''a'' = n and s ''b'' = m, which clearly do not work as a loop invariant since the loop modifies the variables a and b, so after one loop iteration, one of the conditions s ''a'' = n and s ''b'' = m will no longer hold.
You need to figure out a proper invariant that is weaker than what you have now. What you have to do is to kick out the s ''a'' = n and s ''b'' = m. Then your proof goes through.
You can then recover the statement you actually want to show with the strengthen_pre rule.
So the start of your proof would look something like this:
lemma "⊢{λs. s ''a'' = n ∧ s ''b'' = m ∧ n ≥ 0 ∧ m ≥ 0 ∧ (gcd (s ''a'') (s ''b'') = gcd (n) (m))}
WHILE (Or (Less (V ''b'') (V ''a'')) (Less (V ''a'') (V ''b'')))
DO (IF (Less (V ''b'') (V ''a'')) THEN
(''a'' ::= Sub (V ''a'') (V ''b''))
ELSE
(''b'' ::= Sub (V ''b'') (V ''a'')))
{λs. s ''a'' = gcd (s ''a'') (s ''b'')}"
apply (rule strengthen_pre)
defer
apply (rule While'[where P = "λs. s ''a'' ≥ 0 ∧ s ''b'' ≥ 0 ∧ gcd (s ''a'') (s ''b'') = gcd n m"])
To avoid this awkward manual use of strengthen_pre, other versions of IMP allow annotating the invariants of WHILE loops directly in the algorithm itself, so that a VCG (verification condition generator) can automatically give you all the things you have to prove and you don't have to apply Hoare rules manually.
Addendum: Note however that there is also a problem with your postcondition:
{λs. s ''a'' = gcd (s ''a'') (s ''b'')}
This is not what you want to show! This just means that the value of a after the execution is the GCD of the values of a and b after the execution. This also happens to be true because a and b are always equal after the algorithm has finished – but what you really want to know is that the value of a after the execution is equal to the GCD of a and b before the execution, i.e. equal to gcd n m. You therefore have to change your postcondition to
{λs. s ''a'' = gcd n m}
I'm trying to prove these two addition functions are extensionally the same, however I can't even prove the simplest lemma for the second one. How does one do this proof over the non-primitive recursive addition function?
Fixpoint myadd1 (m n : nat) : nat :=
match m, n with
| 0, n => n
| (S m), n => S (myadd1 m n)
end.
Fixpoint myadd2 (m n : nat) : nat :=
match m, n with
| 0, n => n
| (S m), n => myadd2 m (S n)
end.
Lemma succlem1 : forall (m n : nat),
(myadd1 m 0) = m.
Proof.
intros. induction m.
- simpl. reflexivity.
- simpl. rewrite IHm.
reflexivity.
Qed.
Lemma succlem12 : forall (m n : nat),
(myadd2 m 0) = m.
Proof.
intros. induction m.
- reflexivity.
- simpl.
Abort.
Edit:
This is what I was trying to prove, and why I was led to this lemma.
Lemma succlem : forall (m n : nat),
S (myadd2 m 0) = myadd2 m 1.
Proof.
intros. induction m.
- simpl. reflexivity.
- simpl. rewrite <- IHm.
simpl.
Theorem succHomo : forall (m n : nat),
S (myadd2 m n) = myadd2 m (S n).
Proof.
intros.
induction n.
- simpl. reflexivity.
- simpl.
inversion IHm.
Theorem equivadds : forall (m n : nat),
myadd1 m n = myadd2 m n.
Proof.
intros.
induction m.
- simpl. reflexivity.
- intros.
simpl.
rewrite IHm.
symmetry.
When you have an accumulator, you most always want to generalize your induction hypothesis. So, in this case you could first prove that myadd2 is equivalent to myadd1:
Lemma myadd1Sr m n :
myadd1 m (S n) = S (myadd1 m n).
Proof.
now induction m as [|m IHm]; trivial; simpl; rewrite IHm.
Qed.
Lemma myadd2_equiv_myadd1 : forall m n : nat,
myadd2 m n = myadd1 m n.
Proof.
intros m. (* important: don't introduce `n` yet -- this will make your IH less general than needed *)
induction m as [| m IHm]; trivial; intros n; simpl.
now rewrite IHm, myadd1Sr.
Qed.
Then the rest can be done by simple rewriting:
Lemma succlem12 : forall m : nat,
myadd2 m 0 = m.
Proof.
now intros m; rewrite myadd2_equiv_myadd1, succlem1.
Qed.
If you show that myadd1 commutes, it becomes easy to prove that they are equal:
Lemma myadd1_comm: forall a b, myadd1 a b = myadd1 b a.
now induction a; intros; auto; simpl; rewrite IHa.
Qed.
Lemma myadd2_equiv_myadd1: forall m n, myadd1 m n = myadd2 m n.
now induction m; intros; auto; simpl; rewrite <- IHm, !(myadd1_comm m).
Qed.
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.
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.