Proof irrelevance for boolean equality - coq

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 "{").

Related

Z_3: left id proof

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.

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.

How can I prove `false` and by extension anything from Coq hypothesis 'd=d+1'?

Goal forall (d : nat), d + 1 = d -> False.
Proof.
intros d H.
Abort.
How can I prove False from H? inversion H is just replicating it.
Here is how you can discover some helpful lemmas to do derive a contradiction from your context. First of all we need to import a module containing them, otherwise the Search command won't be able to discover those lemmas:
Require Import Coq.Arith.Arith.
Let's check if we have exactly the lemma we need (recall that x <> y is a notation for not (eq x y), and not A stands for A -> False):
Search (?x + _ <> ?x).
No luck this time. Ok, addition is commutative, let's trying it this way:
Search (_ + ?x <> ?x).
Nothing again. But we certainly should have something like that:
Search (S ?x <> ?x).
Finally we have the following lemma:
Nat.neq_succ_diag_l: forall n : nat, S n <> n
which we can use like so:
Require Import Coq.Arith.Arith.
Goal forall (d : nat), d + 1 = d -> False.
Proof.
intros d H.
rewrite Nat.add_comm in H.
now apply Nat.neq_succ_diag_l in H.
Qed.
The proof follows by induction on d and uses:
eq_add_S
: forall n m : nat, S n = S m -> n = m
The base case is 0 = 1 which by inversion leads to False, this concluding the case. The inductive case you have d + 1 = d -> False as the induction hypothesis and S d + 1 = S d -> False as your goal. We know that x + 1 = y + 1 -> x + y from eq_add_S, so we rewrite our goal and apply the induction hypothesis.
Complete proof:
Goal forall (d : nat), d + 1 = d -> False.
Proof.
induction d.
intros.
- inversion H.
- intros H.
erewrite <- eq_add_S in H; eauto.
Qed.

How to do induction differently?

I am doing an exercise in Coq and trying to prove if a list equals to its reverse, it's a palindrome. Here is how I define palindromes:
Inductive pal {X : Type} : list X -> Prop :=
| emptypal : pal []
| singlpal : forall x, pal [x]
| inducpal : forall x l, pal l -> pal (x :: l ++ [x]).
Here is the theorem:
Theorem palindrome3 : forall {X : Type} (l : list X),
l = rev l -> pal l.
According to my definition, I will need to do the induction my extracting the front and tail element but apparently coq won't let me do it, and if I force it to do so, it gives an induction result that definitely doesn't make any sense:
Proof.
intros X l H. remember (rev l) as rl. induction l, rl.
- apply emptypal.
- inversion H.
- inversion H.
- (* stuck *)
context:
1 subgoals
X : Type
x : X
l : list X
x0 : X
rl : list X
Heqrl : x0 :: rl = rev (x :: l)
H : x :: l = x0 :: rl
IHl : x0 :: rl = rev l -> l = x0 :: rl -> pal l
______________________________________(1/1)
pal (x :: l)
aparently the inductive context is terribly wrong. is there any way I can fix the induction?
The solution I propose here is probably not the shortest one, but I think it is rather natural.
My solution consists in defining an induction principle on list specialized to your problem.
Consider natural numbers. There is not only the standard induction nat_ind where you prove P 0 and forall n, P n -> P (S n). But there are other induction schemes, e.g., the strong induction lt_wf_ind, or the two-step induction where you prove P 0, P 1 and forall n, P n -> P (S (S n)). If the standard induction scheme is not strong enough to prove the property you want, you can try another one.
We can do the same for lists. If the standard induction scheme list_ind is not enough, we can write another one that works. In this idea, we define for lists an induction principle similar to the two-step induction on nat (and we will prove the validity of this induction scheme using the two-step induction on nat), where we need to prove three cases: P [], forall x, P [x] and forall x l x', P l -> P (x :: l ++ [x']). The proof of this scheme is the difficult part. Applying it to deduce your theorem is quite straightforward.
I don't know if the two-step induction scheme is part of the standard library, so I introduce it as an axiom.
Axiom nat_ind2 : forall P : nat -> Prop, P 0 -> P 1 ->
(forall n : nat, P n -> P (S (S n))) -> forall n : nat, P n.
Then we prove the induction scheme we want.
Lemma list_ind2 : forall {A} (P : list A -> Prop) (P_nil : P [])
(P_single : forall x, P [x])
(P_cons_snoc : forall x l x', P l -> P (x :: l ++ [x'])),
forall l, P l.
Proof.
intros. remember (length l) as n. symmetry in Heqn. revert dependent l.
induction n using nat_ind2; intros.
- apply length_zero_iff_nil in Heqn. subst l. apply P_nil.
- destruct l; [discriminate|]. simpl in Heqn. inversion Heqn; subst.
apply length_zero_iff_nil in H0. subst l. apply P_single.
- destruct l; [discriminate|]. simpl in Heqn.
inversion Heqn; subst. pose proof (rev_involutive l) as Hinv.
destruct (rev l). destruct l; discriminate. simpl in Hinv. subst l.
rewrite app_length in H0.
rewrite PeanoNat.Nat.add_comm in H0. simpl in H0. inversion H0.
apply P_cons_snoc. apply IHn. assumption.
Qed.
You should be able to conclude quite easily using this induction principle.
Theorem palindrome3 : forall {X : Type} (l : list X),
l = rev l -> pal l.

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.