Z_3: left id proof - coq

I am close to ending the proof for Z_3 left id. Here is what I have so far
Require Import Coq.Arith.PeanoNat.
Require Import Coq.Bool.Bool.
Require Import Coq.Logic.Eqdep_dec.
Record Z_3 : Type := Z3
{
n :> nat;
proof : (Nat.ltb n 3) = true
}.
Proposition lt_0_3 : (0 <? 3) = true.
Proof.
simpl. reflexivity.
Qed.
Definition z3_0 : Z_3 := (Z3 0 lt_0_3).
Proposition lt_1_3 : (1 <? 3) = true.
Proof.
reflexivity.
Qed.
Definition z3_1 : Z_3 := (Z3 1 lt_1_3).
Proposition lt_2_3 : (2 <? 3) = true.
Proof.
reflexivity.
Qed.
Definition z3_2 : Z_3 := (Z3 2 lt_2_3).
Proposition three_ne_0 : 3 <> 0.
Proof.
discriminate.
Qed.
Lemma mod_upper_bound_bool : forall (a b : nat), b <> O -> (a mod b <? b) = true.
Proof.
intros a b H. apply (Nat.mod_upper_bound a b) in H. case Nat.ltb_spec0.
- reflexivity.
- intros Hcontr. contradiction.
Qed.
Definition Z3_op (x y: Z_3) : Z_3 :=
let a := (x + y) mod 3 in
Z3 a (mod_upper_bound_bool _ 3 three_ne_0).
Lemma Z3_eq n m p q : n = m -> Z3 n p = Z3 m q.
Proof.
intros H. revert p q. rewrite H. clear H. intros. apply f_equal. apply UIP_dec. apply bool_dec.
Qed.
Proposition Z3_left_id' : forall x: Z_3, (Z3_op z3_0 x) = x.
Proof.
intro. unfold Z3_op. destruct x as [n proof]. apply Z3_eq.
Result:
1 subgoal (ID 46)
n : nat
proof : (n <? 3) = true
============================
(z3_0 + {| n := n; proof := proof |}) mod 3 = n
I found the following theorems that could be useful:
Nat.ltb_spec0
: forall x y : nat, reflect (x < y) (x <? y)
Nat.mod_small: forall a b : nat, a < b -> a mod b = a
Is it possible to get rid of profs in the goal, convert proof from bool to Prop, and then use Nat.mod_small?
Update
Proposition Z3_left_id' : forall x: Z_3, (Z3_op z3_0 x) = x.
Proof.
intro. unfold Z3_op. destruct x as [vx proof]. apply Z3_eq. unfold n, z3_0. rewrite plus_O_n. apply Nat.mod_small.
1 subgoal (ID 67)
vx : nat
proof : (vx <? 3) = true
============================
vx < 3

You need the coercion to execute. Unfortunately,
by naming the bound variable of your proof n and the projection from Z_3 to nat n, you painted yourself in a corner.
Here are four solutions:
1/ this one I mention just for the record: you can talk about the constant n that was defined in this file by using the file name as a module qualifier.
unfold user4035_oct_16.n.
user4035_oct_16 is the name of the current file, this is ugly.
2/ you could call a computation function that computes everything, however computation of modulo leaves unsightly terms in the goal, so you could decide to not compute that particular part.
cbn -[Nat.modulo].
I like this one, but it requires that you spend sometime learning how to use cbn.
3/ You can avoid the name clash by renaming variables in the goal.
rename n into m.
unfold n, Z3_0.
Not very nice either.
4/ Just go back in your script and replace destruct x as [n proof] with destruct x as [vx proof], then you can type:
unfold n, z3_0.
you will be able to use the lemmas you suggest.
Proof:
Proposition Z3_left_id : forall x: Z_3, (Z3_op z3_0 x) = x.
Proof.
intro. unfold Z3_op. destruct x as [vx proof]. apply Z3_eq. unfold n, z3_0. rewrite plus_O_n. apply Nat.mod_small. apply Nat.ltb_lt in proof. assumption.
Qed.

Related

Proof irrelevance for boolean equality

I'm trying to prove group axioms for Z_3 type:
Require Import Coq.Arith.PeanoNat.
Record Z_3 : Type := Z3
{
n :> nat;
proof : (Nat.ltb n 3) = true
}.
Proposition lt_0_3 : (0 <? 3) = true.
Proof.
simpl. reflexivity.
Qed.
Definition z3_0 : Z_3 := (Z3 0 lt_0_3).
Proposition lt_1_3 : (1 <? 3) = true.
Proof.
reflexivity.
Qed.
Definition z3_1 : Z_3 := (Z3 1 lt_1_3).
Proposition lt_2_3 : (2 <? 3) = true.
Proof.
reflexivity.
Qed.
Definition z3_2 : Z_3 := (Z3 2 lt_2_3).
Proposition three_ne_0 : 3 <> 0.
Proof.
discriminate.
Qed.
Lemma mod_upper_bound_bool : forall (a b : nat), (not (eq b O)) -> (Nat.ltb (a mod b) b) = true.
Proof.
intros a b H. apply (Nat.mod_upper_bound a b) in H. case Nat.ltb_spec0.
- reflexivity.
- intros Hcontr. contradiction.
Qed.
Definition Z3_op (x y: Z_3) : Z_3 :=
let a := (x + y) mod 3 in
Z3 a (mod_upper_bound_bool _ 3 three_ne_0).
Lemma Z3_eq n m p q : n = m -> Z3 n p = Z3 m q.
Proof.
intros H. revert p q. rewrite H. clear H. intros. apply f_equal.
We are almost done:
1 subgoal (ID 41)
n, m : nat
p, q : (m <? 3) = true
============================
p = q
What theorem should I use to prove that p = q?
Update 1
Theorem bool_dec :
(forall x y: bool, {x = y} + {x <> y}).
Proof.
intros x y. destruct x.
- destruct y.
+ left. reflexivity.
+ right. intro. discriminate H.
- destruct y.
+ right. intro. discriminate H.
+ left. reflexivity.
Qed.
Lemma Z3_eq n m p q : n = m -> Z3 n p = Z3 m q.
Proof.
intros H. revert p q. rewrite H. clear H. intros. apply f_equal. apply UIP_dec. apply bool_dec.
Qed.
You are probably interested in knowing that every two proofs of a decidable equality are equal. This is explained and proved here: https://coq.inria.fr/library/Coq.Logic.Eqdep_dec.html
You are interested in particular in the lemma UIP_dec: https://coq.inria.fr/library/Coq.Logic.Eqdep_dec.html#UIP_dec
Theorem UIP_dec :
forall (A:Type),
(forall x y:A, {x = y} + {x <> y}) ->
forall (x y:A) (p1 p2:x = y), p1 = p2.
You will have then to prove that equalities of booleans are decidable (i.e. that you can write a function which says whether two given booleans are equal or not) which you should also be able to find in the standard library but which should be easily provable by hand as well.
This is a different question but since you asked: bool_dec exists and even has that name!
The easy way to find it is to use the command
Search sumbool bool.
It will turn up several lemmata, including pretty early:
Bool.bool_dec: forall b1 b2 : bool, {b1 = b2} + {b1 <> b2}
Why did I search sumbool? sumbool is the type which is written above:
{ A } + { B } := sumbool A B
You can find it using the very nice Locate command:
Locate "{".
will turn up
"{ A } + { B }" := sumbool A B : type_scope (default interpretation)
(and other notations involving "{").

even_Sn_not_even_n - apply 1 hypothesis in another

Unfortunately I got stuck again:
Inductive even : nat > Prop :=
| ev_0 : even 0
| ev_SS (n : nat) (H : even n) : even (S (S n)).
Lemma even_Sn_not_even_n : forall n,
even (S n) <-> not (even n).
Proof.
intros n. split.
+ intros H. unfold not. intros H1. induction H1 as [|n' E' IHn].
- inversion H.
- inversion_clear H. apply IHn in H0. apply H0.
+ intros H. induction n as [|n' IHn].
- exfalso. apply H. apply ev_0.
- apply evSS_inv'.
Here is the result:
1 subgoal (ID 179)
n' : nat
H : ~ even (S n')
IHn : ~ even n' -> even (S n')
============================
even n'
As far I could prove it in words:
(n' + 1) is not even according to H. Therefore according to IHn, it is not true that n' is not even (double negation):
IHn : ~ ~ even n'
Unfolding double negation, we conclude that n' is even.
But how to write it in coq?
The usual way to strip double negation is to introduce the "excluded middle" axiom, which is defined under the name classic in Coq.Logic.Classical_Prop, and apply the lemma NNPP.
However, in this particular case, you can use the technique called reflection by showing that the Prop is consistent with a boolean function (you might remember the evenb function introduced earlier in the book).
(Assuming you're at the beginning of IndProp) You'll soon see the following definition later in that chapter:
Inductive reflect (P : Prop) : bool -> Prop :=
| ReflectT (H : P) : reflect P true
| ReflectF (H : ~ P) : reflect P false.
You can prove the statement
Lemma even_reflect : forall n : nat, reflect (even n) (evenb n).
and then use it to move between a Prop and a boolean (which contain the same information i.e. the (non-)evenness of n) at the same time. This also means that you can do classical reasoning on that particular property without using the classic axiom.
I suggest to complete the exercises under Reflection section in IndProp, and then try the following exercises. (Edit: I uploaded the full answer here.)
(* Since `evenb` has a nontrivial recursion structure, you need the following lemma: *)
Lemma nat_ind2 :
forall P : nat -> Prop,
P 0 -> P 1 -> (forall n : nat, P n -> P (S (S n))) -> forall n : nat, P n.
Proof. fix IH 5. intros. destruct n as [| [| ]]; auto.
apply H1. apply IH; auto. Qed.
(* This is covered in an earlier chapter *)
Lemma negb_involutive : forall x : bool, negb (negb x) = x.
Proof. intros []; auto. Qed.
(* This one too. *)
Lemma evenb_S : forall n : nat, evenb (S n) = negb (evenb n).
Proof. induction n.
- auto.
- rewrite IHn. simpl. destruct (evenb n); auto. Qed.
(* Exercises. *)
Lemma evenb_even : forall n : nat, evenb n = true -> even n.
Proof. induction n using nat_ind2.
(* Fill in here *) Admitted.
Lemma evenb_odd : forall n : nat, evenb n = false -> ~ (even n).
Proof. induction n using nat_ind2.
(* Fill in here *) Admitted.
Lemma even_reflect : forall n : nat, reflect (even n) (evenb n).
Proof. (* Fill in here. Hint: You don't need induction. *) Admitted.
Lemma even_iff_evenb : forall n, even n <-> evenb n = true.
Proof. (* Fill in here. Hint: use `reflect_iff` from IndProp. *) Admitted.
Theorem reflect_iff_false : forall P b, reflect P b -> (~ P <-> b = false).
Proof. (* Fill in here. *) Admitted.
Lemma n_even_iff_evenb : forall n, ~ (even n) <-> evenb n = false.
Proof. (* Fill in here. *) Admitted.
Lemma even_Sn_not_even_n : forall n,
even (S n) <-> not (even n).
Proof. (* Fill in here.
Hint: Now you can convert all the (non-)evenness properties to booleans,
and then work with boolean logic! *) Admitted.

Induction on evidence for the "less than" relation in coq

I am working on the proof of the following theorem Sn_le_Sm__n_le_m in IndProp.v of Software Foundations (Vol 1: Logical Foundations).
Theorem Sn_le_Sm__n_le_m : ∀n m,
S n ≤ S m → n ≤ m.
Proof.
intros n m HS.
induction HS as [ | m' Hm' IHm'].
- (* le_n *) (* Failed Here *)
- (* le_S *) apply IHSm'.
Admitted.
where, the definition of le (i.e., ≤) is:
Inductive le : nat → nat → Prop :=
| le_n n : le n n
| le_S n m (H : le n m) : le n (S m).
Notation "m ≤ n" := (le m n).
Before induction HS, the context as well as the goal is as follows:
n, m : nat
HS : S n <= S m
______________________________________(1/1)
n <= m
At the point of the first bullet -, the context as well as the goal is:
n, m : nat
______________________________________(1/1)
n <= m
where we have to prove n <= m without any context, which is obviously impossible.
Why does it not generate S n = S m (and then n = m) for the le_n case in induction HS?
The main problem here -I think- is it is impossible to prove the Theorem using induction on HS as there is no way to say something about n with only hypothesis about S n because non of the constructors of le do not change the value of n. But anyway the reason that after first bullet - there is no assumption is because calling induction has the effect of replacing all occurrences of the property argument by the values that correspond to each constructor and it doesn't help in this case since the term that gets replaced S n is not mentioned anywhere. There are some tricks to avoid this. for example you can replace n with pred(S n) as follows.
Theorem Sn_le_Sm__n_le_m : forall n m,
S n <= S m -> n <= m.
Proof.
intros n m HS.
assert(Hn: n=pred (S n)). reflexivity. rewrite Hn.
assert(Hm: m=pred (S m)). reflexivity. rewrite Hm.
induction HS.
- (* le_n *) apply le_n.
- (* le_S *) (* Stucks! *) Abort.
But as I mentioned above it is impossible to go further. Another way is to use inversion which is smarter but in some cases it may not help since induction hypothesis would be necessary. But it worth to know about it.
Theorem Sn_le_Sm__n_le_m : forall n m,
S n <= S m -> n <= m.
Proof.
intros n m HS.
inversion HS.
- (* le_n *) apply le_n.
- (* le_S *) (* Stucks! *) Abort.
Best way to solve the problem is use of remember tactic as follows.
Theorem Sn_le_Sm__n_le_m : forall n m,
S n <= S m -> n <= m.
Proof.
intros n m HS.
remember (S n) as Sn.
remember (S m) as Sm.
induction HS as [ n' | n' m' H IH].
- (* le_n *)
rewrite HeqSn in HeqSm. injection HeqSm as Heq.
rewrite <- Heq. apply le_n.
- (* le_S *) (* Stucks! *) Abort.
According to Software Foundations (Vol 1: Logical Foundations)
The tactic remember e as x causes Coq to (1) replace all occurrences
of the expression e by the variable x, and (2) add an equation x = e
to the context.
Anyway, although it is impossible to prove the fact using induction on HS -imo-, performing an induction on m will solve the case. (Note the use of inversion.)
Theorem Sn_le_Sm__n_le_m : forall n m,
S n <= S m -> n <= m.
Proof.
intros n.
induction m as [|m' IHm'].
- intros H. inversion H as [Hn | n' contra Hn'].
+ apply le_n.
+ inversion contra.
- intros H. inversion H as [HnSm' | n' HSnSm' Heq].
+ apply le_n.
+ apply le_S. apply IHm'. apply HSnSm'.
Qed.
Just more examples of Kamyar's answer.
Well, let's take a look of le induction scheme :
Compute le_ind.
forall (n : nat) (P : nat -> Prop),
P n ->
(forall m : nat, n <= m -> P m -> P (S m)) ->
forall n0 : nat, n <= n0 -> P n0
P is some proposition that holds one natural number, which means in the case of le_n, our preposition n <= m will be reduced to forall n, n <= m. Indeed, it's the same lemma that we want to prove, however unprovable because there is no premise.
An easy to solve this is doing induction where le_ind doesn't do.
For example :
Theorem Sn_le_Sm__n_le_m' : forall m n,
S n <= S m -> n <= m.
elim.
by intros; apply : Gt.gt_S_le .
intros; inversion H0.
by subst.
by subst; apply : le_Sn_le.
Qed.
Notice that we doing induction by m, and using inversion to generates the two possible construction of le ({x = y} + {x < y}). Optionally, you can use le decidability.
Theorem Sn_le_Sm__n_le_m : forall n m,
S n <= S m -> n <= m.
intros.
generalize dependent n.
elim.
auto with arith.
intros.
have : n <= m.
by apply : H; apply : le_Sn_le.
move => H'.
destruct m.
auto with arith.
destruct (le_lt_eq_dec _ _ H').
assumption.
subst.
(* just prove that there is no S m <= m *)
Qed.
For the sake of your time, coq has the tactic dependent induction that easily solves your goal :
Theorem Sn_le_Sm__n_le_m'' : forall n m,
S n <= S m -> n <= m.
intros.
dependent induction H.
auto.
by apply : (le_Sn_le _ _ H).
Qed.

How to deal with a function with an exists on the right side?

I am not sure whether I am using the right words in the question title, so here is the code:
Lemma In_map_iff :
forall (A B : Type) (f : A -> B) (l : list A) (y : B),
In y (map f l) <->
exists x, f x = y /\ In x l.
Proof.
intros A B f l y.
split.
- intros.
induction l.
+ intros. inversion H.
+ exists x.
simpl.
simpl in H.
destruct H.
* split.
{ apply H. }
{ left. reflexivity. }
* split.
A : Type
B : Type
f : A -> B
x : A
l : list A
y : B
H : In y (map f l)
IHl : In y (map f l) -> exists x : A, f x = y /\ In x l
============================
f x = y
Basically, there is not much to go on with this proof, I can only really use induction on l and after substituting for x in the goal I get the above form. If IHl had a forall instead of exists maybe I could substitute something there, but I am not sure at all what to do here.
I've been stuck on this one for a while now, but unlike the other problems where that has happened, I could not find the solution online for this one. This is a problem as I am going through the book on my own, so have nobody to ask except in places like SO.
I'd appreciate a few hints. Thank you.
Lemma In_map_iff :
forall (A B : Type) (f : A -> B) (l : list A) (y : B),
In y (map f l) <->
exists x, f x = y /\ In x l.
Proof.
intros A B f l y.
split.
- intros.
induction l.
+ intros. inversion H.
+ simpl.
simpl in H.
destruct H.
* exists x.
split.
{ apply H. }
{ left. reflexivity. }
* destruct IHl.
-- apply H.
-- exists x0.
destruct H0.
++ split.
** apply H0.
** right. apply H1.
- intros.
inversion H.
induction l.
+ intros.
inversion H.
inversion H1.
inversion H3.
+ simpl.
right.
apply IHl.
* inversion H.
inversion H0.
inversion H2.
exists x.
split.
-- reflexivity.
-- destruct H3.
A : Type
B : Type
f : A -> B
x0 : A
l : list A
y : B
H : exists x : A, f x = y /\ In x (x0 :: l)
x : A
H0 : f x = y /\ In x (x0 :: l)
IHl : (exists x : A, f x = y /\ In x l) ->
f x = y /\ In x l -> In y (map f l)
x1 : A
H1 : f x1 = y /\ In x1 (x0 :: l)
H2 : f x = y
H3 : x0 = x
H4 : f x = y
============================
In x l
I managed to do one case, but am now stuck in the other. To be honest, since I've already spent 5 hours on a problem that should need like 15 minutes, I am starting to think that maybe I should consider genetic programming at this point.
H can be true on two different ways, try destruct H. From that, the proof follows easily I think, but be careful on the order you destruct H and instantiate the existential thou.
Here is a proof that has the same structure as would have a pen-and-paper proof (at least the first -> part). When you see <tactic>... it means ; intuition (because of Proof with intuition. declaration), i.e. apply the intuition tactic to all the subgoals generated by <tactic>. intuition enables us not to do tedious logical deductions and can be replaced by a sequence of apply and rewrite tactics, utilizing some logical lemmas.
As #ejgallego pointed out the key here is that while proving you can destruct existential hypotheses and get inhabitants of some types out of them. Which is crucial when trying to prove existential goals.
Require Import Coq.Lists.List.
Lemma some_SF_lemma :
forall (A B : Type) (f : A -> B) (l : list A) (y : B),
In y (map f l) <->
exists x, f x = y /\ In x l.
Proof with intuition.
intros A B f l y. split; intro H.
- (* -> *)
induction l as [ | h l'].
+ (* l = [] *)
contradiction.
+ (* l = h :: l' *)
destruct H.
* exists h...
* destruct (IHl' H) as [x H'].
exists x...
- (* <- *)
admit.
Admitted.

Inductive Predicate for Addition in Coq

I'm new to inductive predicates in Coq. I have learned how to define simple inductive predicates such as "even" (as in adam.chlipala.net/cpdt/html/Predicates.html) or "last" (as in http://www.cse.chalmers.se/research/group/logic/TypesSS05/resources/coq/CoqArt/inductive-prop-chap/SRC/last.v).
Now I wanted to try something slightly more complicated: to define addition as an inductive predicate, but I got stuck. I did the following:
Inductive N : Type :=
| z : N (* zero *)
| s : N -> N. (* successor *)
Inductive Add: N -> N -> N -> Prop :=
| add_z: forall n, (Add n z n)
| add_s: forall m n r, (Add m n r) -> (Add m (s n) (s r)).
Fixpoint plus (x y : N) :=
match y with
| z => x
| (s n) => (s (plus x n))
end.
And I would like to prove a simple theorem (analogously to what has been done for last and last_fun in www.cse.chalmers.se/research/group/logic/TypesSS05/resources/coq/CoqArt/inductive-prop-chap/SRC/last.v):
Theorem T1: forall x y r, (plus x y) = r -> (Add x y r).
Proof.
intros x y r. induction y.
simpl. intro H. rewrite H. apply add_z.
case r.
simpl. intro H. discriminate H.
???
But then I get stuck. The induction hypothesis seems strange. I don't know if I defined Add wrongly, or if I am just using wrong tactics. Could you please help me, by either correcting my inductive Add or telling me how to complete this proof?
You introduced r before using induction on y. In general you'll want to use induction before introducing anything so the induction hypothesis is as general as possible.
Conjecture injectivity : forall n m, s n = s m -> n = m.
Theorem T1: forall x y r, (plus x y) = r -> (Add x y r).
Proof.
intros x y. induction y.
simpl. intros r H. rewrite H. apply add_z.
intro r. case r.
simpl. intro H. discriminate H.
simpl. intros n H. apply add_s. apply IHy. apply injectivity. apply H.
Qed.